Selection Sets in Autocad VBA do not contain methods to Move, Copy, Rotate, Scale, Mirror etc. The programmer has to make a For-Each loop to iterate through the Selection Set and apply the method to each individual entity one at a time. There are quite a few steps between making the selection set, populating it, then looping through its members and actually doing something to them. Breaking down these steps into small re-usable sub-procedures is the way to go.
Other than how to use them, Selection Sets have pretty good documentation not too hard to understand. The first sub-procedure makes a new clean Selection Set in the drawing. If it already exists it deletes it. Its called with a parameter name.
Sub addss(strname As String) 'adds a clean selection set Dim sset As AcadSelectionSet On Error Resume Next Set sset = acadDoc.SelectionSets.Item(strname) sset.Delete Set sset = acadDoc.SelectionSets.Add(strname) If sset Is Nothing Then MsgBox "unable to add " & strname & " selection set" End If End Sub
In a recent program I made two kinds of selection, ALL and Window, so I made two function procedures to handle this task and return an AcadSelectionSet object. These functions call addss above. The way these work are documented and easily found with VBA ACADSelectionSets. Think of this as the second layer of abstraction, a function to make and return a set according to your selection method.
Function sset_all() As AcadSelectionSet 'returns a selection set ALL addss ("All_Entities") Set sset_all = acadDoc.SelectionSets.Item("All_Entities") sset_all.Select acSelectionSetAll End Function Function sset_win(x1 As Double, y1 As Double, x2 As Double, y2 As Double) As AcadSelectionSet 'returns a selection set with window selection Dim pt1(0 To 2) As Double Dim pt2(0 To 2) As Double Call initpt(pt1, x1, y1, 0) Call initpt(pt2, x2, y2, 0) 'items not visible do not select acadApp.Update acadApp.ZoomAll addss ("Win_Entities") Set sset_win = acadDoc.SelectionSets.Item("Win_Entities") sset_win.Select acSelectionSetWindow, pt1, pt2 End Function Sub initpt(ByRef ptn() As Double, val1 As Double, val2 As Double, val3 As Double) ptn(0) = val1: ptn(1) = val2: ptn(2) = val3 End Sub
initpt is a little helper I made. You don’t need the ByRef keyword, I put it in there to remind that arrays always pass by reference. It would not work otherwise.
Now we have, when properly called, a selection set of our choosing. We want to make sub-procedures for MOVE, COPY, ROTATE, MIRROR and SCALE which accept a selection set as an argument and whatever other basic parameters required, such as a displacement for MOVE. This is the third level of abstraction. We are calling these methods with a selection set previously selected by whatever method.
Erase is the simplest case. it doesnt require a loop.
Sub erase_ss(sset As AcadSelectionSet) sset.Erase 'erases the autocad entities in the drawing sset.Delete 'deletes the selection set Set sset = Nothing 'call by reference will set to nothing in calling program End Sub
now finally here is the code to MOVE a selection set using a loop to go thru the set for each item. It takes the set itself as argument and the displacement in x and y. You can select items with either of the subs above by window or all or your program with Crossing or Filters. Deleting the selection set at the end of the routine is optional and may not always be desired, say if you wanted to move and rotate.
Sub move_ss(sset As AcadSelectionSet, x1 As Double, y1 As Double) 'x1 y1 is the displacement Dim objent As AcadEntity Dim pt0(0 To 2) As Double Dim pt1(0 To 2) As Double Call initpt(pt0, 0, 0, 0) Call initpt(pt1, x1, y1, 0) If 0 <> sset.Count Then For Each objent In sset objent.Move pt0, pt1 Next End If sset.Delete 'deletes the selection set Set sset = Nothing 'call by reference will set to nothing in calling program End Sub
At this point these sub-procedures still do not change per program requirements. They are basic tools.
Here are mirror and scale (I have not needed COPY yet).
Sub mirror_ss(sset As AcadSelectionSet, pt1() As Double, pt2() As Double) 'deletes old copy, pt1 pt2 are axis Dim objent As AcadEntity Dim objent_mirrored As AcadEntity If 0 <> sset.Count Then For Each objent In sset Set objent_mirrored = objent.Mirror(pt1, pt2) objent.Delete Next End If sset.Delete Set sset = Nothing End Sub Sub scale_ss(sset As AcadSelectionSet, x1 As Double, y1 As Double, sc As Integer) 'x1 y1 is the scale from point, sc is the scale factor Dim objent As AcadEntity Dim pt0(0 To 2) As Double Call initpt(pt0, x1, y1, 0) If 0 <> sset.Count Then For Each objent In sset objent.ScaleEntity pt0, sc Next End If acadApp.Update acadApp.ZoomAll sset.Delete 'deletes the selection set Set sset = Nothing 'call by reference will set to nothing in calling program End Sub
Now to some extent, we have hidden the loops, we don’t have to duplicate them, and we can call them with simple programs. Here are some upper level calling programs. You will need to write your own according to the method and selection you want to use.
Sub erase_all() Dim sset As AcadSelectionSet Set sset = sset_all Call erase_ss(sset) End Sub Sub move_all(x1 As Double, y1 As Double) Dim sset As AcadSelectionSet Set sset = sset_all Call move_ss(sset, x1, y1) End Sub Sub scale_w(x1 As Double, y1 As Double, x2 As Double, y2 As Double, sc As Integer) 'scales from pt 0,0 Dim sset As AcadSelectionSet Set sset = sset_win(x1, y1, x2, y2) Call scale_ss(sset, 0, 0, sc) End Sub Sub mirror_all(pt1() As Double, pt2() As Double) Dim sset As AcadSelectionSet Set sset = sset_all Call mirror_ss(sset, pt1, pt2) End Sub
those get called rather simply by your top level, where you can see what you are doing without having to dive in to the details.
Call erase_all Call move_all (0,20) Call scale_w(-1, -1, 12, 9.5, sc) Call mirror_all(vt1, vt4)
when you draw with xy data starting at the origin, this is how you move and position the piece onto your drawing assembly or border.