---

Extrude.zip

Hallo,
weil es beim letzten Mal so gut geklappt hat gleich noch ein Problem.
1. ich wollte mit folgendem Code 3DFlächen zu Volumen umwandeln:

Sub FlZuVol()
    Dim Ele As AcadEntity
    Dim Region As AcadRegion
    Dim Segment As Acad3DSolid
    Dim Blechdicke As Variant
   
    Blechdicke = 5
   
    For Each Ele In ThisDrawing.ModelSpace
        If TypeName(Ele) = "IAcad3DFace" Then
      'ActiveDocument.SendCommand "_Extrude" & vbCr & Ele & vbCr & Blechdicke & vbCr
            Region = ThisDrawing.ModelSpace.AddRegion(Ele)
            Set Segment = ThisDrawing.ModelSpace.AddExtrudedSolid(Ele, Blechdicke, 0)
        End If
    Next

End Sub

Leider erhalte ich die Fehlermeldung: "Unültige Objektanordnung"
Ich vermute, das ich Einer Region keine 3DPolylinie übergeben kann.
Mein 2. Ansatz über SendCommand hat leider auch nicht funktioniert.
Was mache ich falsch?

Und hier noch eine  2. Frage.
Im Anhang eine Zeichnung bei der ich über Fensterauswahl die 3DFlächen extrudiert habe (Extrusionshöhe = -5) leider erhalte ich bei manchen Flächen eine andere Extrusionsrichtung. Wieso?

MfG
Paul

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

---

Hallo Paul,

Hier mal ein Grundgerüst:

Sub Addregion_Paul()
Dim oEnt As AcadEntity
Dim vPick As Variant
Dim oRegions As Variant
Dim oRegObjects(0) As AcadEntity
Dim Segment As Acad3DSolid
Dim Blechdicke As Variant

ThisDrawing.Utility.GetEntity oEnt, vPick, "Objekt wählen: "
   
    Set oRegObjects(0) = oEnt
    oRegions = ThisDrawing.ModelSpace.AddRegion(oRegObjects)
    Blechdicke = 5
    Set Segment = ThisDrawing.ModelSpace.AddExtrudedSolid(oRegions(0), Blechdicke, 0)
    oRegions(0).Delete
    oEnt.Delete
End Sub

Zur zweiten Frage:

Unter 2007 hab ich keine Probleme damit. Es werden alle Segmente in die selbe Richtung extrudiert. Ich probiers Morgen noch mal im 2006er.

Gruß, Carsten

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

---

Hallo Paul,

Im 2006er extrudiert Autocad genau so wie in deinem Beispiel. Woran es liegt kann ich dir leider nicht sagen.

Gruß, Carsten

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

---

Hallo,
nach einiger Zeit habe ich dieses Problemm wieder aufgegriffen.
Anbei mein Versuch:

Sub Fl2Sol()
Dim oEnt As AcadEntity
Dim oRegions As Variant
Dim oRegObjects(0) As AcadRegion
Dim Segment As Acad3DSolid
Dim Blechdicke As Variant
Dim Auswahl As AcadSelectionSet
Blechdicke = 10
On Error Resume Next
ThisDrawing.SelectionSets("TempSSet").Delete

Set Auswahl = ThisDrawing.SelectionSets.Add("TempSSet")
Auswahl.SelectOnScreen
    For Each oEnt In Auswahl
        If TypeName(oEnt) = "IAcad3DFace" Then
            Set oRegObjects(0) = oEnt
            oRegions = ThisDrawing.ModelSpace.AddRegion(oRegObjects)
            Set Segment = ThisDrawing.ModelSpace.AddExtrudedSolid(oRegions(0), Blechdicke, 0)
            oRegions(0).Delete
            oEnt.Delete
        End If
    Next oEnt
    If Not Auswahl Is Nothing Then
        Auswahl.Delete
    End If
End Sub

Leider funktioniert es nicht, Es kommt keine Fehlermeldung, die Schleife wird durchlaufen, und die 3D-Flächen werden gelöscht selbst wenn die entsprechenden Zeilen auskommentiert werden.
Wer weiß einen Rat?

MfG
Paul

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