Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
WCrihfield
in reply to: romu51

Hi @romu51.  Below is an iLogic rule you can try for that task.  I have not tested it yet myself, so I am not 100% sure if it will work yet, because WorkSurface is not one of the object types listed that we can use as input into the DrawingView.DrawingCurves property to get its curves.  If this fails, we may have to go an additional step (or few) deeper by exploring into the WorkSurface.SurfaceBodies property, if this is even possible.

oObj = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingViewFilter, "Select a Drawing View.")
If IsNothing(oObj) OrElse (TypeOf oObj Is DrawingView = False) Then Exit Sub
Dim oView As DrawingView = oObj
oView.IncludeSurfaceBodies = True
Dim oSheet As Inventor.Sheet = oView.Parent
oModelType = oView.ReferencedDocumentDescriptor.ReferencedDocumentType
If oModelType <> DocumentTypeEnum.kPartDocumentObject Then
	MsgBox("The view must be of a Part, not an Assembly, because only Parts have WorkSurfaces.",,"")
	Exit Sub
End If
Dim oViewPDoc As PartDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument
Dim oWSs As WorkSurfaces = oViewPDoc.ComponentDefinition.WorkSurfaces
If oWSs.Count = 0 Then
	MsgBox("There were no WorkSurfaces found in the Part in the selected view.",,"")
	Exit Sub
End If
Dim oObjCol As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
For Each oWS As WorkSurface In oWSs
	Dim oDCurves As DrawingCurvesEnumerator = Nothing
	Try : oDCurves = oView.DrawingCurves(oWS) : Catch : End Try
	If IsNothing(oDCurves) OrElse oDCurves.Count = 0 Then Continue For 'skip to next oWS
	For Each oDC As DrawingCurve In oDCurves
		Dim oDCSs As DrawingCurveSegments = oDC.Segments
		For Each oDCS As DrawingCurveSegment In oDCSs
			oObjCol.Add(oDCS)
		Next
	Next
Next
If oObjCol.Count = 0 Then Exit Sub
Dim oDDoc As DrawingDocument = oSheet.Parent
Dim oLayer As Inventor.Layer = Nothing
Dim oLayerCreated As Boolean = False
Try
	oLayer = oDDoc.StylesManager.Layers.Item("WorkSurface Curves")
Catch
	oLayer = oDDoc.StylesManager.Layers.Item(1).Copy("WorkSurface Curves")
	oLayerCreated = True
End Try
If oLayerCreated Then
	oLayer.Color = ThisApplication.TransientObjects.CreateColor(255, 0, 0) 'Pure Red
	oLayer.LineType = LineTypeEnum.kContinuousLineType
	'oLayer.LineWeight = .01 'in centimeters
	oLayer.Plot = True
	oLayer.Visible = True
	'oLayer.SaveToGlobal
End If
oSheet.ChangeLayer(oObjCol, oLayer)

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

Wesley Crihfield

EESignature

(Not an Autodesk Employee)