01-02-2024
03:07 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
01-02-2024
03:07 AM
with this code you can step through each Partlist row and have the Occurrences marked blue.
Maybe it helps you a bit.
Sub Main() Dim oDoc As Document = ThisDoc.Document If oDoc.DocumentType <> kDrawingDocumentObject Then: MsgBox("Run in drawings only!"): Exit Sub: End If Dim oSheet As Sheet = oDoc.ActiveSheet If oSheet Is Nothing Then: MsgBox("Only valid for dwg files with sheets!"): Exit Sub: End If If oSheet.PartsLists.Count <> 1 Then: MsgBox("Only valid for sheets with 1 PartsList"):Exit Sub: End If Dim oPL As PartsList = oSheet.PartsLists(1) If oPL.PartsListRows.Count < 1 Then: MsgBox("Only valid for partslists with actual rows"): Exit Sub: End If If oSheet.Balloons.Count < 1 Then : MsgBox("Rule only valid for sheets with balloons!") : Exit Sub : End If Dim oAsmDoc As AssemblyDocument = ThisApplication.ActiveDocument.ReferencedDocuments.Item(1) Dim oAsmDef As AssemblyComponentDefinition = oAsmDoc.ComponentDefinition Dim oview As DrawingView=oDoc.ActiveSheet.DrawingViews.item(2) Dim oDoc1 As Document Dim oSet As HighlightSet oSet = oDoc.CreateHighlightSet oview = ThisApplication.CommandManager _ .Pick(kDrawingViewFilter, "Select a drawing view.") Dim Oocc As ComponentOccurrence For Each oRow In oPL.PartsListRows oDoc1 = oRow.ReferencedFiles.Item(1).ReferencedDocument For Each Oocc In oAsmDef.Occurrences.AllReferencedOccurrences(oDoc1) Dim oCurveUnum As DrawingCurvesEnumerator oCurveUnum = oview.DrawingCurves(Oocc) Dim oCurve As DrawingCurve Dim oSegment As DrawingCurveSegment 'add segments to collection to be moved to required layer For Each oCurve In oCurveUnum For Each oSegment In oCurve.Segments Try oSet.AddItem(oSegment) Catch Continue For End Try Next Next Next Dim oColor As Color oColor = ThisApplication.TransientObjects.CreateColor(0, 0, 255) oSet.Color = oColor MsgBox("ok?") oSet.Clear() Next End Sub