选择集和筛选
亲爱的会员嗨，我已经很久没有autocad定制了很长时间，现在我想创建一些折线坐标的数组，然后删除重复的坐标，所以我写了我的日常工作，但它在第一阶段有一些错误。
谢谢，祝您度过美好时光。
Private Sub CommandButton4_Click()
Me.Hide
Dim myEnt As AcadEntity
Dim Pot(0 To 2) As Double
Dim myLay As Variant
Dim myCol As Variant
ThisDrawing.Utility.GetEntity myEnt, Pot, "Select yout lwpolyline"
If TypeOf myEnt Is AcadLWPolyline Then
myLay = myEnt.Layer
myCol = myEnt.color
Else
MsgBox "Not selected a polyline !?", vbCritical
End If
Dim SSet As AcadSelectionSet
Dim FilterType(0 To 2) As Integer
Dim FilterData(0 To 2) As Variant
Dim Groupcode As Variant
Dim DataValue As Variant
Dim myCoords() As Double
FilterType(0) = 0
FilterData(0) = "LWPolyline"
FilterType(1) = 8
FilterData(1) = myEnt.Layer
FilterType(2) = 62
FilterData(2) = myEnt.color
Groupcode = FilterType
DataValue = FilterData
On Error Resume Next
ActiveDocument.SelectionSets.Item("MY_SSL").Delete
Set SSet = ActiveDocument.SelectionSets.Add("MY_SSL")
On Error GoTo 0
SSet.Select acSelectionSetAll, , , Groupcode, DataValue
Dim Ents() As Object
Dim Ent As Object
Dim i As Long
i = 0
For Each Ent In SSet
If Ent.EntityTypemyEnt.EntityType Then
ReDim Preserve Ents(0 To i)
Set Ents(i) = Ent
ReDim Preserve Ents(0 To i)
myCoords(i) = Ent.Coordinates
i = i + 1
End If
Next Ent
If i > 0 Then
SSet.RemoveItems (Ents)
End If
For i = 0 To UBound(myCoords) - 1
Debug.Print myCoords(i), myCoords(i + 1)
Next i
UserForm1.Show
End Sub
**** Hidden Message ***** 你好，Robert98
这个问题你解决了吗？
否则，请让我知道您还在纠结什么。
但是，第一眼我会注意到下面的内容:
-似乎您会抱怨用户没有选择myEnt作为LWPolyline ("MsgBox "没有选择Polyline！？"，vbCritical ")但是，如果他选择myEnt作为LWPolyline，那么例程不会做任何事情，因为" if Ent。EntityTypemyEnt。SSet”循环中每个Ent的entity type“control inside”将始终返回“False”(SSet。选择标准将只收集“LWPolyline”类型的元素)并且myCoords向量永远不会被填充。
所以您的例程只处理与“非轻量级折线”实体具有相同颜色和图层的轻量级折线的坐标:这是您的目标吗？
-指令“my cords(I)= Ent。坐标”不起作用，因为“坐标”属性会返回一个变量。此外，它返回不止一个值(“对象中每个顶点的坐标”)，这些值不能只放入一个向量位置，例如“my cords(I)”。最后，您没有使用任何ReDim指令来使“my cords”向量能够填充新的坐标
,因此您应该首先声明一个变量来收集实体坐标，并最终通过循环将它们注入my cords向量中。所有这些总是保持对向量尺寸的跟踪(即:适当地重新定义它们)。例如:
Option Explicit
Private Sub CommandButton4_Click()
Me.Hide
Dim myEnt As AcadEntity
Dim Pot(0 To 2) As Double
Dim myLay As Variant
Dim myCol As Variant
ThisDrawing.Utility.GetEntity myEnt, Pot, "Select yout lwpolyline"
If TypeOf myEnt Is AcadLWPolyline Then
myLay = myEnt.Layer
myCol = myEnt.color
Else
MsgBox "Not selected a polyline !?", vbCritical
End If
Dim SSet As AcadSelectionSet
Dim FilterType(0 To 2) As Integer
Dim FilterData(0 To 2) As Variant
Dim Groupcode As Variant
Dim DataValue As Variant
Dim myCoords() As Double
FilterType(0) = 0
FilterData(0) = "LWPolyline"
FilterType(1) = 8
FilterData(1) = myEnt.Layer
FilterType(2) = 62
FilterData(2) = myEnt.color
Groupcode = FilterType
DataValue = FilterData
On Error Resume Next
ActiveDocument.SelectionSets.Item("MY_SSL").Delete
Set SSet = ActiveDocument.SelectionSets.Add("MY_SSL")
On Error GoTo 0
SSet.Select acSelectionSetAll, , , Groupcode, DataValue
Dim Ents() As Object
Dim Ent As Object
Dim i As Long, j As Long, UBRetCoords As Long, UBMyCoords As Long
Dim retCoords As Variant
i = 0
For Each Ent In SSet
If Ent.EntityTypemyEnt.EntityType Then
ReDim Preserve Ents(0 To i)
Set Ents(i) = Ent
ReDim Preserve Ents(0 To i)
i = i + 1
retCoords = Ent.Coordinates
UBRetCoords = UBound(retCoords)
'handle the first time you have to fill myCoords
On Error Resume Next
UBMyCoords = UBound(myCoords)
If Err Then UBMyCoords = -1
On Error GoTo 0
' fill myCoords
ReDim Preserve myCoords(0 To UBMyCoords + UBRetCoords + 1)
For j = 0 To UBRetCoords
myCoords(UBMyCoords + j + 1) = retCoords(j)
Next j
End If
Next Ent
If i > 0 Then
SSet.RemoveItems (Ents)
End If
For i = 0 To UBound(myCoords) - 1
Debug.Print myCoords(i), myCoords(i + 1)
Next i
UserForm1.Show
End Sub
再见 你好，雷克巴
非常感谢你的问候，继续下去似乎是个好主意，但我现在正在进行实地工作，因此很快我就要开始编程了。
罗伯特，你说得对
页:
[1]