Author Topic: Selection sets  (Read 15150 times)

0 Members and 1 Guest are viewing this topic.

sbattina

  • Guest
Selection sets
« on: February 20, 2004, 02:47:15 PM »
I am trying to work on selection sets. The code below is what I have used. But it does not show the selection window. It gives me a line from the first point to the second. How can get the user to see the selection window??


Public Sub SelectObject()

Dim ssetName As String
Dim objSet As AcadSelectionSet
Dim intMode As Integer
Dim ObjLayer As AcadLayer

Dim Pt1, Pt2
Dim dblPt3(0 To 2) As Double
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

Pt1 = ThisDrawing.Utility.GetPoint(, "select lower left point to window selection set:")

Pt2 = ThisDrawing.Utility.GetPoint(Pt1, "select Upper Right point to window selection set:")

objSet.Select intMode, Pt1, Pt2
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

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Selection sets
« Reply #1 on: February 20, 2004, 11:33:43 PM »
You should really use the SelectOnScreen method instead of select and passing points.

Try this
Code: [Select]

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


I have not tested it, but it should work fine.
Incedently I removed the unused variables.

I might add that is is always good practice to use the AcadApplication object as opposed to Application. This prevents an error if the program is ever used within another VBA enabled program, excel for example.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

TR

  • Guest
Selection sets
« Reply #2 on: February 21, 2004, 02:28:24 AM »
You should try to stay away from "On Error Resume Next".

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Selection sets
« Reply #3 on: February 21, 2004, 09:00:50 AM »
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

mohan

  • Newt
  • Posts: 98
Re: Selection sets
« Reply #4 on: March 16, 2016, 11:14:47 AM »
Code: [Select]
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

Hello guys;
Please explain from begining how to run the visual basic programming code
if you don't mind

Thanks
Mohan
"Save Energy"

ChrisCarlson

  • Guest