Celková délka entit (object.Length)


Makro znázorní celkovou délku podporovaných entit ve výkrese s použitím vlastnosti object.length.

Podporovány jsou tyto entity:
Arc
Ellipse
Line
LWPolyline
Polyline
3Dpolyline
Spline
Circle (podle poloměru)

Sub DelkaEntit()
' Vraci celkovou delku podporovanych entit ve vykrese.
Dim ents As Object
Dim ent As Object
Dim ct As Integer
Dim counter As Integer
Dim totallength As Double
Set ents = ActiveDocument.ModelSpace
ct = ents.Count

totallength = 0
For counter = 1 To ct
Set ent = ents.Item(counter)
If ent.EntityType = 3 Or ent.EntityType = 15 Or ent.EntityType = 21 Or ent.EntityType = 22 Or ent.EntityType = 25 Or ent.EntityType = 31 Then
totallength = totallength + ent.Length
ElseIf ent.EntityType = 7 Then
totallength = totallength + ent.Radius * 2 * 3.14159
End If
Next

MsgBox "Celkova delka entit:" & totallength

End Sub



Makro můžete také stáhnout zde.

 



Menu