Using Move, Copy with AcadSelectionSet

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.

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s