Jump to content

Copy Object From Another Drawing and Paste it to a Specific Point


kunekainen

Recommended Posts

Hi there. I made a code which opens multiple dwg files in the active file directory and copy objects. But i have a problem, as usual:

 

Sub MergeDrawings()

   Dim CurrentFile As String
   Dim Path As String
   Dim ssMerge As AcadSelectionSet
   Dim maindrawing As AcadDocument
   Dim tempdrawing As AcadDocument
   Dim destEnts As Variant
   Dim sourceEnts() As AcadObject
   
   Set maindrawing = Application.ActiveDocument()
   
   Path = Application.ActiveDocument.Path()
          
   CurrentFile = Dir(Path + "\*.dwg", vbNormal)
   
   Do While CurrentFile <> ""
       
       If Path & "\" & CurrentFile = maindrawing.FullName() Then
           
           GoTo 98176
           
       End If
       
   
       Application.Documents.Open CurrentFile, False
       
       Set tempdrawing = Application.ActiveDocument()
       
       Set ssMerge = tempdrawing.SelectionSets.Add("SSMERGE03")
       ssMerge.Select acSelectionSetAll
                              
       ReDim sourceEnts(ssMerge.Count - 1)
       For i = 0 To ssMerge.Count - 1
           Set sourceEnts(i) = ssMerge(i)
       Next
       
             
       destEnts = tempdrawing.CopyObjects(sourceEnts, maindrawing.ModelSpace)
       
       ThisDrawing.Close False
       
98176   CurrentFile = Dir

       MsgBox ("done")
       
   Loop

End Sub

 

Actually it works but;

 

destEnts = tempdrawing.CopyObjects(sourceEnts,maindrawing.ModelSpace)

 

does not allow me to set insertion point. It just paste objects to their original position. I need to set lower left corner of the insertion point so i could add other drawings next to it.

 

Sorry for my English. Thanks in advance.

Link to comment
Share on other sites

some guessings

1) set each object-to-copy insertion points before adding it to sourceEnts()

2) set each copied object-insertion points after they've been added to destination file with something like:


destEnts = tempdrawing.CopyObjects(sourceEnts, maindrawing.ModelSpace)

dim myObj as AcadObject 

For i = 0 To ssMerge.Count - 1 

       Set myObj = sourceEnts(i) 

      ' add code to change myObj insertion point 

Next

 

some final notes (and guessings)

a) I saw form AutoCAD ActiveX and VBA reference that what you declared as "Variant" should be declared "Object". may be this doesn't affect the CopyObjects result, since you said that you got them in the new files. but just in case...

b) you set the "owner" as maindrawing.ModelSpace. which could sound like the default option. may be you could try to set it as the Tempdrawing.ModelSpace

Edited by RICVBA
clicked send post before I was done
Link to comment
Share on other sites

Thanks for your efforts and suggestions RICVBA. I struggled with the code last night and I somehow managed to do it. Before copying items from the tempdrawing, I move them to the point where I want. But there is a small problem, AutoCAD opens every drawing in Windows, so process takes too much time if there are too many drawings. I wonder if there is a way to "do things in the background". :D But this is not important, code does the job good enough for me.

 

Sub MergeDrawings()

   Dim CurrentFile As String
   Dim Path As String
   Dim ssMerge As AcadSelectionSet
   Dim maindrawing As AcadDocument
   Dim tempdrawing As AcadDocument
   Dim destEnts As Variant
   Dim sourceEnts() As AcadObject
   Dim tempEnt As AcadEntity
   
   Dim Extmin As Variant
   Dim Extmax As Variant
   
   Dim tempP1(2) As Double
   Dim tempP2(2) As Double
   
   'Define origin
   tempP1(0) = 0
   tempP1(1) = 0
   tempP1(2) = 0
   
   Set maindrawing = Application.ActiveDocument()
   
   'Set Drawing path
   Path = Application.ActiveDocument.Path()
   CurrentFile = Dir(Path + "\*.dwg", vbNormal)
   
   'Open Drawings
   Do While CurrentFile <> ""
         
       'Skip main drawing
       If Path & "\" & CurrentFile = maindrawing.FullName() Then
           
           GoTo 98176
           
       End If
       
       'Open temporary drawing for merge
       Application.Documents.Open CurrentFile, False
       Set tempdrawing = Application.ActiveDocument()
       
       'Regen for extent values
       maindrawing.Activate
       ThisDrawing.Regen (acAllViewports)
               
       Extmin = maindrawing.GetVariable("EXTMIN")
       Extmax = maindrawing.GetVariable("EXTMAX")
            
       'Set move distance
       d = Extmax(0) - Extmin(0)
       
       'Set destination move point
       tempP2(0) = d
       tempP2(1) = 0
       tempP2(2) = 0
                           
       tempdrawing.Activate
              
       Set ssMerge = tempdrawing.SelectionSets.Add("SSMERGE03")
       ssMerge.Select acSelectionSetAll
       
       'Move entities
       For Each tempEnt In ssMerge

           tempEnt.Move tempP1, tempP2

       Next
                              
       'Set array for copy
       ReDim sourceEnts(ssMerge.Count - 1)
       For i = 0 To ssMerge.Count - 1
           Set sourceEnts(i) = ssMerge(i)
       Next
             
       destEnts = tempdrawing.CopyObjects(sourceEnts, maindrawing.ModelSpace)
       
       ThisDrawing.Close False
       
98176   CurrentFile = Dir
       
   Loop
       
   ssMerge.Delete

End Sub

Link to comment
Share on other sites

so you already made it similarly to my "guessing" number 1)

 

as for the time issue I can point out the following

I) set AutoCAD Visible property to 'False' at the beginning of your macro

so you get rid of all those time consuming visualization efforts

and then remember to set that property back to 'True' before your macro ends

 

II) use ObjectDBX

as Seant recently remembered in this forum (http://www.cadtutor.net/forum/showthread.php?30302-VBA-code-for-length-of-selected-line&p=608193#post608193)

it should allow you to "use" drawings without having to open them in Autocad, since you work with their database (which is what every Autocad drawing really is)

Link to comment
Share on other sites

Yes it's pretty close your suggestion and it worked well. Actually Autocad.Visible property didn't differ much. I'll give ObjectDBX a try later.

 

Thanks again my friend. You and other people in this forum are very kind and helpful. I really appreciate for that.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...