[原创]：多义线上加点

laoxie_1983

用pedit给多义线加点，感觉好麻烦的，就作了一个添加点的。在添加的时候最好要用最近点捕作方式。
Sub jfjd() '多义线上添加点
Dim i, j As Integer
Dim jd As Double
On Error Resume Next
Dim xzj As AcadSelectionSet
Dim xxzb As Variant
If Not IsNull(ThisDrawing.SelectionSets.Item("jf")) Then
Set xzj = ThisDrawing.SelectionSets.Item("jf")
  xzj.Delete
End If
Set xzj = ThisDrawing.SelectionSets.Add("jf")
xzj.SelectOnScreen
xxzb = ThisDrawing.Utility.GetPoint(, vbCrLf & "请指定添加点的位置")
Dim tjdzb(0 To 1) As Double
tjdzb(0) = xxzb(0)
tjdzb(1) = xxzb(1)
'xzj.Delete
Dim st As AcadEntity
For Each st In xzj
'Set st = ThisDrawing.ModelSpace.Item(0)
Dim ds As Double
Dim zb As Variant
Dim ang() As Double
Dim qd, hd As Integer
'MsgBox st.ObjectName
Dim xzb(0 To 2) As Double
Dim zzb As Variant '添加后的坐标
Dim jzb(0 To 2) As Double
Dim pline As AcadLine
Dim ppline  As AcadLWPolyline
ds = (UBound(st.Coordinates) + 1) / 2 '求出总点数
ReDim ang(ds) As Double
ReDim zzb(ds * 2 + 1) As Double
zb = st.Coordinates
'xzb(0) = 815.081
'xzb(1) = 1173.804
'xzb(2) = 0
For i = 1 To ds
  jzb(0) = zb(i * 2 - 2)
  jzb(1) = zb(i * 2 - 1)
  jzb(2) = 0
  Set pline = ThisDrawing.ModelSpace.AddLine(xxzb, jzb)
  ang(i) = pline.Angle
  pline.Delete
Next
For i = 1 To ds
  For j = i + 1 To ds
  jd = Abs(ang(i) - ang(j))
  If Round(jd, 5) = 3.14159 Then
  qd = i '前点
  hd = j '后点
  End If
  Next j
  Next i
'MsgBox qd
  'plineObj.Coordinate(0) = coord
  st.AddVertex qd, tjdzb
kzsj st, 20
Next st
End Sub

kaikenzhe

试试先

laoxie_1983

请提些意见

roominess

kzsj ,未知

laoxie_1983

kzsj是一个添加扩展数据的。对本程序没有影响

ps122

先研究研究

roominess

我正要,偷下懒

yong66824

很不错哟  就是不知道 减点怎么写??

marchwang88

刚好用,省了时间

gmdgm

不错的想法和思路，我试一试