Forum:Inventor VBA
Thema:XYZ-Koordinate und Bezeichnung von einem Punkt in der Zeichnung anzeigen
Möchten Sie sich registrieren?
Wer darf antworten? Registrierte Benutzer können Beiträge verfassen.
Hinweise zur Registrierung Sie müssen registriert sein, um Beiträge oder Antworten auf Beiträge schreiben zu können.
Ihr Benutzername:
Ihr Kennwort:   Kennwort vergessen?
Anhang:    Datei(en) anhängen  <?>   Anhänge verwalten  <?>
Grafik für den Beitrag:                                                
                                                       
Ihre Antwort:

Fachbegriff
URL
Email
Fett
Kursiv
Durchgestr.
Liste
*
Bild
Zitat
Code

*HTML ist AUS
*UBB-Code ist AN
Smilies Legende
Netiquette

10 20 40

Optionen Smilies in diesem Beitrag deaktivieren.
Signatur anfügen: die Sie bei den Voreinstellungen angegeben haben.

Wenn Sie bereits registriert sind, aber Ihr Kennwort vergessen haben, klicken Sie bitte hier.

Bitte drücken Sie nicht mehrfach auf "Antwort speichern".

*Ist HTML- und/oder UBB-Code aktiviert, dann können Sie HTML und/oder UBB Code in Ihrem Beitrag verwenden.

T H E M A     A N S E H E N
rkauskh

Beiträge: 1710 / 0

Windows 10 x64, AIP 2021

Hallo

Automatisch werden sich die Texte nicht aktualisieren. Reicht auch ein Makro (UpdatePointInfo) für das Aktualisieren aller Punktinfos auf einem Blatt?
Die Fehlermeldung beim ESC Drücken sollte jetzt weg sein.


EDIT:
Als Automatismus könnte man eine iLogic-Regel erstellen, die nur ein InventorVb.RunMacro("projectName", "moduleName", "macroName") enthält. Dazu noch einen Ereignisauslöser "Vor dem Speichern" oder "Änderung der Zeichnungsansicht".

Code:

Private Sub PointInfoDemo2()

Dim oDrawDoc As DrawingDocument
Dim oPointMark As Centermark
Dim oPoint As WorkPoint
Dim dX, dY, dZ As Double
Dim oRes As VbMsgBoxResult

Set oDrawDoc = ThisApplication.ActiveDocument
oRes = vbYes

Do While oRes = vbYes

    Set oPointMark = ThisApplication.CommandManager.Pick(kDrawingCentermarkFilter, "Mittelpunkt wählen...")
    If oPointMark Is Nothing Then Exit Do
    If Not TypeOf oPointMark.AttachedEntity Is WorkPoint Then
        MsgBox "Es sind nur eingeschlossene Arbeitspunkte zulässsig."
        GoTo 1
    End If
   
    Set oPoint = oPointMark.AttachedEntity

    Dim oInsertPoint As Point2d
    Set oInsertPoint = oPointMark.Position

    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry

    Dim oLeaderPoints As ObjectCollection
    Set oLeaderPoints = ThisApplication.TransientObjects.CreateObjectCollection

    Call oLeaderPoints.Add(oTG.CreatePoint2d(oInsertPoint.X + 1, oInsertPoint.Y + 1))

    Dim oGeometryIntent As GeometryIntent
    Set oGeometryIntent = oDrawDoc.ActiveSheet.CreateGeometryIntent(oPointMark)

    Call oLeaderPoints.Add(oGeometryIntent)

    Dim sText As String
    sText = "X: " & Round(oPoint.Point.X * 10, 2) & " mm" & vbCrLf & _
        "Y: " & Round(oPoint.Point.Y * 10, 2) & " mm" & vbCrLf & _
        "Z: " & Round(oPoint.Point.Z * 10, 2) & " mm" & vbCrLf & vbCrLf & _
        "Name: " & oPoint.Name

    Dim oLeaderNote As LeaderNote
    Set oLeaderNote = oDrawDoc.ActiveSheet.DrawingNotes.LeaderNotes.Add(oLeaderPoints, sText)

    Dim oFirstNode As LeaderNode
    Set oFirstNode = oLeaderNote.Leader.RootNode.ChildNodes.Item(1)
   
    Call oLeaderNote.AttributeSets.Add("PointInfo")
   
    oRes = MsgBox("Weiteren Punkt abfragen?", vbYesNo, "Punktinfos")
1:
Loop

End Sub



Code:

Private Sub UpdatePointInfo()

Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument

Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet

Dim oLeaderNote As LeaderNote
Dim oAttrSet As AttributeSet
Dim oPoint As WorkPoint

For Each oLeaderNote In oSheet.DrawingNotes.LeaderNotes
    For Each oAttrSet In oLeaderNote.AttributeSets
        If oAttrSet.Name = "PointInfo" Then
            Set oPoint = oLeaderNote.Leader.AllLeafNodes.Item(1).AttachedEntity.Geometry.AttachedEntity
            Dim sText As String
            sText = "X: " & Round(oPoint.Point.X * 10, 2) & " mm" & vbCrLf & _
                    "Y: " & Round(oPoint.Point.Y * 10, 2) & " mm" & vbCrLf & _
                    "Z: " & Round(oPoint.Point.Z * 10, 2) & " mm" & vbCrLf & vbCrLf & _
                    "Name: " & oPoint.Name
            oLeaderNote.Text = sText
        End If
    Next
Next

End Sub


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