明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 788|回复: 9

多段线加点 vba

[复制链接]
发表于 2023-11-20 23:22 | 显示全部楼层 |阅读模式
'线上加点
Sub Start_XianJiaDian()
  '1、选线
  Dim PolyXian As AcadLWPolyline  'AcadPolyline   'AcadEntity
  Dim Dianwei As Variant

  ThisDrawing.Utility.GetEntity PolyXian, Dianwei, "选取线"    '如何判断没选任何东西呢?

  Dim DianShu As Integer
  DianShu = (UBound(PolyXian.Coordinates) + 1) / 2 '求出总点数

  Dim i As Integer, j As Integer
  Dim JieDian(0 To 2) As Double
  Dim ZuobiaoJi As Variant
  Dim Ang() As Double  '直线的角度
  ReDim Ang(DianShu)
  ZuobiaoJi = PolyXian.Coordinates

  Dim pLine As AcadLine

  For i = 1 To DianShu
    JieDian(0) = ZuobiaoJi(i * 2 - 2)
    JieDian(1) = ZuobiaoJi(i * 2 - 1)
    JieDian(2) = 0
    Set pLine = ThisDrawing.ModelSpace.AddLine(Dianwei, JieDian)
       Ang(i) = pLine.Angle  ' 记录新建直线的角度,这个角度为弧度值。
'       Debug.Print Ang(i)
       pLine.Delete

  Next i

    Dim Qd As Integer  '点序号

        '通过直线夹角判断所选取点离线上的结点哪个最近,,夹角越小,离点越近
         Dim JiaJiao() As Double
         ReDim JiaJiao(DianShu - 1)

          For i = 1 To DianShu - 1
            JiaJiao(i) = Abs(Ang(i) - Ang(i + 1))   '夹角
          Next i
          For i = 1 To DianShu - 1
            JiaJiao(i) = JiaJiao(i) / 3.1415926 * 180  '夹角转成度
            JiaJiao(i) = Abs(180 - JiaJiao(i))
'            Debug.Print JiaJiao(i)
          Next i

          Dim jd As Double
          jd = JiaJiao(1)
            For i = 1 To DianShu - 1
               If JiaJiao(i) < jd Then
                  jd = JiaJiao(i)        '找最小夹角和对应的序号
                  Qd = i
               End If
            Next i

  Dim JiaDian As Variant
  JiaDian = ThisDrawing.Utility.GetPoint(, vbCrLf & "请指定添加点的位置")
  Dim tjdzb(0 To 1) As Double
  tjdzb(0) = JiaDian(0)
  tjdzb(1) = JiaDian(1)

  PolyXian.AddVertex Qd, tjdzb



End Sub

发表于 2023-11-21 18:24 | 显示全部楼层
本帖最后由 yshf 于 2023-11-21 18:26 编辑

'线上加点
Sub Start_XianJiaDian()
  '1、选线
  Dim PolyXian As AcadLWPolyline  'AcadPolyline   'AcadEntity
  Dim Dianwei As Variant

  On Error Resume Next
  
  AppActivate ThisDrawing.Application.Caption
  
  ThisDrawing.Utility.GetEntity PolyXian, Dianwei, "选取线"    '如何判断没选任何东西呢?
  
  If Err.Number = -2147352567 Then
     MsgBox "没有选取对象!"
     Err.Clear
     End
  Else
     If Err.Number = 13 Then
        MsgBox "选取的对象不是多段线!"
        Err.Clear
        End
     End If
     
     Dim DianShu As Integer
     DianShu = (UBound(PolyXian.Coordinates) + 1) / 2 '求出总点数

     Dim i As Integer, j As Integer
     Dim JieDian(0 To 2) As Double
     Dim ZuobiaoJi As Variant
     Dim Ang() As Double  '直线的角度
     ReDim Ang(DianShu)
     ZuobiaoJi = PolyXian.Coordinates

     Dim pLine As AcadLine

     For i = 1 To DianShu
         JieDian(0) = ZuobiaoJi(i * 2 - 2)
         JieDian(1) = ZuobiaoJi(i * 2 - 1)
         JieDian(2) = 0
         Set pLine = ThisDrawing.ModelSpace.AddLine(Dianwei, JieDian)
         Ang(i) = pLine.Angle  ' 记录新建直线的角度,这个角度为弧度值。
'       Debug.Print Ang(i)
         pLine.Delete

     Next i

     Dim Qd As Integer  '点序号

     '通过直线夹角判断所选取点离线上的结点哪个最近,,夹角越小,离点越近
     Dim JiaJiao() As Double
     ReDim JiaJiao(DianShu - 1)

     For i = 1 To DianShu - 1
         JiaJiao(i) = Abs(Ang(i) - Ang(i + 1))   '夹角
     Next i
     For i = 1 To DianShu - 1
         JiaJiao(i) = JiaJiao(i) / 3.1415926 * 180  '夹角转成度
         JiaJiao(i) = Abs(180 - JiaJiao(i))
'            Debug.Print JiaJiao(i)
     Next i

     Dim jd As Double
     jd = JiaJiao(1)
     For i = 1 To DianShu - 1
         If JiaJiao(i) < jd Then
            jd = JiaJiao(i)        '找最小夹角和对应的序号
            Qd = i
          End If
     Next i

     Dim JiaDian As Variant
     JiaDian = ThisDrawing.Utility.GetPoint(, vbCrLf & "请指定添加点的位置")
     Dim tjdzb(0 To 1) As Double
     tjdzb(0) = JiaDian(0)
     tjdzb(1) = JiaDian(1)

     PolyXian.AddVertex Qd, tjdzb
  
  End If
End Sub

 楼主| 发表于 2023-11-21 23:57 | 显示全部楼层

感谢论坛长老“yshf”,

我为什么就不知道这些错误代码呢,有什么相关的书或者资料吗
发表于 2023-11-22 20:47 | 显示全部楼层
坐看大佬解决
发表于 2023-11-24 09:30 | 显示全部楼层
http://www.lee-mac.com/addpolyvertex.html
可以参考Lee-mac ,也是线上加点的功能

AddLWPolylineVertexV1-1.lsp 下面为连结
http://www.lee-mac.com/lisp/AddLWPolylineVertexV1-1.lsp
发表于 2024-1-13 08:42 | 显示全部楼层
多段线也研究过一段时间,这个加点功能主要用在哪些场景?
 楼主| 发表于 2024-3-22 21:05 | 显示全部楼层
chixun99 发表于 2024-1-13 08:42
多段线也研究过一段时间,这个加点功能主要用在哪些场景?

测绘专业在处理等高线、公路、河流等线性地物的时候
发表于 2024-3-25 10:56 | 显示全部楼层
yealor 发表于 2024-3-22 21:05
测绘专业在处理等高线、公路、河流等线性地物的时候

好的,多谢回复。了解了
发表于 2024-5-5 16:20 | 显示全部楼层
多段线插入点要想适应范围宽,就得考虑凸度,没有凸度的比较简单,只处理数组就行,有凸度的要判断
发表于 2024-5-5 16:21 | 显示全部楼层
再做一个判断点在线的哪一段上的函数
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-6-22 21:15 , Processed in 0.171411 second(s), 22 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表