kunekainen Posted September 16, 2014 Share Posted September 16, 2014 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. Quote Link to comment Share on other sites More sharing options...
RICVBA Posted September 17, 2014 Share Posted September 17, 2014 (edited) 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 September 17, 2014 by RICVBA clicked send post before I was done Quote Link to comment Share on other sites More sharing options...
kunekainen Posted September 17, 2014 Author Share Posted September 17, 2014 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". 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 Quote Link to comment Share on other sites More sharing options...
RICVBA Posted September 17, 2014 Share Posted September 17, 2014 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) Quote Link to comment Share on other sites More sharing options...
kunekainen Posted September 17, 2014 Author Share Posted September 17, 2014 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. Quote Link to comment Share on other sites More sharing options...
RICVBA Posted September 17, 2014 Share Posted September 17, 2014 I'll give ObjectDBX a try later. If you will post the results of your ObjectDBX efforts, I'll gladly share them. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.