选择集
我试着在选集上工作。下面的代码是我用过的。但是它不显示选择窗口。它给了我一条从第一点到第二点的线。如何让用户看到选择窗口？？Public Sub select Object()Dim sset name As String
Dim objSet As acadselectonset
Dim int mode As Integer
Dim obj layer As acad layer
Dim Pt1，Pt2
Dim dblPt3(0到2)As Double
Dim obj ent As Object
sset name = " A1 "
出错时继续下一步
'删除现有sset A1(如果有)此绘图。SelectionSets("A1 ")。删除
Set objSet = ThisDrawing。selection sets . Add(sset name)
int mode = acSelectionSetCrossing
frmMain。隐藏Pt1 = ThisDrawing。Utility.GetPoint(，"选择窗口选择集的左下点:")
Pt2 = ThisDrawing。Utility.GetPoint(Pt1，"选择窗口选择集的右上角点:")
对象集。为objSet中的每个对象选择intMode，Pt1，Pt2
如果对象的类型是AcadEntity，则
Set ObjLayer = ThisDrawing。layers . Add(" ABC ")
obj layer . color = AC blue
objEnt。Layer = "ABC"
如果下一个对象是该绘图，则结束。SelectionSets.Item(ssetName)。删除应用程序。更新
结束订阅
**** Hidden Message ***** 您应该真正使用SelectOnScreen方法，而不是选择和传递点
试试这个
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
我还没有测试它，但它应该可以正常工作
我可以补充一点，使用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
大家好；
如果您不介意，请从头解释如何运行visual basic编程代码
谢谢
Mohan
页:
[1]