Trouble with CopyObjects and dimension annotations

Trouble with CopyObjects and dimension annotations

PeetCAD
Contributor Contributor
1,115 Views
1 Reply
Message 1 of 2

Trouble with CopyObjects and dimension annotations

PeetCAD
Contributor
Contributor

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. 

0 Likes
Accepted solutions (1)
1,116 Views
1 Reply
Reply (1)
Message 2 of 2

PeetCAD
Contributor
Contributor
Accepted solution

After some test I found a solution and used the InsertBlock method instead, pointing to the drawings that I need to import to my model space.

 

Cheers 😊 


0 Likes