Hi,
So wird das nix 
Bounding Box klappt nur bei an Koordinatenkreuz ausgerichteten Wänden rechtwinkligen Querschnitts 
Und da das Koordinaten ermitteln lästig ist, hab ich die Routine hierfür mit dreingegeben. ACAD kennt ja mehr als nur eine Polygontype.
Polygon Länge, Fläche, Flächenschwerpunkt sowie die Trägheitsmomente gibt es ebenfalls dazu
Lieben Gruß
Thomas
Public Type POINT3D
X As Double
Y As Double
Z As Double
End Type
Function POLY_INFO(POINTS() As Point3d, CENTROID As Point3d, ix As Double, iy As Double, IXY As Double, LENGTH As Double) As Double
Dim N As Long
Dim I_NEXT As Long
Dim I_CURRENT As Long
Dim DX As Double
Dim DY As Double
Dim AREA As Double
AREA = 0: CX = 0: CY = 0: ix = 0: iy = 0: IXY = 0: LENGTH = 0
N = UBound(POINTS) + 1
I_CURRENT = N
For I_NEXT = 0 To N - 1
DX = POINTS(I_NEXT).X - POINTS(I_CURRENT).X
DY = POINTS(I_NEXT).Y - POINTS(I_CURRENT).Y
LENGTH = LENGTH + Sqr(DX * DX + DY * DY)
AREA = AREA + (POINTS(I_CURRENT).X * POINTS(I_NEXT).Y - POINTS(I_NEXT).X * POINTS(I_CURRENT).Y)
CENTROID.X = CENTROID.X + (POINTS(I_CURRENT).X + POINTS(I_NEXT).X) * (POINTS(I_CURRENT).X * POINTS(I_NEXT).Y - POINTS(I_NEXT).X * POINTS(I_CURRENT).Y)
CENTROID.Y = CENTROID.Y + (POINTS(I_CURRENT).Y + POINTS(I_NEXT).Y) * (POINTS(I_CURRENT).X * POINTS(I_NEXT).Y - POINTS(I_NEXT).X * POINTS(I_CURRENT).Y)
ix = ix + (POINTS(I_CURRENT).Y ^ 2 + POINTS(I_CURRENT).Y * POINTS(I_NEXT).Y + POINTS(I_NEXT).Y ^ 2) * (POINTS(I_CURRENT).X * POINTS(I_NEXT).Y - POINTS(I_NEXT).X * POINTS(I_CURRENT).Y)
iy = iy + (POINTS(I_CURRENT).X ^ 2 + POINTS(I_CURRENT).X * POINTS(I_NEXT).X + POINTS(I_NEXT).X ^ 2) * (POINTS(I_CURRENT).X * POINTS(I_NEXT).Y - POINTS(I_NEXT).X * POINTS(I_CURRENT).Y)
IXY = IXY + (POINTS(I_CURRENT).X * POINTS(I_NEXT).Y + 2 * POINTS(I_CURRENT).X * POINTS(I_CURRENT).Y + 2 * POINTS(I_NEXT).X * POINTS(I_NEXT).Y + POINTS(I_NEXT).X * POINTS(I_CURRENT).Y) * (POINTS(I_CURRENT).X * POINTS(I_NEXT).Y - POINTS(I_NEXT).X * POINTS(I_CURRENT).Y)
I_CURRENT = I_NEXT
Next
AREA = AREA * 0.5
If AREA <> 0 Then
CENTROID.X = CENTROID.X / (6 * AREA)
CENTROID.Y = CENTROID.Y / (6 * AREA)
End If
ix = ix / 12
iy = iy / 12
IXY = IXY / 24
POLY_INFO = AREA
End Function
Function POINTS_FROM_POLYLINE(ByRef POINTS() As Point3d, entity As AcadEntity) As Long
Dim V As Variant
Dim I As Long
Dim J As Long
Dim POINTCOUNT As Long
Dim polylw As AcadLWPolyline
Dim poly3d As Acad3DPolyline
Dim poly2d As AcadLWPolyline
Dim polym As AcadMLine
Dim polyAC As AcadPolyline
Dim Line As acadline
Dim spline As AcadSpline
Dim LEADER As AcadLeader
Dim MLEADER As ACADOBJECT 'AcadMleader
Dim face As Acad3DFace
Dim closed As Boolean
Dim S As String
DoEvents
POINTS_FROM_POLYLINE = -1
S = LCASE(entity.objectname)
J = 0
closed = False
If entity Is Nothing Then Exit Function
Select Case S
Case "acdbline"
Set Line = entity
ReDim POINTS(1)
POINTS(0).X = Line.startPoint(0)
POINTS(0).Y = Line.startPoint(1)
POINTS(0).Z = Line.startPoint(2)
POINTS(1).X = Line.endPoint(0)
POINTS(1).Y = Line.endPoint(1)
POINTS(1).Z = Line.endPoint(2)
POINTCOUNT = 1
Case "acdblwpolyline"
Set polylw = entity
closed = polylw.closed
V = polylw.COORDINATES
POINTCOUNT = ((UBound(V) + 1) / 2) - 1
ReDim POINTS(POINTCOUNT)
''debug.print pointcount
For I = 0 To POINTCOUNT
POINTS(I).X = polylw.COORDINATES(J): J = J + 1
POINTS(I).Y = polylw.COORDINATES(J): J = J + 1
Next
POINTS_FROM_POLYLINE = POINTCOUNT
Case "acdbpolyline"
V = entity.COORDINATES
POINTCOUNT = ((UBound(V) + 1) / 2) - 1
ReDim POINTS(POINTCOUNT)
''debug.print pointcount
Set polylw = entity
closed = polylw.closed
For I = 0 To POINTCOUNT
POINTS(I).X = polylw.COORDINATES(J): J = J + 1
POINTS(I).Y = polylw.COORDINATES(J): J = J + 1
POINTS(I).Z = polylw.ELEVATION
'POINTS(i).z = polylw.COORDINATES(j): j = j + 1
' points(i).z = polyLW.coordinates(J): J = J + 1
Next
Case "acdb2dpolyline"
Set polyAC = entity
closed = polyAC.closed
V = entity.COORDINATES
' pointCount = ((UBound(v) + 1) / 2) - 1
POINTCOUNT = ((UBound(V) + 1) / 3) - 1
ReDim POINTS(POINTCOUNT)
''debug.print pointcount
For I = 0 To POINTCOUNT
POINTS(I).X = polyAC.COORDINATES(J): J = J + 1
POINTS(I).Y = polyAC.COORDINATES(J): J = J + 1
POINTS(I).Z = polyAC.COORDINATES(J): J = J + 1
POINTS(I).Z = polyAC.ELEVATION
Next
POINTS_FROM_POLYLINE = POINTCOUNT
Case "acdb3dpolyline"
Set Acad3DPolyline = entity
closed = Acad3DPolyline.closed
V = entity.COORDINATES
' pointCount = ((UBound(v) + 1) / 2) - 1
POINTCOUNT = ((UBound(V) + 1) / 3) - 1
ReDim POINTS(POINTCOUNT)
''debug.print pointcount
For I = 0 To POINTCOUNT
POINTS(I).X = V(J): J = J + 1
POINTS(I).Y = V(J): J = J + 1
POINTS(I).Z = V(J): J = J + 1
Next
POINTS_FROM_POLYLINE = POINTCOUNT
Case "acdbface"
Set face = entity
closed = False
V = face.COORDINATES
' pointCount = ((UBound(v) + 1) / 2) - 1
POINTCOUNT = ((UBound(V) + 1) / 3) - 1
ReDim POINTS(POINTCOUNT)
''debug.print pointcount
For I = 0 To POINTCOUNT
POINTS(I).X = face.COORDINATES(J): J = J + 1
POINTS(I).Y = face.COORDINATES(J): J = J + 1
POINTS(I).Z = face.COORDINATES(J): J = J + 1
Next
POINTS_FROM_POLYLINE = POINTCOUNT
Case "acdbmline"
V = entity.COORDINATES
POINTCOUNT = ((UBound(V) + 1) / 3) - 1
ReDim POINTS(POINTCOUNT)
''debug.print pointcount
Set polym = entity
ReDim POINTS(POINTCOUNT)
''debug.print pointcount
For I = 0 To POINTCOUNT
POINTS(I).X = polym.COORDINATES(J): J = J + 1
POINTS(I).Y = polym.COORDINATES(J): J = J + 1
POINTS(I).Z = polym.COORDINATES(J): J = J + 1
Next
Case "acdbleader"
V = entity.COORDINATES
POINTCOUNT = ((UBound(V) + 1) / 3) - 1
ReDim POINTS(POINTCOUNT)
'Set leader = entity
ReDim POINTS(POINTCOUNT)
For I = 0 To POINTCOUNT
POINTS(I).X = V(J): J = J + 1
POINTS(I).Y = V(J): J = J + 1
POINTS(I).Z = V(J): J = J + 1
Next
Case "_acdbmleader"
Dim MLEAD As AcadMleader
Set MLEAD = entity
'V = MLEAD.COORDINATES
POINTCOUNT = ((UBound(V) + 1) / 3) - 1
ReDim POINTS(POINTCOUNT)
'Set leader = entity
ReDim POINTS(POINTCOUNT)
For I = 0 To POINTCOUNT
POINTS(I).X = V(J): J = J + 1
POINTS(I).Y = V(J): J = J + 1
POINTS(I).Z = V(J): J = J + 1
Next
Case "acdb3dpolyline"
Set poly3d = entity
closed = poly3d.closed
V = poly3d.COORDINATES
POINTCOUNT = ((UBound(V) + 1) / 3) - 1
ReDim POINTS(POINTCOUNT)
''debug.print pointcount
For I = 0 To POINTCOUNT
POINTS(I).X = poly3d.COORDINATES(J): J = J + 1
POINTS(I).Y = poly3d.COORDINATES(J): J = J + 1
POINTS(I).Z = poly3d.COORDINATES(J): J = J + 1
Next
Case "acdbspline"
Set spline = entity
spline.SplineMethod = acFit
V = spline.fitPoints
POINTCOUNT = ((UBound(V) + 1) / 3) - 1
ReDim POINTS(POINTCOUNT)
For I = 0 To POINTCOUNT
POINTS(I).X = spline.fitPoints(J): J = J + 1
POINTS(I).Y = spline.fitPoints(J): J = J + 1
POINTS(I).Z = spline.fitPoints(J): J = J + 1
Next
Case "acdbsection"
Dim SECT As AcadSection
Set SECT = entity
closed = False
POINTCOUNT = SECT.NumVertices - 1
ReDim POINTS(POINTCOUNT)
''debug.print pointcount
For I = 0 To POINTCOUNT
V = SECT.COORDINATE(I)
POINTS(I).X = V(0)
POINTS(I).Y = V(1)
POINTS(I).Z = V(2)
Next
closed = False
End Select
If closed Then
POINTCOUNT = POINTCOUNT + 1
ReDim Preserve POINTS(POINTCOUNT)
POINTS(POINTCOUNT) = POINTS(0)
End If
POINTS_FROM_POLYLINE = POINTCOUNT + 1
End Function
------------------
Wer es nicht versucht, hat schon verlorn 
Und bei 3 Typos gibts den vierten gratis !
<<< for sale !
[Diese Nachricht wurde von rexxitall am 14. Apr. 2018 editiert.]
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
. Bin nun aber auf ein neues Problem gestoßen, welches ich durch meine Denkweise und Google nicht gelöst bekomme:
- 
