Copy views with childs to a new document in vba

[Anonymous]

Hello!

I would need to copy the selected view AND ALL HIS AUXILIARY VIEWS to a new file using vba.

Unfortunately this code is only copying the main view leaving all the childs behind:

oDrawingView.CopyTo( oDocTemp.ActiveSheet)

I also tried to select all the views including the child, and do the move for each view in the selection. It worked, but the views lost the connection to the main view, and became all main views instead of main/child views.

How can this be done in VBA?

thank you

best regards

Igor

[bradeneuropeArthur]

hi,

Copy the complete sheet!

[Anonymous]

Thanks, but this is not what i need.. 

I dohave multiple items on a page, and only need to copy the views associated with the selected view.

Selecting them by hand and doing ctrl+C ctrl+V works. But I would need to do it automatically.. 

What I am trying to do is to take the selected views, copy them to another temporary file, replace the references with a new file, and now copy them back.

[Anonymous]

shouldn't everything that can be done by hand also be possible through VBA?

[bradeneuropeArthur]

Yes,

It can.

But need a little time to program this.

[Anonymous]

Ok thanks!

In fact my whole tool is already programmed, the only missing part is the copying of the views to the new sheed with the childs all toghether...

Best regards

Igor

[bradeneuropeArthur]

Please provide the code than.
We will add only the missing things.

[Anonymous]

Sure!

Here it is:

Public Sub Main()
 doc = ThisDoc.Document
 Dim oFD As FileDescriptor



	
 If doc.SelectSet.Count = 0 Then
 
 MsgBox("Mindestens eine Ansicht auswählen!")
 Else
 	
	
Dim oDrawingView As DrawingView
	
Dim oDrawingViewtemp As DrawingView
oDrawingView = Doc.SelectSet.Item(1)
	
		Dim strFileToOpen As String
		strFileToOpen = OpenFileDLG()
		
		If strFileToOpen <> "" Then
			
		Dim oDocTemp As Inventor.DrawingDocument
		oDocTemp = ThisApplication.Documents.Add(kDrawingDocumentObject, , True)
		
		For Each oDrawingView In Doc.selectset
			
		oDrawingView.CopyTo( oDocTemp.ActiveSheet)
		Next
			
	
		oDocTemp.Activate
		oDrawingViewtemp = oDocTemp.ActiveSheet.DrawingViews(1)
		
				Dim oRefFileDesc As ReferencedFileDescriptor
				oRefFileDesc = oDrawingViewtemp.ReferencedFile
				
				oFD = oRefFileDesc.DocumentDescriptor.ReferencedFileDescriptor
				oFD.ReplaceReference(strFileToOpen)
				oDocTemp.Update2
						
				For Each oDrawingViewtemp In oDocTemp.ActiveSheet.DrawingViews
					Call oDrawingViewtemp.Moveto(doc.ActiveSheet)
					
				Next
				
				
				
				Call oDocTemp.Close(True)
				Call doc.Activate

				doc.Update2
				iLogicVb.UpdateWhenDone = True


		End If
	
 End If

 
 End Sub
 
 
 
 
 Public Function OpenFileDLG()

    ' Set a reference to the DesignProjectManager object.
    Dim oDesignProjectMgr As DesignProjectManager
    oDesignProjectMgr = ThisApplication.DesignProjectManager
    'current workspace path
    Dim sPath As String
    sPath = oDesignProjectMgr.ActiveDesignProject.WorkspacePath

		If Not Dir(sPath & "\Konstruktionszeichnungen", vbDirectory) = "" Then
		sPath = sPath & "\Konstruktionszeichnungen"
		End If

    Dim oFileDlg As FileDialog
    Call ThisApplication.CreateFileDialog(oFileDlg)

    oFileDlg.Filter = "Inventor Files (*.iam;*.ipt)|*.iam;*.ipt|All Files (*.*)|*.*"

    oFileDlg.FilterIndex = 1

    oFileDlg.DialogTitle = "Ersatzdatei Wählen"

    oFileDlg.InitialDirectory = sPath   '"C:\Temp"

    ' Set the flag so an error will be raised if the user clicks the Cancel button.
    oFileDlg.CancelError = True

    On Error Resume Next
    oFileDlg.ShowOpen

    If Err.Number <> 0 Then
	   Return ""
    ElseIf oFileDlg.FileName <> "" Then
       Return  oFileDlg.FileName
    End If
End Function

[Anonymous]

Hello Braden,

did you have a chance to have a look at this?

Thanks

Best regards

Igor

[bradeneuropeArthur]

Hi,

At took a look at it.

But I need to program it in my "scarce" free time.

So I will try doing it if time is there, ok?

[Anonymous]

Sure!

Thank you!

Best regards

[bradeneuropeArthur]

Hi,

Here is some idea, but I need to fine-tune it a little.

But I am working on it.

Public Sub dwgViewCopy()

Dim a As Application
Set a = ThisApplication

Dim b As DrawingDocument
Set b = a.ActiveDocument

Dim sh As Sheet
Set sh = b.Sheets.Item(1)

