Forum: Inventor VBA Thema: XYZ-Koordinate und Bezeichnung von einem Punkt in der Zeichnung anzeigen

Nur autorisierte Mitglieder (Administrator, Moderator) oder das Mitglied, welches den Beitrag erstellt haben, können diesen editieren. (Nur registrierte Benutzer können Beiträge editieren) HINWEIS: Nur autorisierte Mitglieder können Beiträge löschen!
Löschen? Um diesen Beitrag zu löschen, markieren Sie bitte dieses Kästchen. Smilies in diesem Beitrag deaktivieren.
Ihr Benutzername:
Ihr Kennwort:	Kennwort vergessen?
Attachment:	Dateien uploaden  <?>   Dateien verwalten  <?>
Grafik für den Beitrag:
Zu editierender Beitrag: Fachbegriff URL Email Fett Kursiv Durchgestr. Liste * Bild Zitat Code *HTML ist AUS *UBB-Code ist AN Smilies Legende Netiquette	Original erstellt von: rkauskh am 05-25-2020 01:04 AM 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] [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 [/code] ------------------ MfG Ralf [IMG]http://ww3.cad.de/foren/ubb/uploads/rkauskh/pcfite.gif[/IMG] 10 20 40
System-Info / Zusatztext: Bitte hier Ihre aktuelle System-Konfiguration, oder den Zusatztext für das Forum Inventor VBA angeben.	Windows 10 x64, AIP 2021

Bitte drücken Sie nicht mehrfach auf "Änderungen durchführen".

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