---

Schrankseite.jpg

Hallo zusammen!

Ich möchte folgendes probieren:
- Umgrenzungslinie (Schrankseite) auswählen.
- Objekte über Layernamen filtern und auswählen,
  die sich in diesem Rahmen befinden.
- Basispunkt untere linke Ecke / OK über GetBoundingBox
- Ausgewählte Teile kopieren und auf den aktuellen BKS Nullpunkt
  verschieben.

Kann mir da bzgl. der Filter jemand weiterhelfen?

Code:

---

Sub Unit()
Dim SLayer As AcadLayer
Dim MinPoint As Variant
Dim minp(0 To 2) As Double
Dim MaxPoint As Variant
Dim maxp(0 To 2) As Double
Dim Objekt As Object
Dim NewObjekt As AcadEntity
Dim NewName As String
Dim Prompt As String
Dim SSet As AcadSelectionSet

Set SSet = ThisDrawing.SelectionSets.Add("Auswahllayer")

On Local Error Resume Next

Prompt = "Wählen Sie eine Schrankseite aus"

ThisDrawing.Utility.GetEntity Objekt, PickedPoint, Prompt
If TypeName(Objekt) = "IAcadPolyline" Or "IAcadLWPolyline" Then
    Objekt.GetBoundingBox MinPoint, MaxPoint
        minp(0) = MinPoint(0)
        minp(1) = MinPoint(1)
        maxp(0) = MaxPoint(0)
        maxp(1) = MaxPoint(1)
       
        SSet.Clear
        SSet.Select acSelectionSetCrossing, minp, maxp
        For Each SLayer In SSet

'###--Hier soll nun ein Filter eingebau werden, der Objekte
'    auf bestimmten Layern auswählt
'    anschließend soll die ausgewählte Umgrenzungslinie
'    (Schrankseite) komplett mit diesen Teilen kopiert werden
'    Kreise auf den Layern "ZB" "Z_" "ZL_"
'    Polylinien auf dem Layer "FK"

        Next SLayer
    End If
End Sub

---

Vielen Dank im voraus.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Dirk,

der Filter sollte eigentlich schon im SSet.Select mitkommen, dann hast Du nicht alle Elemente zu durchlaufen, sondern hast gleich die richtigen bei der Hand.

Code:

---

Dim tDxfCodes(1) As Integer
Dim tDxfValues(1) As Variant
tDxfCodes(0) = 0: tDxfValues(0) = "*LINE*"  'alles mit 'LINE' im Geometrietypnamen
tDxfCodes(1) = 8: tDxfValues(1) = "ZB,Z_,ZL_"  'Layernamen

'und dann kannst Du mit diesem Filter die Selektion machen
SSet.Select acSelectionSetCrossing, minp, maxp, tDxfCodes, tDxfValues

---

Viel Erfolg, - alfred -

------------------
www.hollaus.at

[Diese Nachricht wurde von a.n. am 13. Aug. 2009 editiert.]

---

Hallo Alfred!

Vielen Dank für den Tipp.
werds nachher mal probieren.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Schrankseite.jpg

Hallo Alfred!

Das funktioniert echt prima.

Könnte man nicht so auch die Kreisobjekte auslesen und in ein Solid umwandeln?

Hab's mal so probiert, jedoch ohne Erfolg.

Code:

---

Sub Solid()

Dim Objekt As Object
Dim NewEntity1 As AcadEntity
Dim NewEntity2 As AcadEntity
Dim NewEntity3 As AcadEntity
Dim Prompt As String
Dim SSet As AcadSelectionSet

Dim tDXFCodes(1) As Integer
Dim tDXFValues(1) As Variant

Dim regionObj As Variant
Dim NewS As Acad3DSolid

Dim height As Double
Dim taperAngle As Double
height = 3
taperAngle = 0

Dim minp(2) As Double
Dim maxp(2) As Double

