---

mit Hilfe dieses Makros soll die 3DSkizze eines Bauteils der gewählten Ansicht angezeigt werden "einschliessen". funktioniert zum Teil
der Fehler: es wird die Skizze des zuletzt plazierten Teils in der gewählten Ansicht eingefügt und nicht die Skizze das in der Ansicht referenzierten Bauteils. bin immer darauf angewiesen das Makro direkt nach dem Plazieren der Ansicht auszuführen. was nicht schlimm ist aber ein Schönheitsfehler.
der Fehler liegt natürlich bei  oDoc.ReferencedDocuments.Item(1).ComponentDefinitions.Item(1).Sketches3D.Item(1)
ich müsste eigentlich ReferencedDocuments von oselect ansprechen aber das bekomme ich nicht hin.
Jemand eine Lösung?

Code:
Sub Einschließen()

Dim oDoc As Inventor.DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oSelect As SelectSet
Set oSelect = oDoc.SelectSet
If oSelect.Count = 0 Then
    MsgBox "Ansicht vorher wählen!"
    GoTo ende
End If

Set oaktiv = oSelect.Item(1)
Dim skizze As Sketch3D

Auswahl = MsgBox("3D Skizze anzeigen?", vbYesNoCancel)
If Auswahl = vbCancel Then GoTo ende
If Auswahl = vbYes Then

    Set skizze = oDoc.ReferencedDocuments.Item(1).ComponentDefinitions.Item(1).Sketches3D.Item(1)
    Call oaktiv.SetIncludeStatus(skizze, True)

Else

    Set skizze = Nothing
    Set skizze = oDoc.ReferencedDocuments.Item(1).ComponentDefinitions.Item(1).Sketches3D.Item(1)
    Call oaktiv.SetIncludeStatus(skizze, False)

End If
ende:

End Sub

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

---

Hallo Zusammen,

ich muss noch einmal diesen alten Beitrag wiederbeleben, um den Anwendungsfall für meine Zwecke umzubauen.
Ich möchte die 3D-Skizze des Sweeps einer Rohrleitung autmoatisch auf der Zeichnung als Strich-Punkt-Linie anziegen lassen, um mir das umständliche Einfügen der Mittellinien in der Zeichnungsoberfläche zu ersparen. Die Rohrleitung ist ein skizzierter "Ring", der durch eine 3D-Skizze "gesweept" wird.

Ich habe versucht mir den vorangestellten Sub als iLogic umzumodeln, bin aber mit meinem laienhaften Verständnis nicht weitergekommen:

Dim oDoc As Inventor.DrawingDocument
oDoc = ThisApplication.ActiveDocument
Dim oSelect As SelectSet
oSelect = oDoc.SelectSet
If oSelect.Count = 0 Then
    MsgBox ("Ansicht vorher wählen!",0,"Ansicht wählen")
    GoTo ende
End If

oaktiv = oSelect.Item(1)
Dim skizze As Sketch3D

skizze = oDoc.ReferencedDocuments.Item(1).ComponentDefinitions.Item(1).Sketches3D.Item(1)
Call oaktiv.SetIncludeStatus(skizze, True)

ende:

Schlussendlich soll noch eine for-Schleife Einzug erhalten, damit alle ausgewählten Ansichten nach der 3D-Skizze durchforstet werden und dementsprechend mit eingeschlossen werden. Habe in anderen Beiträgen auch den vielleichten passenderen Befehl " Call DravingView.SetIncludeStatus(xxx(n), True) entdeckt, konte diesen aber noch nicht sinnvoll einsetzen.

Vielleicht hat jemand eine fixe Idee, wie das schnell umzusetzen ginge? Danke schonmal.

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

---

Moin

Es wäre besser, wenn die 3D-Skizze benannt ist. Sich darauf zu verlassen, dass es immer die erste 3D-Skizze ist, kann schief gehen.
Ich hab die Alternative als Kommentar dazu geschrieben.

Code:

---

Option Explicit On
If Not ThisDoc.Document.DocumentType = DocumentTypeEnum.kDrawingDocumentObject Then
    MsgBox("Funktion nur in Zeichnungen verfügbart.", MsgBoxStyle.Exclamation, "iLogic")
    Exit Sub
End If

Dim oDrawDoc As DrawingDocument = ThisDrawing.Document
Dim oSheet As Sheet = oDrawDoc.ActiveSheet
Dim oView As DrawingView
For Each oView In oSheet.DrawingViews
    If oView.ViewType=DrawingViewTypeEnum.kStandardDrawingViewType _
        Or oView.ViewType=DrawingViewTypeEnum.kDefaultDrawingViewType _
        Or oView.ViewType=DrawingViewTypeEnum.kProjectedDrawingViewType Then
        If oView.ReferencedDocumentDescriptor.ReferencedDocumentType = DocumentTypeEnum.kPartDocumentObject Then
            Dim oDoc As PartDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument
            If oDoc.ComponentDefinition.Sketches3D.Count > 0 Then
                Dim oSketch3D As Sketch3D = oDoc.ComponentDefinition.Sketches3D(1) 'oDoc.ComponentDefinition.Sketches3D("Name_der_Skizze")
                oView.SetIncludeStatus(oSketch3D, True)
                If oView.GetVisibility(oSketch3D) = False Then
                    oView.SetVisibility(oSketch3D, True)
                End If
            End If
        End If
    End If
