---

Hallo,

Ich habe eine Linie im Bauteil das ich markiere(SelectSet)
anschliessend will ich nun eine Extrusion machen als Fläche durch die linie.

klingt nicht so schwer aber ich bekomme es nicht hin

das habe ich schon aber geht nicht :-(

Code:

---

    Dim oPartdoc As PartDocument
    Set oPartdoc = ThisApplication.ActiveDocument
   
    ' Set a reference to the component definition.
    Dim oCompDef As PartComponentDefinition
    Set oCompDef = oPartdoc.ComponentDefinition
   
    Dim oTransGeom As TransientGeometry
    Set oTransGeom = ThisApplication.TransientGeometry
   
   
    'Dim oSketch As PlanarSketch
    'Set oSketch = oCompDef.Sketches.Add(oCompDef.WorkPlanes(3))

   
    Dim oSketch As PlanarSketch
'    Set oSketch = oPartdoc.SelectSet.item(1)
    Set oSketch = oCompDef.Sketches.item(1)
   
    ' Create a profile. ??
    Dim oProfile As Profile
    Set oProfile = oSketch.Profiles.item(2)

    Dim oExtrude As ExtrudeFeature
    Set oExtrude = oCompDef.Features.ExtrudeFeatures.AddByThroughAllExtent(oProfile, kSymmetricExtentDirection, kJoinOperation)

---

danke für die Hilfe

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

---

Hi

Code:

---

Public Sub FaceExtrude()
    Dim oPartDoc As PartDocument
    Set oPartDoc = ThisApplication.ActiveDocument
                   
    Dim oCompDef As PartComponentDefinition
    Set oCompDef = oPartDoc.ComponentDefinition
   
    Dim oSketch As PlanarSketch
    Set oSketch = oCompDef.Sketches.Item(1)
   
    Dim oTransGeom As TransientGeometry
    Set oTransGeom = ThisApplication.TransientGeometry
   
    Dim oProfile As Profile
    Set oProfile = oSketch.Profiles.AddForSurface
   
    Dim oExtrude As ExtrudeFeature
    Set oExtrude = oCompDef.Features.ExtrudeFeatures.AddByDistanceExtent(oProfile, 0.25, kSymmetricExtentDirection, kSurfaceOperation)
End Sub

---

------------------
MfG
RK

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

---

markierung.jpg eingefügt.jpg

Hi,

Danke für die Programmierung allerdings macht er es nicht mit der zuvor markierten Linie sondern -> die zuererst eingefügte Bild

Danke schon mal

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

---

Hi

Na dann hole deine selektierte Linie aus dem SelectSet.

Code:

---

Public Sub FaceExtrude()
    Dim oPartDoc As PartDocument
    Set oPartDoc = ThisApplication.ActiveDocument
                   
    Dim oCompDef As PartComponentDefinition
    Set oCompDef = oPartDoc.ComponentDefinition
   
    Dim oSelection As SketchLine
    Set oSelection = oPartDoc.SelectSet.Item(1)
   
    Dim oTransGeom As TransientGeometry
    Set oTransGeom = ThisApplication.TransientGeometry
   
    Dim oSketch As PlanarSketch
    Set oSketch = oSelection.Parent
   
    Dim oProfile As Profile
    Set oProfile = oSketch.Profiles.AddForSurface(oSelection)
   
    Dim oExtrude As ExtrudeFeature
    Set oExtrude = oCompDef.Features.ExtrudeFeatures.AddByDistanceExtent(oProfile, 0.25, kSymmetricExtentDirection, kSurfaceOperation)
End Sub

---

------------------
MfG
RK

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

---

super danke funktioniert nun

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