Search the Community

Hi, I am trying to copy a layer "DATE" from an old drawing file and then pasting to new drawing file. Following is the VBA code... Private Sub CommandButton1_Click() Dim oDoc As New AxDbDocument Dim nDoc As New AxDbDocument Dim newPath As String 'without layer and updated Dim oldPath As String 'to update UserForm1.Hide 'Call the copyLayer() CopyLayers newPath, oldPath End Sub Private Sub UserForm_Activate() oldPath = "E:\ACE\Testing\09Dec\oldFile.dwg" newPath = "E:\ACE\Testing\30Jan\newFile.dwg" savPath = "E:\ACE\Testing\09Dec\oldFile_Copy.dwg" End Sub 'To copy the Layers from newFile and pasting them to OldFile Public Sub CopyLayers(ByVal newFile As String, ByVal oldFile As String) Dim oDbx As Object 'To update i.e OLD FILE Dim nDbx As Object 'Updated i.e NEW FILE Dim olayer As AcadLayer Dim i As Integer With ThisDrawing.Application Set nDbx = .GetInterfaceObject("ObjectDBX.AxDbDocument.18") End With nDbx.Open FileName:=newFile 'Copying the Layers from Updated File i.e NEW FILE Dim copyLay() As Object For Each olayer In nDbx.Layers If UCase(olayer.Name) = "DATE" Then ReDim Preserve copyLay(i) Set copyLay(i) = olayer 'MsgBox olayer.Name i = i + 1 End If Next 'MsgBox i Dim idPairs As Variant 'Dim copyObj As Variant 'Opening the NEW FILE to copy the Layer With ThisDrawing.Application Set oDbx = .GetInterfaceObject("ObjectDBX.AxDbDocument.18") End With oDbx.Open FileName:=oldFile nDbx.CopyObjects copyLay, ThisDrawing.Application.ActiveDocument.ModelSpace, idPairs oDbx.SaveAs savPath Set oDbx = Nothing Set nDbx = Nothing End Sub There no error, but my old file is not getting updated.. !! Whats wrong with this code??? Regards JB