tDXFCodes(0) = 0: tDXFValues(0) = "circle"
tDXFCodes(1) = 8: tDXFValues(1) = "ZB"

Set SSet = ThisDrawing.SelectionSets.Add("Auswahllayer1")

On Local Error Resume Next

Prompt = "Wählen Sie eine Schrankseite aus"

ThisDrawing.Utility.GetEntity Objekt, PickedPoint, Prompt
If TypeName(Objekt) = "IAcadCircle" Then
    Objekt.GetBoundingBox MinPoint, MaxPoint
        minp(0) = MinPoint(0)
        minp(1) = MinPoint(1)
        maxp(0) = MaxPoint(0)
        maxp(1) = MaxPoint(1)
       
        SSet.Clear
        SSet.Select acSelectionSetCrossing, minp, maxp, tDXFCodes, tDXFValues
       
        For Each NewEntity1 In SSet
        regionObj = ThisDrawing.ModelSpace.AddRegion(NewEntity1)
         
        Set NewS = ThisDrawing.ModelSpace.AddExtrudedSolid(regionObj, height, taperAngle)
        Next NewEntity1
       
End If

End Sub

---

Siehst Du da eine Möglichkeit?

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

Code:

---

Prompt = "Wählen Sie eine Schrankseite aus"

ThisDrawing.Utility.GetEntity Objekt, PickedPoint, Prompt
If TypeName(Objekt) = "IAcadCircle" Then

---

Du wählst die Schrankseite aus. Die besteht aus einer Polylinie. Fragst aber danach ab, ob de Schrankseite ein Kreis ist?! 

Das kann so nicht funktionieren.

Gruß, Carsten

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Dirk,

neben der wahrscheinlich anders gemeinten Objektauswahl und Prüfung auf Kreis statt Polylinie, die ja von Carsten schon beantwortet wurde, gibt es folgende notwendige Umbauten:

Um aus Elementen eine Region zu bauen, braucht die 'AddRegion'-Funktion ein Array von Elementen, daher:

Code:

---

....
For Each NewEntity1 In SSet
  dim tEntities(0) as AcadEntity
  set tEntities(0) = NewEntity1
  regionObj = ThisDrawing.ModelSpace.AddRegion(tEntities)
  ...

---

Und nachdem die Funktion 'AddRegion' auch wiederum ein Array retourniert, die Funktion 'AddExtrudedSolid' aber nur einzelne Objekte als Parameter zuläßt, musst Du aus dem Ergebnissarray das erste Element und nicht den ganzen Array übergeben.

Code:

---

Set NewS = ThisDrawing.ModelSpace.AddExtrudedSolid(regionObj(0), height, taperAngle)

---

Wieso das ganze:

erstens, weils die API so vorsieht und die Funktionen so deklariert sind.
zweitens (und das ist der Hintergrund dazu), Du kannst aus 1 Kreis genauso eine Region bauen wie z.B. aus 2 Polylinien, denn Regions können ja Inseln haben. Und aus diesem Grund muß man zur Bildung einer Region die Möglichkeit haben, mehrere Elemente zugleich an die Funktion zu übergeben, daher ein Array.
Und nachdem das Ergebnis aus der Region-Erstellung darin resultieren kann, dass meherere Regions generiert werden, ist der Rückgabewert der 'AddRegion'-Funktion auch wieder ein Array.

Dazu gesagt: solange Du weisst, dass es Kreise sind, ist Dein Programmablauf OK, allgemein gehalten müsstest Du zuerst prüfen, ob mit AddRegion überhaupt die Bildung einer oder mehrerer Regions gelungen ist, und wenn Du mehrere Regions zurückbekommst, dann müsstest Du auch jedes dieser retorunierten Elemente extrudieren. Aber wie gesagt, solange es nur um Kreise geht, ist das schon OK.

Viel Erfolg, - alfred -

------------------
www.hollaus.at

---

Hallo Carsten!
Hallo Alfred!

