社区 › VB › 在cad中写文字的问题

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

在cad中写文字的问题

如何用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中写文字的问题