|
|
[原创]：多义线上加点
9pt
10pt
11pt
12pt
13pt
15pt
用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
本帖以下内容被隐藏保护；需要你回复后，才能看到！ 游客，如果您要查看本帖隐藏内容请 回复 |
|
置顶卡
