Danke Klaus, für die nette Begrüßung!
Fasse nochmal das Ziel zusammen:
Die Schnittpunkte eines Unterzuges (UZ) mit dem einer Wand zu ermitteln. Dazu sollen 2 Linien, die ei-ne stellvertretend für die Wand , die andere stellvertretend für den UZ mit der "IntersectWith" Methode auf Schnittpunkte überprüft werden!
1.Problem:
Die UZs gehören der Klasse "AecsMember" an, die die Objekteigenschaft "FloorLine" nicht enthält. Deshalb war mein Gedanke durch die "StartPoint" und "EndPoint" Eigenschaft der Klasse eine Linie zu erzeugen, die stellvertretend für das UZ Objekt verwendet werden soll. Doch das schlug fehl mit der Fehlermeldung:
Run-time Error '438':
Object doesn't support this property or method
Quellcode:
'Anm.: Erzeugt ein neues Unterzug (UZ) Objekt und weist diesem Attribute zu
Public Function NeuesUZBauteil(UZEnti As AecsMember) As clsBauteile
Set NeuesUZBauteil = New clsBauteile
NeuesUZBauteil.BauteilName = UZEnti.ObjectName
NeuesUZBauteil.BauteilHandle = UZEnti.Handle
NeuesUZBauteil.BauteilObjectID = UZEnti.ObjectID
NeuesUZBauteil.StartPunkt = UZEnti.StartPoint
NeuesUZBauteil.EndPunkt = UZEnti.EndPoint
NeuesUZBauteil.UZLinie = ThisDrawing.ModelSpace.AddLine(NeuesUZBauteil.StartPunkt, _ NeuesUZBauteil.EndPunkt)
End Function
2.Problem
Um zu überprüfen, ob die "IntersectWith" Methode mit der "FloorLine" Eigenschaft der Klasse "Aec-Wall" anwendbar ist, habe die "IntersectWith" Methode auf die Wandbauteile angewendet und der folgende Fehler trat auf:
Run-time error '424'
Oject required
Quellcode
Option Explicit
'Dim BauteilListe As Collection
Dim Bauteil As clsBauteile
Dim Entity As AcadEntity
Dim Wand As AecWall
Dim Unterzug As AecsMember
Public Function BauteilListeAnlegen() As Collection
Dim WandBauteilListe As Collection
Set WandBauteilListe = New Collection
Dim UZBauteilListe As Collection
Set UZBauteilListe = New Collection
For Each Entity In ThisDrawing.ModelSpace
Set Bauteil = New clsBauteile
'Anm.: Wände
' -----
If Entity.ObjectName = "AecDbWall" Then
Set Wand = Entity
Set Bauteil = NeuesWandBauteil(Wand)
WandBauteilListe.Add Bauteil
'Anm.: Unterzüge
' ---------
ElseIf Entity.ObjectName = "AecsDbMember" Then
Set Unterzug = Entity
Set Bauteil = NeuesUZBauteil(Unterzug)
UZBauteilListe.Add Bauteil
End If
Next
'Anm.: Überprüfung eines Schnittpunktes zwischen dem 1. und dem 2.
'Wandbauteil
Dim VarPoints As Variant
VarPoints = WandBauteilListe.Item(1).FussLinie.IntersectWith _
(WandBauteilListe.Item(2).FussLinie, acExtendNone)
End Function
'Anm.: Klasse WandBauteile
Public Function NeuesWandBauteil(WallEnti As AecWall) As clsBauteile
NeuesWandBauteil.FussLinie = WallEnti.Floorline
End Function
Vielleicht bin ich auch völlig auf dem Holzweg und die "IntersectWith" Methode ist nicht anwendbar um die Schnittpunkt eines "AecWall" Objektes und eines "AecsMember" Objektes zu ermitteln?
Schon mal Vielen Dank im Voraus!
Viele Grüße Michel
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
