Include a Part Work Point Feature in a Drawing View Using VBA

[Anonymous]

Does anyone have a vba routine that will perform a part selection in a drawing view and add the "CenterPoint" Work Point of that selected part in a drawing view?

Thanks,

Mike

[HideoYamada]

Hi Mike,

---

@Anonymous wrote:

Does anyone have a vba routine that will perform a part selection in a drawing view and add the "CenterPoint" Work Point of that selected part in a drawing view?

---

Select a drawing view and then execute this code.

Sub AddCentermak()
    Dim oDrawingDoc As DrawingDocument: Set oDrawingDoc = ThisApplication.ActiveDocument
    Dim oSheet As Sheet: Set oSheet = oDrawingDoc.ActiveSheet
    Dim oDrawingView As DrawingView: Set oDrawingView = oDrawingDoc.SelectSet(1)
    Dim oPartDoc As PartDocument: Set oPartDoc = oDrawingView.ReferencedDocumentDescriptor.ReferencedDocument

    Dim oWorkPoint As WorkPoint
    For Each oWorkPoint In oPartDoc.ComponentDefinition.WorkPoints
        oSheet.Centermarks.AddByWorkFeature oWorkPoint, oDrawingView
    Next oWorkPoint
End Sub

=====

Freeradical

 Hideo Yamada

[Anonymous]

Here is my code. The only thing that does not seem to work is the last line (not the End Sub). Any help would be grateful. Thanks,

Mike

Sub DrawingTest()

Dim InvDwgDoc As DrawingDocument
Set InvDwgDoc = ThisApplication.ActiveDocument

Dim oSheet As Sheet
Set oSheet = InvDwgDoc.ActiveSheet

Event1:
Dim oDrawingView As DrawingView
Set oDrawingView = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingViewFilter, "PICK A DRAWING VIEW")

Event2:
Dim oPartLine As DrawingCurveSegment
Set oPartLine = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingCurveSegmentFilter, "PICK A LINE ON YOUR PART")

Dim oPartLineParent As DrawingCurve
Set oPartLineParent = oPartLine.Parent

Dim oModelGeo As Object
Set oModelGeo = oPartLineParent.ModelGeometry

Dim oParent As Object
Set oParent = oModelGeo.Parent.Parent

Dim oRDD As PartDocument
Set oRDD = oParent.ReferencedDocumentDescriptor.ReferencedDocument

Dim oWP As WorkPoint
Set oWP = oRDD.ComponentDefinition.WorkPoints.Item(1)

oSheet.Centermarks.AddByWorkFeature oWP, oDrawingView

End Sub

[HideoYamada · Accepted solution]

Hi,

It seems that you are treating assembly document.

The following code supports a view of an assembly document.

Sub AddCentermak()
    Dim oDrawingDoc As DrawingDocument: Set oDrawingDoc = ThisApplication.ActiveDocument
    Dim oSheet As Sheet: Set oSheet = oDrawingDoc.ActiveSheet
    
    Dim oPartLine As DrawingCurveSegment
    Set oPartLine = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingCurveSegmentFilter, "PICK A LINE ON YOUR PART")

    Dim oDrawingView As DrawingView
'    Set oDrawingView = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingViewFilter, "PICK A DRAWING VIEW")
    Set oDrawingView = oPartLine.Parent.Parent ' DrawingCurveSegment -> DrawingCurve -> DrawingView

    Dim oRefDocOfView As Document
    Set oRefDocOfView = oDrawingView.ReferencedDocumentDescriptor.ReferencedDocument

    Dim oWorkPoint As WorkPoint
    If TypeOf oRefDocOfView Is PartDocument Then
        For Each oWorkPoint In oRefDocOfView.ComponentDefinition.WorkPoints
            oSheet.Centermarks.AddByWorkFeature oWorkPoint, oDrawingView
        Next oWorkPoint
    ElseIf TypeOf oRefDocOfView Is AssemblyDocument Then
        Dim occ As ComponentOccurrence
        Set occ = oPartLine.Parent.ModelGeometry.ContainingOccurrence ' DrawingCurveSegment -> DrawingCurve -> EdgeProxy -> ComponentOccurrence(Proxy)
        For Each oWorkPoint In occ.Definition.WorkPoints
            Dim oWorkPointProxy As WorkPointProxy
            occ.CreateGeometryProxy oWorkPoint, oWorkPointProxy
            oSheet.Centermarks.AddByWorkFeature oWorkPointProxy, oDrawingView
        Next oWorkPoint
    End If
End Sub

=====

Freeradical

 Hideo Yamada

[AlexFielder]

Thanks for sharing this rule, you helped me out of a bind. By way of thanks, here is the rule I built around the last part of your solution @HideoYamada :

option explicit on
Sub Main()
	Dim ThisDrawingDoc As DrawingDocument = ThisDoc.Document
	Dim ActiveDrawingSheet As Sheet = ThisDrawingDoc.ActiveSheet
	Dim MainDrawingView As DrawingView = ActiveDrawingSheet.DrawingViews(1)

	Dim ReferencedFrameAssemblyDescriptor As DocumentDescriptor = MainDrawingView.ReferencedDocumentDescriptor
	Dim FrameAssembly As AssemblyDocument
	Dim FrameAssemblyDef As AssemblyComponentDefinition
	
	If Not TypeOf ReferencedFrameAssemblyDescriptor.ReferencedDocument Is AssemblyDocument Then
		Logger.Error("What the heck happened?")
		Exit Sub
	Else
		FrameAssembly = ReferencedFrameAssemblyDescriptor.ReferencedDocument
		FrameAssemblyDef = FrameAssembly.Componentdefinition
	End If
	
	Dim FrameMembersCollection As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
Break	
	For Each compOcc As ComponentOccurrence In FrameAssemblyDef.Occurrences.AllLeafOccurrences
		If TypeOf compOcc.Definition.Document Is PartDocument Then
			Try
				If iProperties.Value(IO.Path.GetFileName(compOcc.Definition.Document.FullFileName), "Custom", "CountOfStaples") IsNot Nothing Then
					Dim partCompDef As PartComponentDefinition = compOcc.Definition
					For Each StapleWorkPoint As WorkPoint In partCompDef.WorkPoints
						If StapleWorkPoint IsNot partCompDef.WorkPoints(1) Then
							Dim StapleWPProxy As WorkPointProxy
							compOcc.CreateGeometryProxy(StapleWorkPoint, StapleWPProxy)
				            ActiveDrawingSheet.Centermarks.AddByWorkFeature(StapleWPProxy, MainDrawingView)
						End If
			        Next
				End If
			Catch 'if a partdocument DOESN'T have CountOfStaples custom iProperty
				Continue For
			End Try
		End If
	Next
	
End Sub

Cheers,

Alex.