选择外圈DWGEditor帮助
我有一个要修改的点的矩形数组。我想擦除位于圆形区域之外的点。如果要手动执行，我会简单地使用擦除命令并选择外圈选项，但无法理解如何在VBA中执行此操作。我假设我需要使用vicSelectionSetOutside Circle类型的选择方法创建一个要删除的点的选择集，但我不明白该类型是如何调用的。有人能向我解释一下它的语法吗？**** Hidden Message ***** 如果该点距离圆心的距离大于半径，请将其切掉，
并欢迎
正如Bryco所说：
Option Explicit
Sub DelOutSide()
Dim oSSet As AcadSelectionSet
Dim delSet As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oCircle As AcadCircle
Dim oPoint As AcadPoint
Dim cp As Variant
Dim varp As Variant
Dim rad As Double
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim dxfCode, dxfValue
Dim name As String
Dim count As Integer
On Error GoTo Err_Control
With ThisDrawing.SelectionSets
While .count > 0
.Item(0).Delete
Wend
Set oSSet = .Add("$Points$")
Set delSet = .Add("$Delete$")
End With
ftype(0) = 0: fdata(0) = "POINT"
dxfCode = ftype: dxfValue = fdata
ThisDrawing.Utility.GetEntity oEnt, varp, vbLf & "Select circle:"
If Not TypeOf oEnt Is AcadCircle Then
Exit Sub
End If
Set oCircle = oEnt
cp = oCircle.Center
rad = oCircle.Radius
oSSet.SelectOnScreen dxfCode, dxfValue
For Each oEnt In oSSet
Set oPoint = oEnt
varp = oPoint.Coordinates
If Distance(varp, cp) > rad Then
Dim varobj(0) As AcadEntity
Set varobj(0) = oEnt
delSet.AddItems (varobj)
End If
Next
MsgBox delSet.count
delSet.Erase
Exit_Here:
Exit Sub
Err_Control:
If Err.Number0 Then
MsgBox Err.Description
Err.Clear
End If
Resume Exit_Here
End Sub
'' by Frank Oquendo
Public Function Distance(fPoint As Variant, sPoint As Variant) As Double
Dim x1 As Double, x2 As Double
Dim y1 As Double, y2 As Double
Dim z1 As Double, z2 As Double
Dim cDist As Double
x1 = fPoint(0): y1 = fPoint(1): z1 = fPoint(2)
x2 = sPoint(0): y2 = sPoint(1): z2 = sPoint(2)
cDist = Sqr(((x2 - x1) ^ 2) + ((y2 - y1) ^ 2) + ((z2 - z1) ^ 2))
Distance = cDist
End Function
~'J'~ 谢谢你的帮助 很高兴能帮上忙
干杯
~'J'~
页:
[1]