本帖最后由 作者 于 2008-3-19 20:53:25 编辑给你个可输出polygon多段线节点的小程序(适用于AutoCAD 200 ...
朋友,给我源码好吗?
我发现这个可以用来做公路勘界用,以前我是用多条复合线连接好后,用其他功能生成txt文件,再转成南方格式文件,并自动剔除了重复点(线路太长,不可能一次绕完一条线路,总有断点,连接好成一条线后就有了重复点)。用你用的这个方法就可省去中间步奏,可直接生成各种格式的文件。cass格式,RTK格式等。
我的邮箱sxliu211@163.com 提供一列代码
可以把多段线的坐标放到D盘里面的txt里面
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("ssLine7")
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
If IsFileExists("d:\坐标.txt") = True Then
Kill "d:\坐标.txt"
End If
Open "d:\坐标.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
Function IsFileExists(ByVal strFileName As String) As Boolean
If Dir(strFileName, 16) <> Empty Then
IsFileExists = True
Else
IsFileExists = False
End If
End Function
页:
1
[2]