在cad中写文字的问题

zcc0 · 发表于 2011-7-25 17:05:00

如何用vba在cad写文字时加上下划线，还有怎么批量提取多条首尾相连的多段线的长度，最好能导入到excel中。求高手指教，谢谢

linlq986 · 发表于 2011-7-31 10:58:00

获取多段线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

hgo1984924 · 发表于 2011-7-31 11:10:00

为文字添加下划线方法有二，可以用多行文字编辑文字样式。也可以得到单行文字插入点并在相应位置直接画直线。
第一种简单，第二种方法我认为比较灵活

wwswwswws · 发表于 2011-9-19 17:04:00

把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

在cad中写文字的问题

发表回复

精选推荐