选择集
我正在尝试选择集。下面的代码是我使用的代码。但它不显示选择窗口。它给了我一条从第一个点到第二个点的线。如何让用户看到选择窗口Public Sub-SelectObject（）
Dim ssetName As StringDim objSet As AcadSelectionSetDim intMode As IntegerDim ObjLayer As AcadLayer>Dim Pt1，Pt2dimm dblPt3（0到2）As Double>Dim objEnt As Object；A1“
出现错误时，继续下一步删除现有sset A1（如果有）。选择集（“A1”）。删除设置对象集=ThisDrawing.SelectionSets。添加（ssetName）
intMode=acSelectionSetCrossing Pt2=ThisDrawing.Utility。GetPoint（Pt1，“选择右上角点到窗口选择集：”）
对象集。为objSet中的每个objEnt选择intMode、Pt1、Pt2。如果objEnt的类型为AcadEntity，则设置ObjLayer=ThisDrawing.Layers。添加（&quo；ABC&quo；）
ObjLayer。颜色=acBlue。层=“”；ABC“
如果结束下一个对象，则结束此绘图。选择集。项目（ssetName）。删除应用程序。更新End Sub
您应该真正使用SelectOnScreen方法，而不是选择和传递点
试试这个[代码我还没有测试它，但它应该可以正常工作
后来，我删除了未使用的变量
我可以补充一点，与应用程序相反，使用AcadApplication对象始终是一种很好的做法。这可以防止在另一个启用VBA的程序（例如excel）中使用该程序时出错。 你应该尽量远离；出错时继续下一步；。 这些有帮助吗
http://www.vbdesign.net/modules.php?s=&name=Code_Trout&cats=25
Public Sub SelectObject()
Dim ssetName As String
Dim objSet As AcadSelectionSet
Dim intMode As Integer
Dim ObjLayer As AcadLayer
Dim objEnt As Object
ssetName = "A1"
On Error Resume Next
' deleting existing sset A1 if any
ThisDrawing.SelectionSets("A1").Delete
Set objSet = ThisDrawing.SelectionSets.Add(ssetName)
intMode = acSelectionSetCrossing
frmMain.Hide
objSet.SelectOnScreen
For Each objEnt In objSet
If TypeOf objEnt Is AcadEntity Then
Set ObjLayer = ThisDrawing.Layers.Add("ABC")
ObjLayer.color = acBlue
objEnt.Layer = "ABC"
End If
Next objEnt
ThisDrawing.SelectionSets.Item(ssetName).Delete
Application.Update
End Sub 大家好
如果您不'；不介意，谢谢 http://usa.autodesk.com/adsk/servlet/index?id=18162650&站点ID=123112
页:
[1]