VBA Basic --> Intermediate

#1
Now we have covered the Basics of VBA we can start working on multiple drawing entity objects and to do this we use selection sets.

Selection sets are temporary collection of drawing entity objects that we can then manipulate.

In VBA we can select the entities using different selection modes which can be automatic or user interfaced.

There are two steps required to create a selection set:

Step 1
Add a selection set name to the drawing database.

Step 2
Populate the selection set with the drawing entity objects

Once we have the entity objects in the selection set we can loop through and change the properties of each entity.

Open a new drawing and draw some lines and circles in a new drawing then open the VBA IDE.

Insert a module in the new drawing and add the following code:

Start Code………………………………….

Sub SSExample()
' dimension the variables
Dim objSS As SelectionSet
Dim ColNum As Integer
Dim I As Integer
Dim objEnt As Entity

' add the selection set name to the drawing database
Set objSS = ThisDocument.SelectionSets.Add("SetName")

' populate the selection set with all the drawing entity objects
objSS.Select vicSelectionSetAll

' highlight all the entities in the selection set
objSS.Highlight True

ColNum = InputBox("Input a number from 1 to 256", "CMS Tutorial")

' trap any user input errors and default to 1
If ColNum > 256 Or ColNum < 1 Then ColNum = 1

' iterate through the selection set and change the color of each entity
For I = 1 To objSS.Count
Set objEnt = objSS(I)
objEnt.Color = ColNum
objEnt.Update

Next I

MsgBox "There are " & objSS.Count & " entities in the Selection Set", vbInformation, "CMS Tutorial"

End Sub


End Code ………………………………….


Try this out by placing the cursor in the subroutine then select F5.

All the drawing entity objects will highlight and an input box will ask for a color number. Input a number and select enter, all the entities will change color. Next a message box will advise how many entities are in the drawing selection set.

Well that was very easy!

What if we only wanted to change the lines and not the circles?

There are three ways we can do this:

First Way
Filter the selection set so only lines are included.
( best way )

Second Way
Get the user to select the lines and place them in the selection set.
( user may not get all lines )

Third Way
As we loop through the selection set entities, check the entity type and only change the line colors. ( slower in execution than First Way )

To filter entity objects in a selection set we use the DXF group codes as the selection criteria.

What are DXF group codes?

These are the Drawing File Interchange names and numbers that represent each drawing entity in text. All entity names are represented by a number 0 and a name, so a line is represented as (0 .“Line”)

To find out what any group codes for any entity type (entget(car(entsel))) at the command prompt – press enter - select an entity and press F2 to see the prompt history window.
You will see something like:

Select entity: ((-1 . <Entity name: d15e20> ) (0 . "LINE") (5 . "1CC") (67 . 0) (8 . "0") (62 . 56) (6 . "ByLayer") (48 . 1.00000) (60 . 0) (39 . 0.000000) (10 15873.7 10692.9 0.000000) (11 7030.93 10692.9 0.000000) (210 0.000000 0.000000 1.00000))
: '_PMTHIST


You can see the (0 . “LINE”) now type the (entget(car(entsel))) and select a circle and you will see (0 . “CIRCLE”) with other group codes.

To filter our selection set we need to add:

Dim DXFNumber(0) As Integer
Dim DXFName(0) As Variant

' set the filter options
DXFNumber(0) = 0
DXFName(0) = "LINE"

Then add additional options to the Select method as below:

' populate the selection set with all the drawing entity objects
objSS.Select vicSelectionSetAll, , , DXFNumber, DXFName

Here is the complete code

Start Code ………………………………….

Sub SSFExample()
' dimension the variables
Dim objSS As SelectionSet
Dim ColNum As Integer
Dim I As Integer
Dim objEnt As Entity
Dim DXFNumber(0) As Integer
Dim DXFName(0) As Variant

' set the filter options
DXFNumber(0) = 0
DXFName(0) = "LINE"


' add the selection set name to the drawing database
Set objSS = ThisDocument.SelectionSets.Add("SetName")

' populate the selection set with all the drawing entity objects
objSS.Select vicSelectionSetAll, , , DXFNumber, DXFName

' highlight all the entities in the selection set
objSS.Highlight True

ColNum = InputBox("Input a number from 1 to 256", "CMS Tutorial")

' trap any user input errors and default to 1
If ColNum > 256 Or ColNum < 1 Then ColNum = 1

' iterate through the selection set and change the color of each entity
For I = 1 To objSS.Count
Set objEnt = objSS(I)
objEnt.Color = ColNum
objEnt.Update

Next I

MsgBox "There are " & objSS.Count & " entities in the Selection Set", vbInformation, "CMS Tutorial"

End Sub


End Code ………………………………….

Our subroutine now only highlights the lines and alters their color.

Now alter DXFName(0) = "LINE" to DXFName(0) = "CIRCLE" and see only the circles change.

Using VBA we have control over all the drawing entity objects and can alter their properties such as layer and color also we can use filters to only select the entities we want to work on.

Have you ever received a CAD file that was produced by an inexperienced user and had to clean it up to use it?

Do you work on drawings that others produce and have to clean them out of excessive entities?

Next we will put our selection set knowledge to good use and I will show you some additional filtering to help cleanup drawings that other CAD people produced or even tidy up our own drawings.