Next

---

------------------
MfG
Ralf

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

---

Das funktioniert im Grunde schon ganz gut. Danke für die schnelle Hilfe.

Jetzt ist die Frage, ob die projizierte Linie auch in Strich-Punkt umgewandelt werden kann?!

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

---

Moin

Einfache Variante, man ändert im Layer "3D Skizziergeometrie (ISO)", auf dem die Skizzenlinien normalerweise landen den Linientyp.
Etwas aufwändiger, man baut sich einen eigenen Layer, holt sich alle Skizzenlinien und schiebt sie auf den Layer:

Code:

---

Option Explicit On
Sub Main
    If Not ThisDoc.Document.DocumentType = DocumentTypeEnum.kDrawingDocumentObject Then
        MsgBox("Funktion nur in Zeichnungen verfügbart.", MsgBoxStyle.Exclamation, "iLogic")
        Exit Sub
    End If
   
   
    Dim oDrawDoc As DrawingDocument = ThisDrawing.Document
   
    Dim oTrans As Transaction = ThisApplication.TransactionManager.StartTransaction(oDrawDoc, "iLogic Sweepskizze abrufen")
   
    Dim oSheet As Sheet = oDrawDoc.ActiveSheet
    Dim oView As DrawingView
    For Each oView In oSheet.DrawingViews
        If oView.ViewType=DrawingViewTypeEnum.kStandardDrawingViewType Or _
          oView.ViewType=DrawingViewTypeEnum.kDefaultDrawingViewType Or _
          oView.ViewType=DrawingViewTypeEnum.kProjectedDrawingViewType Then
            If oView.ReferencedDocumentDescriptor.ReferencedDocumentType = DocumentTypeEnum.kPartDocumentObject Then
                Dim oDoc As PartDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument
                If oDoc.ComponentDefinition.Sketches3D.Count > 0 Then
                    Dim oSketch3D As Sketch3D = oDoc.ComponentDefinition.Sketches3D("Sweeppfad")
                    oView.SetIncludeStatus(oSketch3D, True)
                    If oView.GetVisibility(oSketch3D) = False Then
                        oView.SetVisibility(oSketch3D, True)
                    End If
                    Dim oDrawCurves As DrawingCurvesEnumerator = oView.DrawingCurves(oSketch3D)
                    Dim oLayer As Layer = GetLayer("Sweeping3D")
                    If oLayer Is Nothing Then
                        oTrans.Abort
                        Exit Sub
                    End If
                    Dim oDrawCurve As DrawingCurve
                    For Each oDrawCurve In oDrawCurves
                        If SetCurveOnLayer(oDrawCurve, oLayer) = False Then
                            oTrans.Abort
                            Exit Sub
                        End If
                    Next
                End If
            End If
        End If
    Next
   
    oTrans.end
End Sub

Private Function SetCurveOnLayer(ByVal oCurve As DrawingCurve, ByVal oLayer As Layer) As Boolean
    Try
        Dim SegmentsArrayList As New ArrayList
        Dim oSegment As DrawingCurveSegment
        For Each oSegment In oCurve.Segments
            If oSegment.HiddenLine = False And oSegment.Visible = True Then
                SegmentsArrayList.Add(oSegment)
            End If
        Next

        ' Wenn keine sichtbaren Segmente vorhanden, dann exit
        If SegmentsArrayList.Count = 0 Then Return True
           
        For Each oSegment In SegmentsArrayList
            If SetSegmentOnLayer(oSegment, oLayer) = False Then Return False
        Next
     
        SegmentsArrayList.Clear()
        Return True
    Catch
        Return False
    End Try
End Function

Private Function SetSegmentOnLayer(ByVal oSegment As DrawingCurveSegment, ByVal oLayer As Layer) As Boolean
    Try
        If oSegment.Layer.Name.ToUpper <> oLayer.Name.ToUpper Then
            oSegment.Layer = oLayer
        End If
        Return True
    Catch
        Return False
    End Try
End Function

Private Function GetLayer(ByVal sLayerName As String) As Layer
    Try
        Dim oDrawDoc As DrawingDocument = ThisDrawing.Document
        Dim oStylesManager As DrawingStylesManager= oDrawDoc.StylesManager

        Dim oColor As Inventor.Color= ThisApplication.TransientObjects.CreateColor(0, 0, 0)
        Dim oLineType As Inventor.LineTypeEnum = LineTypeEnum.kDashDottedLineType
       
        ' Layer suchen und aktualisieren
        Dim oLayer As Layer
        For Each oLayer In oStylesManager.Layers
            If (oLayer.Name).ToUpper = sLayerName.ToUpper Then
                oLayer.LineType = oLineType
                oLayer.Color = oColor
                oLayer.LineWeight = 0.05
                oLayer.ScaleByLineWeight = True
                Return oLayer
            End If
        Next

        ' Neu anlegen
        oLayer = Nothing
        oLayer = oStylesManager.Layers.Item(1).Copy(sLayerName)
        If oLayer Is Nothing Then Return Nothing
        oLayer.LineType = oLineType
        oLayer.Color = oColor
        oLayer.LineWeight = 0.05
        oLayer.ScaleByLineWeight = True
        Return oLayer
    Catch
        Return Nothing
    End Try
End Function

---

------------------
MfG
Ralf

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