Vielen Dank für Eure Hilfe.
Ihr habt mir wie immer sehr geholfen  .

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

3D_Ablauf.jpg 3D_Ergebnis.jpg

Hallo zusammen!

Ich komme leider erst jetzt wieder dazu mit meinem Programm fortzufahren.
Bis lang funktionierten die Dinge von Alfred bzw. Carsten gut.
Daher möchte ich das Programm noch erweitern.

An der Plattenkante füge ich Bohrblöcke ein "H_Bohr_9_5".
Die 9_5 stehen für 9.5 und geben die Höhe in Z an.
Diese kann man ja über Len filtern und mit

Code:

---

Replace(Bohr_H.Bohr_Layer.Caption, ",", "_")

---

umwandeln.

Nun soll aus den X und Y Werten des Blocks ein Zylinder erzeugt und in Richtung des Blocks ausgerichtet werden.
Anschließend auf Höhe Z = 9_5 verschoben und von der Grundplatte abgezogen "_subtract Volumenkörper" werden.

Wie baue ich da die Schleife auf?

Vielen Dank im voraus.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

Lade doch mal die Beispielzeichnung (2d) hoch, damit man sehen kann, wie dein Block aufgebaut ist.
Wenn ich mir so anschaue was du da machst würde ich sagen, das ihr euch doch mal nach einer Branchenlösung umschauen solltet.

Gruß, Carsten

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Carsten!

Das hat nichts mit der Firma zutun.
Hier geht es mir um kleine Hilfetools und nicht um "Branchenlösungen".
Die haben wir.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

>> Bis lang funktionierten die Dinge von Alfred bzw. Carsten gut.

Wieso nur 'bis lang', hört sich an wie 'jetzt aber nicht'   

>> Nun soll aus den X und Y Werten des Blocks ein Zylinder erzeugt
>> und in Richtung des Blocks ausgerichtet werden.
>> Anschließend auf Höhe Z = 9_5 verschoben und von der Grundplatte
>> abgezogen "_subtract Volumenkörper" werden.
>> Wie baue ich da die Schleife auf?

Wenn obiges Deine Gedanken sind, wieso baust Du es nicht genau so. Bei der gedanklichen Abfolge sehe ich keinen Fehler.
Ev. ein Verbesserungsvorschlag könnte schon sein, dass die Blockreferenzen bereits die 3D-Geometrie inkludieren, dann brauchst Du die 3D-Geometrie nur mehr aus dem Block herausholen und nicht erst in Deinem Duchgang erzeugen.

- alfred -

------------------
www.hollaus.at

---

Hallo Dirk,

Alfred hat schon Recht damit, das Solid in den Block zu packen. Dann bräuchtest du das Solid(aus dem Block) nur noch in der Höhe passend schieben.
Sonst könntest du über die Eigenschaft "Rotation" den Drehwinkel der Blockref nutzen. Den Einfügepunkt für den Block hast du ja schon.

Brauchst du die 3D-Volumenkörper nur zum Visualisieren?!

Gruß, Carsten