------------------
Regards
John Finlay
Don't want to post a question - email me direct on john@acecad.com.au

#2
Great tutorial
I am having a problem with selection-set filters. It seems that group "-4" is not recognized.
Here is a sample that does not work.

Dim Ftyp(0 To 2) As Integer
Dim Fval(0 To 2) As Variant
Dim Filter1 As Variant
Dim Filter2 As Variant
Ftyp(0) = 0: Fval(0) = "circle"
Ftyp(1) = -4
Fval(1) = "<="
Ftyp(2) = 40: Fval(2) = 5#

Dim ss1 As SelectionSet
Set ss1 = ThisDrawing.SelectionSets.Add("ss1")
Filter1 = Ftyp: Filter2 = Fval
ss1.Select vicSelectionSetAll, , , Filter1, Filter2

Thanks in advance,
RSTRACH

#3
My problem is worse than I thought.
It seems that the problem isn't "group -4" but "group 40" instead. I can't even get the "ssget" lisp example from the help file to work.(shown below)
(ssget "X" '((0 . "CIRCLE") (62 . 1) (-4 . "<") (40 . 15.0)))
This also will not work. Which makes it seem to be a problem with the "group 40".
(ssget "X" '((0 . "CIRCLE") (40 . 15.0)))

Has anyone else had this problem?
Hopefully there is a simple fix...wishfull thinking.

Any ideas?


---RSTRACH

[This message has been edited by RSTRACH (edited 06-16-2003).]

#4
Group 4 is the logical operators for a ssget list (AND, OR, NOT) It has nothing to do with a smaller than or larger than selection. The < and > are to be read as braces in this context.

The syntax of your example therefore is wrong, e.g. (-4 . "<") has no meaning. If you are attempting a smaller-than selection you must go about it another way, as this cannot be done in selection set filter list. (correct me anyone if I am wrong)

I don't know for VBA, but for lisp you should use logical operators (selects circles of radius 15.0):
(setq sstmp (ssget "X" (list '(-4 . "<AND") '(40 . 15.0) '(0 . "CIRCLE")'(-4 . "AND>"))))

My suggestion for an identical question at a different forum a short while back was the following:

(defun maxrad (layr rad / sstmp cir cnt)
;;;Create selection set of circle entities on specific layer using logical operators
(setq sstmp (ssget "X" (list '(-4 . "<AND") (cons 8 layr) '(0 . "CIRCLE")'(-4 . "AND>"))))
(setq ss (ssadd);creates empty selection set
cnt 0);new counter
(repeat (sslength sstmp)
(setq cir (ssname sstmp cnt));a circle in the selection set
(if (>= rad (cdr(assoc 40 (entget cir))));test radius
(setq ss (ssadd cir ss));add to selection set if it passed test
)
(setq cnt (1+ cnt));increment counter
)
ss
)


To use the function, you must pass arguments to it. Let's say you want circles on layer "Green" with radius smaller than 1.5:

(maxrad "Green" 1.5)

creates a selection set ss containing all circles on layer "Green" with a radius smaller than or equal to 1.5

I have no idea how this translates to VBA.

#5
The example that you show .....
(setq sstmp (ssget "X" (list '(-4 . "<AND") '(40 . 15.0) '(0 . "CIRCLE")'(-4 . "AND>"))))
does not work on any of my machines either.
If you substitute a different group code ... say 60
(SETQ SSTMP (SSGET "X" (LIST '(-4 . "<AND") '(60 . 4) '(0 . "CIRCLE")'(-4 . "AND>"))))
Then it filters for all circles that are blue.
It can also be written ...
(SETQ SSTMP (SSGET "X" '((60 . 4) (0 . "CIRCLE"))))
The (-4 . "<and") and (-4 . "and>") are not req'd. as there already is an implied "and" when you create the filter list.
It seems there is actually very little difference in creating selection sets in lisp or VB.
Given the example in the ICAD help-file you should be able to filter for any of the DXF group-codes .

Thankyou for the reply

---RSTRACH

#6
Agreed, no need to use the logical operators in my example:

(setq sstmp (ssget "X" '((40 . 15.0)(0 . "CIRCLE"))))
= (setq sstmp (ssget "X" (list '(-4 . "<AND") '(40 . 15.0) '(0 . "CIRCLE")'(-4 . "AND>"))))
Both work on my machine (but require a circle of radius 15 of course)

The logical operators are necessary if you need to change a value in the filter-list at run-time, e.g.
(setq sstmp (ssget "X" (list '(-4 . "<AND") (cons 8 layr) '(0 . "CIRCLE")'(-4 . "AND>"))))
where [layr] is a variable.

P.S. Your example is wrong as group 62 is entity color, not 60.

#7
Darn, I'll have to eat my words on this one. Those relational arguments you mention for the -4 group are indeed supposed to work in a filter list. I wonder how I could have missed that. Anyway, they dont work in Intellicad, which must be a bug. You are stuck with checking each entity separately for now (which obviously is what I've been doing anyway until now).
How weird that I have never come across this as a compatibility issue when translating Autocad lisp to Intellicad lisp.

#8
I'll have to eat my words also. The "group 40" problem seems to have been fixed in Icad-4. I was trying it in the older versions (Icad-98 etc.)
Hopefully the bug with the -4 group will be fixed soon.
Until then there is always the work-around.
- Thanks
---RSTRACH
cron