Message 1 of 2
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello,
I am trying to combine the model space of a set of opened drawing through VBA and for that I am using the CopyObjects method.
There is a first part where I set de insertion point for the future copied objects and then I get all the objects from document.ModeSpace.Item in an array for the CopyObjects method.
It all works but it results in objects without their dimension annotations... Any idea or help on that ?
PS: all the drawings to copy must be opened and the new drawing where we copy the element must be open too and named "Combined drawing.dwg"
PS2: I am new to VBA on Autocad but not to VBA.
Here is my code at that point:
Sub CopyModel()
Dim oL As AcadLayout
Dim cobj As Variant
Dim odoc As AcadDocument
Dim combDWG As AcadDocument
Dim sourceEnts() As AcadObject
Dim destEnts() As AcadObject
Dim CopyBlock As AcadBlockReference
Dim InputPoint As Variant
Dim Extmin As Variant, Extmax As Variant
Dim tempP1(2) As Double, tempP2(2) As Double
'Def origin and init P2
For i = 0 To 1
tempP1(i) = 0
tempP2(i) = 0
Next
''Get the drawing where we combine the modelspace''
For Each odoc In Application.Documents 'Go through all the opened drawings
If odoc.Name = "Combined drawing.dwg" Then
Set combDWG = odoc
End If
Next
''Go through all the opened drawings''
For Each odoc In Application.Documents
If odoc.Name <> "Combined drawing.dwg" Then
''Bounding box of actual model in combine file''
combDWG.Activate
ThisDrawing.Regen (acActiveViewport)
''Setting Model layout as active layout''
For Each oL In combDWG.Layouts
If oL.Name = "Model" Then
combDWG.ActiveLayout = oL
End If
Next
Extmin = combDWG.GetVariable("EXTMIN")
Extmax = combDWG.GetVariable("EXTMAX")
'Set move distance
d = Extmax(0) - Extmin(0)
'Set destination move point
tempP2(0) = d + tempP2(0)
tempP2(1) = 0
tempP2(2) = 0
odoc.Activate
''Setting Model layout as active layout''
For Each oL In odoc.Layouts
If oL.Name = "Model" Then
odoc.ActiveLayout = oL
End If
Next
''Set array for copy
ReDim sourceEnts(odoc.ModelSpace.Count - 1)
ReDim destEnts(odoc.ModelSpace.Count - 1)
For i = 0 To odoc.ModelSpace.Count - 1
Set sourceEnts(i) = odoc.ModelSpace.Item(i)
Next
Dim newgroup As AcadGroup
Dim orPt(2) As Double
orPt(0) = 0
orPt(1) = 0
orPt(2) = 0
''Copy to combine file
For Each oL In combDWG.Layouts
If oL.Name = "Model" Then
combDWG.ActiveLayout = oL
End If
Next
destEnts = odoc.CopyObjects(sourceEnts, combDWG.ModelSpace)
''Move object once copied in the combined file
For Each cobj In destEnts
cobj.Move tempP1, tempP2
Next
End If
Next
End Sub
Thank you !
Peter A.
Solved! Go to Solution.