Copying specific things from model space into a new document

Copying specific things from model space into a new document

Anonymous
Not applicable
883 Views
1 Reply
Message 1 of 2

Copying specific things from model space into a new document

Anonymous
Not applicable

So I have a drawing with multiple rectangles in it.  Based on user input I want to copy a certain rectangle and put it into a new drawing.  For example if the user tells me 18 x 72 I want to copy the rectangle that is 18 x 72 and so on.  I know the user input part I just need to figure out how i can copy certain things using vba.  I have tried a lisp and then used sendcommand but that works once and then I have to close autocad to run my program again.  I have read that using sendcommand should be avoided at all costs, so I am here.  Please help!

0 Likes
884 Views
1 Reply
Reply (1)
Message 2 of 2

grobnik
Collaborator
Collaborator

Hi @Anonymous ,

if rectangle is  Polyline, I have code for selecting all object inside a closed polyline, for next step as paste in new document, I have to test but shall be no a big problem I guess.

Here the code just to selecting polyline and get object.

I'll try later to paste in a new doc.

 

 

Sub test_pl()
Dim oEnt As AcadEntity
Dim Pt(0 To 2) As Double
Dim oLWP As AcadLWPolyline
Dim oP As AcadPolyline
Dim dblNewCords As Variant
Dim ssetObj As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets.Item("TEST_SSET2").Delete

ThisDrawing.Utility.GetEntity oEnt, Pt, "Select a polyline"
Set oLWP = oEnt
dblCurCords = oLWP.Coordinates
iMaxCurArr = UBound(dblCurCords)
iMaxNewArr = ((iMaxCurArr + 1) * 1.5) - 1
ReDim dblNewCords(iMaxNewArr) As Double
iCurArrIdx = 0: iCnt = 1
For iNewArrIdx = 0 To iMaxNewArr
If iCnt = 3 Then
dblNewCords(iNewArrIdx) = 0
iCnt = 1
Else
dblNewCords(iNewArrIdx) = dblCurCords(iCurArrIdx)
iCurArrIdx = iCurArrIdx + 1
iCnt = iCnt + 1
End If
Next

Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET2")
ssetObj.SelectByPolygon acSelectionSetCrossingPolygon, dblNewCords
MsgBox ssetObj.Count
' ssetObj contains all objects inside the polyline.
End Sub