---

Guten Morgen zusammen,
ich wollte mal FRagen ob jemand zeit hat mir mit einem Makro auszuhelfen. Und zwar habe ich mir eine vorhandened Makro so angepasst, dass es mir Bauteile mit bestimmter Farbe auf der Zeichung gestrichelt Darstellt. Folgenden Wunsch habe ich noch weiss aber leider nicht wie ich ihn umsetzen kann. Das Makro soll abprüfen of sich die Zeichnungsansicht in einer bestimmten Ansicht "Ref Darstellung" befindet- Nur dann sollten die Bauteile /Baugruppe mit der zugewiesenen Farbe auf die gestrichelte Darstellung umgestellt werden. Befindet sich die Bauteile / Baugruppe in einer anderen Darstellung sollen die normalen Layer dargestellt werden?

Anbei das Makro:

Public Sub ChangeLayerOfOccurrenceCurves()
' Get the active drawing document.
Dim drawDoc As DrawingDocument
Set drawDoc = ThisApplication.ActiveDocument

Dim drawView As DrawingView
For Each drawView In drawDoc.ActiveSheet.DrawingViews

Dim docDesc As DocumentDescriptor
Set docDesc = drawView.ReferencedDocumentDescriptor

' Verify that the selected drawing view is of an assembly.
If docDesc.ReferencedDocumentType <> kAssemblyDocumentObject Then
MsgBox "The selected view must be of an assembly."
Exit Sub
End If

' Get the component definition for the assembly.
Dim asmDef As AssemblyComponentDefinition
Set asmDef = docDesc.ReferencedDocument.ComponentDefinition

' Process the occurrences, wrapping it in a transaction so the
' entire process can be undone with a single undo operation.
Dim trans As Transaction
Set trans = ThisApplication.TransactionManager.StartTransaction(drawDoc, "Change drawing view Layer")

' Call the recursive function that does all the work.
Call ProcessAssemblyColor(drawView, asmDef.Occurrences)
trans.End

Next
End Sub

Private Sub ProcessAssemblyColor(drawView As DrawingView, Occurrences As ComponentOccurrences)
' Iterate through the current collection of occurrences.
Dim occ As ComponentOccurrence
Dim sLayer As String
For Each occ In Occurrences

' Check to see if this occurrence is a part or assembly.
If occ.DefinitionDocumentType = kAssemblyDocumentObject Then

' ** It's an assembly so process the BOM structure

sLayer = ""

Select Case occ.ActiveDesignViewRepresentation
Case occ.ActiveDesignViewRepresentation: sLayer = "Referenz"

End Select

If sLayer <> "" Then

' Get the TransientsObjects object to use later.
Dim transObjs As TransientObjects
Set transObjs = ThisApplication.TransientObjects

' Verify that a layer "Referenz" exists
Dim layers As LayersEnumerator
Set layers = drawView.Parent.Parent.StylesManager.layers

Dim drawDoc As DrawingDocument
Set drawDoc = drawView.Parent.Parent

On Error Resume Next
Dim oLayer As Layer
Set oLayer = layers.Item(sLayer)

If Not oLayer Is Nothing Then
' Get all of the curves associated with this occurrence.
On Error Resume Next
Dim drawcurves As DrawingCurvesEnumerator
Set drawcurves = drawView.DrawingCurves(occ)
If Err.Number = 0 Then
On Error GoTo 0

' Create an empty collection.
Dim objColl As ObjectCollection
Set objColl = transObjs.CreateObjectCollection()

' Add the curve segments to the collection.
Dim drawCurve As DrawingCurve
For Each drawCurve In drawcurves
Dim segment As DrawingCurveSegment
For Each segment In drawCurve.Segments
objColl.Add segment
Next
Next

' Change the layer of all of the segments.
Call drawView.Parent.ChangeLayer(objColl, oLayer)
End If
End If
On Error GoTo 0
End If
Else
' It's an assembly so process its contents.
Call ProcessAssemblyColor(drawView, occ.SubOccurrences)
End If
Next
End Sub

Danke schon mal im voraus

MfG

------------------
MFG

BlueJay

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP