027集—CAD中批量删除多段线重复点、距离过近点——vba代码实现

山水CAD筑梦人

已于 2024-08-25 12:08:24 修改

阅读量673

点赞数 9

分类专栏： CAD VBA 文章标签：算法

于 2024-08-25 12:03:24 首次发布

本文链接：https://blog.csdn.net/yongshiqq/article/details/141527445

版权

CAD VBA 专栏收录该内容

65 篇文章

订阅专栏

cad图中多段线存在重复点、或距离过近点，可通过vba插件一键删除。

（精度可人工设定，例如精度设置0.001：小于0.001 的点视为重复点，删除此点。）

如下图：

大量重复点和距离过近点：

运行dvb插件（使用方法：命令行输入vbaman,加载此dvb插件，输入vbarun运行，选择多段线即可。）

另附部分源代码：


Sub AddIntersectionPointsToMultiplePolylines()
     'yngqq443440204@2024年8月25日10:41:30
    'On Error Resume Next
    Dim polyline1 As AcadLWPolyline ' 用于存储第一批中的单个多段线
    Dim selSet1 As AcadSelectionSet ' 第一批多段线的选择集
    Dim selSet2 As AcadSelectionSet ' 第二批多段线的选择集
    Dim i As Integer
    On Error Resume Next
    ThisDrawing.SelectionSets.Item("selSet1").Delete
    On Error GoTo 0
    Set selSet1 = ThisDrawing.SelectionSets.Add("selSet1")
    ThisDrawing.Utility.Prompt "请选择第一批需要加点的线，并按空格键结束。"
    selSet1.SelectOnScreen
    If selSet1.Count = 0 Then GoTo erro
    For i = 0 To selSet1.Count - 1
        Set polyline1 = selSet1.Item(i)
        'Call SimplifyPolyline(polyline1)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''省略部分源码，qq完整代码443440204
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Next i
    ThisDrawing.Utility.Prompt "交点已加入到第一批多段线中。"
erro:
    MsgBox "OK，CAD二次开发", , "443440204"
End Sub