功能 闭合多段线的顶点 转移到 西北角 。。。
X-Y 最小值 判定为西北角
问题： 框选多条线后 只有两条起点坐标 放置到西北角其他无变化
求解 ：：：： 代码如下 （新手 代码很乱）
Sub Gpl()
Dim seer As AcadSelectionSet
Dim seername As String
seername = "seerre"
Dim var As Variant
Dim pp(1) As Double
Dim cc As Double
Dim pl As AcadLWPolyline
Dim coor() As Double
Dim Dx As Double
Dim DY As Double
Dim Bl As Boolean
Bl = False
Set seer = ThisDrawing.SelectionSets.Add(seername)
Dim f(0) As Integer
Dim d(0) As Variant
f(0) = 0
d(0) = "LWPOLYLINE"
seer.SelectOnScreen f, d
' pp = ThisDrawing.Utility.GetPoint
For Each pl In seer
var = pl.Coordinates
i = UBound(var)
ReDim coor(i) As Double
'-------------------------------------------------
'为PP 附值
For we = 0 To i - 2 Step 2
If Bl = False Then
Bl = True
Dx = var(we)
DY = var(we + 1)
Else
cc = var(we) - var(we + 1)
If Dx - DY > cc Then
Dx = var(we)
DY = var(we + 1)
End If
End If
Next
pp(0) = Dx
pp(1) = DY
'--------------------------------------------------
'判断下标
For j = 0 To i - 1
If var(j) = pp(0) And var(j + 1) = pp(1) Then
k = j
'MsgBox k
Exit For
End If
Next
For e = 0 To i - k
coor(e) = var(k + e)
Next
For r = 0 To k - 1
coor(i - k + r + 1) = var(r)
Next
pl.Coordinates = coor
pl.color = acBlue
Next
seer.Delete
End Sub
功能 闭合多段线的顶点 转移到 西北角 。。。
X-Y 最小值 判定为西北角
问题： 框选多条线后 只有两条起点坐标 放置到西北角其他无变化
求解 ：：：： 代码如上 （新手 代码很乱
置顶卡
