Folgende Zeilen Code berechnen die Länge einer Linie:
Sub LängeAnzeigen()
Const ShapeLinieAnzeigen As String = „Dynamischer Verbinder“
Dim i As Long
For i = 1 To ActivePage.Shapes.Count
If ActivePage.Shapes(i).Name Like „*“ & ShapeLinieAnzeigen & „*“ Then
ActivePage.Shapes(i).Text = Format(Application.ConvertResult(ActivePage.Shapes(i).LengthIU, „in“, „mm“), „0.00“)
End If
Next i
End Sub
Erklärung: Die Eigenschaft LengthIU liefert die Länge – allerdings in inch. Sie muss in cm oder m umgewandelt werden. Dies kann die Funktion Application.ConvertResult. Und dieses Ergebnis wird mit der Funktion Format auf zwei Stellen nach dem Komma formatiert: „0.00“. Und diese Ergebnis wird auf das Shape als Text geschrieben. Auf welches Shape?
Eine Schleife durchläuft alle Shapes und schreibt den Text jeweils auf die „Dynamischen Verbinder“.
Für Ihre Fluchtwege können Sie den Code anpassen. Erstellen Sie ein Mastershape „Fluchtweg“ in einer Schablone, ziehen es aufs Zeichenblatt (formatieren es, machen es transparent …). In Entwicklertools / Shape-Name befindet sich ja der Name – beispielsweise „Fluchweg“ oder „Fluchtweg.24“ Wenn die Konstante in „Fluchtweg“ geändert wurde, wenn Sie die Formatierung auf „m“ ändern, dann liefert der folgende Code:
Sub LängeAnzeigen()
Const ShapeLinieAnzeigen As String = „Fluchtweg“
Dim i As Long
For i = 1 To ActivePage.Shapes.Count
If ActivePage.Shapes(i).Name Like „*“ & ShapeLinieAnzeigen & „*“ Then
ActivePage.Shapes(i).Text = Format(Application.ConvertResult(ActivePage.Shapes(i).LengthIU, „in“, „m“), „0.00“)
End If
Next i
End Sub
die Länge des Fluchtwegs (hier: 77,13 – schließlich muss man noch nachsehen, wenn beim Billard gewonnen hat, bevor man in die Raucherecke geht)
Wechseln Sie zu VBA. Erstellen dort ein Modul. Und fügen den Code von oben ein. Sie können diese Datei als VSDM speichern – oder die Vorlage als VSTM (Mit Makros!). Das Programm wird von Visio über Ansicht / Makros ausgeführt.
Hallo,
leider ist die Eigenschaft Länge nicht immer richtig.
Bei einem dynamischen Verbinder/Rohrleitung werden bei mir (Visio Professional 2019) nicht alle Element der Geometrie 1 ausgewertet.
Dennoch vielen Dank für die Anregung