在cad中写文字的问题
如何用vba在cad写文字时加上下划线，还有怎么批量提取多条首尾相连的多段线的长度，最好能导入到excel中。求高手指教，谢谢 获取多段线xyz 的坐标并存在一个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, "X" & x & ",Y" & y
Next
Next
Close #1
ss_dim.Clear
ss_dim.Delete
End Sub
为文字添加下划线方法有二，可以用多行文字 编辑文字样式。也可以得到单行文字插入点并在相应位置直接画直线。
第一种简单，第二种方法我认为比较灵活 把linlq986的程序修改一下，就可以求长度了
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
Dim lLen as long
Dim lLenAll as Long
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, "X" & x & ",Y" & y
' 以下是添加的内容
lLen=ent.Length
Print #1, "lLen" & lLen
lLenAll=lLenAll+lLen
Print #1, "lLenAll" & lLenAll
Next
Next
Close #1
ss_dim.Clear
ss_dim.Delete
End Sub
页:
[1]