[Diese Nachricht wurde von Carsten1210 am 29. Sep. 2009 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

3D_Links.jpg 3D_Rechts.jpg

Hallo zusammen!

Der Block wird erst beim einfügen auf Größe skaliert.
Das wird dann bei dem SolidBlock wohl nicht funktionieren?

Den Zylinder erstellen und an dem Einfügepunkt des Blocks setzen
habe ich nun.

Code:

---

For Each Bohrungen In SSet
    Set HBlock = Bohrungen
    XScale = HBlock.XScaleFactor
    YScale = HBlock.YScaleFactor
    InPoint = HBlock.InsertionPoint
       
    ra = YScale / 2
    he = XScale
    Set CylinderObj = ThisDrawing.ModelSpace.AddCylinder(InPoint, _
    ra, he)

    Next Bohrungen

---

Wie bekomme ich es nun hin, den Zylinder in Richtung des Blocks auszurichten?
Der Block kann sich in verschiedenen Richtungen in der Platte
befinden.

Mir geht es bei dieser Sache darum, aus 2D Elementen mal schnell
ein 3D Modell zu erzeugen.

Vielen Dank im voraus.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

>> Der Block wird erst beim einfügen auf Größe skaliert.
>> Das wird dann bei dem SolidBlock wohl nicht funktionieren?

...hast Du das probiert oder geraten? Ich hab's jetzt nicht probiert, bin aber ziemlich überzeugt davon, dass die XY-Skalierung der Blockreferenz den Radius und die Z-Skalierung die Zylinderhöhe des im Block definierten Zylinders beeinflusst.

Und die leichteste Variante, den Zylinder in die richtige Richtung zu bekommen wird wohl sein, mit  'CylinderObj.Rotate3D'  vorzugehen

- alfred -

------------------
www.hollaus.at

---

Hallo Alfred!
Hallo Carsten!

Vielen dank nochmal für Eure Tipps und Anregungen.
Mit dem auslesen der Werte von dem eingefügten Block wie

Code:

---

XScale = HBlock.XScaleFactor
YScale = HBlock.YScaleFactor
Angle = HBlock.Rotation

---

und der anschließenden Weiternutzung für

Code:

---

CylinderObj.Rotate3D
CylinderObj.Move

---

funktioniert es echt gut.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Anlage01.jpg

Hallo zusammen!

Eine Frage habe ich noch.

Das 3DSolid wird erzeugt, aber die Einzelobjekte bleiben erhaten, wie:
- Regionen
- Kreise
- etc.

Ich dachte die nun über die jeweilige Delete Funktion löschen zu können. Da geschieht aber leider nicht.

Code:

---

Dim BohrObj(0) As AcadEntity
Dim BohrRegion As Variant
Dim BohrSolid As Acad3DSolid
...
Set BohrObj(0) = Bohrungen
BohrRegion = ThisDrawing.ModelSpace.AddRegion(BohrObj)
Set BohrSolid = ThisDrawing.ModelSpace.AddExtrudedSolid(BohrRegion(0) _, BohrHo, BohrAn)
...
BohrObj(0).Delete '##das funktioniert nicht
BohrRegion.Delete '##das funktioniert nicht

---

Wie bekomme ich nach der Erzeugung des 3DSolids die anderen Elemente
gelöscht?

Mit

Code:

---

SSet.Delete

---

lösche ich ja nur den Inhalt der Auswahlsatzes, aber nicht die Element / Objekte ansich.

Vielen Dank im voraus.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Dirk,

heisst's nicht xx.Erase statt xx.Delete? 

- alfred -

------------------
www.hollaus.at

---

Hallo Alfred!

Mit Erase funktionierts soweit, nur anschließend funktioniert der Auswahlsatz ansich nicht mehr.
Bei der ersten Selection "Grundplatte" hörts auf.

Kann es an meinem SelectionsSet liegen?

Code:

---

Dim SSet As AcadSelectionSet
...
On Error Resume Next
Set SSet = ThisDrawing.SelectionSets("MeineAuswahl")
If Err.Number Then
    Set SSet = ThisDrawing.SelectionSets.Add("MeineAuswahl")
End If
On Error GoTo 0
...
SSet.Clear
SSet.Select acSelectionSetCrossing, minp, maxp, Codes, Values
...
ReDim ssets(0 To SSet.Count - 1) As AcadEntity
Dim i As Integer
For i = 0 To SSet.Count - 1
Set ssets(i) = SSet.Item(i)
Next
       
SSet.AddItems ssets
       
SSet.Erase

---

Danke im voraus.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Dirk,

Du wolltest doch die Geometrieelemente löschen, da hilft SSet.Erase nicht, sondern das '.Erase' musst Du auf die Geometrie anwenden. Also z.B.

Code:

---

SSet.Item(i).Erase

---

- alfred -

------------------
www.hollaus.at