选择集

sbattina · 发表于 2004-2-20 14:47:15

我试着在选集上工作。下面的代码是我用过的。但是它不显示选择窗口。它给了我一条从第一点到第二点的线。如何让用户看到选择窗口？？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)。删除应用程序。更新
结束订阅

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

Keith · 发表于 2004-2-20 23:33:43

您应该真正使用SelectOnScreen方法，而不是选择和传递点
试试这个

copy


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）中使用该程序时出错。

JohnK · 发表于 2004-2-21 02:28:24

你应该尽量避免“下次出错时继续”。

MOHAN · 发表于 2004-2-21 09:00:50

这些有帮助吗
http://www.vbdesign.net/modules.php?s=&name=Code_Trout&cats=25

Master_Shake · 发表于 2016-3-16 11:14:47

copy

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

选择集

发表回复

精选推荐