Dim v As DrawingView
Set v = sh.DrawingViews.Item(1)
'MsgBox v.Name & "1"
Call v.CopyTo(b.Sheets.Item(2))
sh.Activate
Dim v1 As DrawingView
For Each v1 In sh.DrawingViews

On Error Resume Next
If v1.ParentView.Name = v.Name Then
'MsgBox v1.ParentView.Name & "2"
Call v1.CopyTo(b.Sheets.Item(2))
'sh.Activate
End If

Next

End Sub

[Anonymous]

thanks, will test it asap... but I think I already tried a similar version, and the problem was that the chile views became indipendent parent views, and were not connected to the main view anymore.. will test it and let you know..

[NachoShaw]

No it cant.

There are known limitations that prevent some functions being carried out purely by code. Design View representation being one. You can add / delete but not get a list of (unless they have fixed the issue recently which i very much doubt...)

[Anonymous]

ok, and what about selecting them by hand and then copy all toghether?  would it work? the copy functin copies one at the time, thus it looses the parent child connection..

[Anonymous]

so would it at least be possible to copy all the selected views to another sheet without losing the parent/child relation?

thanks!

[marcin_bargiel]

Is this possible in inv. 2022?

copy view with child view (section or detail etc. )

[WCrihfield]

I was trying this using an iLogic rule, simply because it's quicker & easier for me to test stuff there.  So far though, it's just another case of 'almost there'.  I can copy the set of related views just fine, all day long, but it's the pasting on the other document's sheet part that's been evading me.  I keep pasting a new sheet to the other drawing, instead of pasting the views, for some reason.  I definitely confirm that I have copied the views and not the sheet, but it's just mussing a step on the side of the other document.  When done manually, I pretty much have to click somewhere on the sheet area before it will let me paste those views.  Before that click, it won't let me paste them correctly.  That's the missing link in this process.

Here is the iLogic code I started, but the last part of the Sub Main area is where that missing step needs to be added in there, and maybe something else altered.  The custom Function is working just fine.  The top portion of the Sub Main code is just fine...just puts the parent view and its child views into an ObjectCollection, then puts that ObjectCollection into the SelectSet, so that it is 'selected'.  Then copies them to Inventor's session memory (or Clipboard or something).  Then the last part of the Sub Main code creates the other/new drawing document that we want to copy those views into.  That part is just fine too, because I can do that part manually too between pasting views, and it also works just fine.  It's what to do next that is stumping me right now.  It seems like I may need to somehow simulate a mouse click somewhere on that new document's sheet area, before using the paste command, otherwise the paste part will not work.  The same is true when doing it manually.

Sub Main
	'get the 'local' drawing (or one that was active when rule started)
	oDDoc = ThisDrawing.Document
	oSourceSheet = oDDoc.ActiveSheet
	oViews = oSourceSheet.DrawingViews
	oDDoc.SelectSet.Clear
	'get first view with no parent view, but has child views
	For Each oView As DrawingView In oViews
		If IsNothing(oView.ParentView) Then
			oChildViews = GetChildViewsOnSameSheet(oView)
			If oChildViews.Count = 0 Then Continue For
			'MsgBox("oChildViews.Count = " & oChildViews.Count,,"")
			'found that view, now process it and its child views
			'add that parent view to the ObjectCollection
			oChildViews.Add(oView)
			'add that ObjectCollection to the SelectSet
			oDDoc.SelectSet.SelectMultiple(oChildViews)
			'now execute a command to copy them (to the Clipboard)
			ThisApplication.CommandManager.ControlDefinitions.Item("AppCopyCmd").Execute2(False)
			Exit For 'don't process more views
		End If
	Next
	
	'create a new drawing document
	Dim oTempDDoc As DrawingDocument = ThisApplication.Documents.Add(DocumentTypeEnum.kDrawingDocumentObject, , True)
	oTempDDoc.SelectSet.Clear
	'oNode = oTempDDoc.BrowserPanes.Item("Model").GetBrowserNodeFromObject(oTempDDoc.ActiveSheet)
	oTempDDoc.SelectSet.Select(oTempDDoc.ActiveSheet)
	oTempDDoc.SelectSet.Clear
	'then activate the oTempSheet
	'oTempSheet.Activate
	'then execute a command to paste those views to it
	ThisApplication.CommandManager.ControlDefinitions.Item("AppPasteCmd").Execute '.Execute2(False)
End Sub

Function GetChildViewsOnSameSheet(oDView As DrawingView) As ObjectCollection
	oCViews = ThisApplication.TransientObjects.CreateObjectCollection
	oSheet = oDView.Parent
	For Each oView As DrawingView In oSheet.DrawingViews
		If oView Is oDView Then Continue For
		If IsNothing(oView.ParentView) Then Continue For
		If oView.ParentView Is oDView Then
			oCViews.Add(oView)
		End If
	Next
	Return oCViews
End Function

If this solved your problem, or answered your question, please click ACCEPT SOLUTION.
Or, if this helped you, please click (LIKE or KUDOS) 👍.

If you want and have time, I would appreciate your Vote(s) for My IDEAS 💡 or you can Explore My CONTRIBUTIONS

[marcin_bargiel]

Thank You.

I managed to do it in a slightly different way.