怎样利用VBA提取选定的cad中多段线坐标,并将这些坐标写入txt中
就是cad中有很多多段线,我只想把我选定的多段线输入到txt中。有一部分的程序代码如下:PrivateSubGetLWPOLYLINECoordinates()Dimss...
就是cad中有很多多段线,我只想把我选定的多段线输入到txt中。有一部分的程序代码如下:
Private Sub GetLWPOLYLINECoordinates()
Dim ss_dim As AcadSelectionSet, ent As AcadLWPolyline
Dim dxf_code() As Integer, dxf_value() As Variant
Dim i As Long, j As Long
Dim dbCor As Variant, x As Double, y As Double, z As Double
Set ss_dim = ThisDrawing.SelectionSets.Add("ssLine1")
ReDim dxf_code(0), dxf_value(0)
dxf_code(0) = 0: dxf_value(0) = "LWPOLYLINE"
ss_dim.Select acSelectionSetAll, , , dxf_code, dxf_value
Open "d:\aaaaa.txt" For Append As #1
For Each ent In ss_dim
For j = 0 To UBound(ent.Coordinates) \ 2
x = ent.Coordinates(j * 2)
y = ent.Coordinates(j * 2 + 1)
Print #1, (j); ",," & x & "," & y
Next
Next
Close #1
ss_dim.Clear
ss_dim.Delete
End Sub
这个程序把图中所有的多段线都输入到了txt中。还要怎么修改一下 展开
Private Sub GetLWPOLYLINECoordinates()
Dim ss_dim As AcadSelectionSet, ent As AcadLWPolyline
Dim dxf_code() As Integer, dxf_value() As Variant
Dim i As Long, j As Long
Dim dbCor As Variant, x As Double, y As Double, z As Double
Set ss_dim = ThisDrawing.SelectionSets.Add("ssLine1")
ReDim dxf_code(0), dxf_value(0)
dxf_code(0) = 0: dxf_value(0) = "LWPOLYLINE"
ss_dim.Select acSelectionSetAll, , , dxf_code, dxf_value
Open "d:\aaaaa.txt" For Append As #1
For Each ent In ss_dim
For j = 0 To UBound(ent.Coordinates) \ 2
x = ent.Coordinates(j * 2)
y = ent.Coordinates(j * 2 + 1)
Print #1, (j); ",," & x & "," & y
Next
Next
Close #1
ss_dim.Clear
ss_dim.Delete
End Sub
这个程序把图中所有的多段线都输入到了txt中。还要怎么修改一下 展开
1个回答
展开全部
1.要改两个部份,第一步,改首行的private 为 public
2.ss_dim.Select acSelectionSetAll, , , dxf_code, dxf_value
改正:
ss_dim.SelectOnScreen dxf_code, dxf_value
这样就是输出选中对象了。
----------------------------
Public Sub GetLWPOLYLINECoordinates()
Dim ss_dim As AcadSelectionSet, ent As AcadLWPolyline
Dim dxf_code() As Integer, dxf_value() As Variant
Dim i As Long, j As Long
Dim dbCor As Variant, x As Double, y As Double, z As Double
Set ss_dim = ThisDrawing.SelectionSets.Add("ssLine1")
ReDim dxf_code(0), dxf_value(0)
dxf_code(0) = 0: dxf_value(0) = "LWPOLYLINE"
'ss_dim.Select acSelectionSetAll, , , dxf_code, dxf_value
ss_dim.SelectOnScreen dxf_code, dxf_value
Open "d:\aaaaa.txt" For Append As #1
For Each ent In ss_dim
For j = 0 To UBound(ent.Coordinates) \ 2
x = ent.Coordinates(j * 2)
y = ent.Coordinates(j * 2 + 1)
Print #1, (j); ",," & x & "," & y
Next
Next
Close #1
ss_dim.Clear
ss_dim.Delete
End Sub
2.ss_dim.Select acSelectionSetAll, , , dxf_code, dxf_value
改正:
ss_dim.SelectOnScreen dxf_code, dxf_value
这样就是输出选中对象了。
----------------------------
Public Sub GetLWPOLYLINECoordinates()
Dim ss_dim As AcadSelectionSet, ent As AcadLWPolyline
Dim dxf_code() As Integer, dxf_value() As Variant
Dim i As Long, j As Long
Dim dbCor As Variant, x As Double, y As Double, z As Double
Set ss_dim = ThisDrawing.SelectionSets.Add("ssLine1")
ReDim dxf_code(0), dxf_value(0)
dxf_code(0) = 0: dxf_value(0) = "LWPOLYLINE"
'ss_dim.Select acSelectionSetAll, , , dxf_code, dxf_value
ss_dim.SelectOnScreen dxf_code, dxf_value
Open "d:\aaaaa.txt" For Append As #1
For Each ent In ss_dim
For j = 0 To UBound(ent.Coordinates) \ 2
x = ent.Coordinates(j * 2)
y = ent.Coordinates(j * 2 + 1)
Print #1, (j); ",," & x & "," & y
Next
Next
Close #1
ss_dim.Clear
ss_dim.Delete
End Sub
追问
请问用vba开发cad学起来难么?我有些vb的基础,但是我感觉cad有一些自身的函数。那是我在vb里没学的。还有有什么学习方法介绍下。呵呵
追答
不难,帮助文档说的很详细,例子很多,有vb的基础,上手不难。
主要是理解cad的知识。对cad越理解,对开发越有好处。
VBA就是针对应用程序的应用,如果没有cad自身的函数,就没那么方便了。
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询