---

Second ExtrudedProtrusion is error!
Can you lend me a hand?
Thank you very much!!

Dim objApp As SolidEdgeFramework.Application
Dim objDoc As SolidEdgePart.PartDocument
Dim objProfile(1 To 2) As SolidEdgePart.Profile
Dim objExtProt As SolidEdgePart.ExtrudedProtrusion
Dim objModel As SolidEdgePart.Model
Dim objCircles2d As SolidEdgeFrameworkSupport.Circles2d
Dim objRelns As SolidEdgeFrameworkSupport.Relations2d
Dim objApplication As SolidEdgeFramework.Application
Dim objSimpM As SolidEdgePart.SimplifiedModel
Dim simapp As SolidEdgePart.SimplifiedModels
Dim lngStatus As Long
Const PI = 3.14159265358979

On Error Resume Next
Set objApp = GetObject(, "SolidEdge.Application")

Set objDoc = objApp.Documents.Add("SolidEdge.PartDocument")
objApp.Visible = True

Set objProfile(1) = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:= _
objDoc.RefPlanes(3))
Set objCircles2d = objProfile(1).Circles2d
objCircles2d.AddByCenterRadius 0, 0, 0.05

Set objModel = objDoc.Models.AddFiniteExtrudedProtrusion(NumberOfProfiles:=1, _
profileArray:=objProfile, ProfilePlaneSide:= _
igRight, ExtrusionDistance:=0.05)

Set objProfile(1) = Nothing
Set objCircles2d = Nothing

Set objProfile(1) = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:= _
objDoc.RefPlanes(3))
Set objCircles2d = objProfile(1).Circles2d
objCircles2d.AddByCenterRadius 0, 0, 0.08
Set simapp = objDoc.SimplifiedModels
Set objSimpM = simapp.Item(1)
Set objSimpM = objDoc.Models.AddFiniteExtrudedProtrusion(NumberOfProfiles:=1, _
profileArray:=objProfile, ProfilePlaneSide:= _
igLeft, ExtrusionDistance:=0.05)
objProfile(1).Visible = False

Set objApp = Nothing
Set objDoc = Nothing
Set objProfile(1) = Nothing
Set objProfile(2) = Nothing
Set objExtProt = Nothing
Set objModel = Nothing
Set objRelns = Nothing
Set objApplication = Nothing

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

---

Zitat:

---

Original erstellt von bbsbbs:
Second ExtrudedProtrusion is error!
Can you lend me a hand?
Thank you very much!!

Dim objApp As SolidEdgeFramework.Application
Dim objDoc As SolidEdgePart.PartDocument
Dim objProfile(1 To 2) As SolidEdgePart.Profile
Dim objExtProt As SolidEdgePart.ExtrudedProtrusion
Dim objModel As SolidEdgePart.Model
Dim objCircles2d As SolidEdgeFrameworkSupport.Circles2d
Dim objRelns As SolidEdgeFrameworkSupport.Relations2d
Dim objApplication As SolidEdgeFramework.Application
Dim objSimpM As SolidEdgePart.SimplifiedModel
Dim simapp As SolidEdgePart.SimplifiedModels
Dim lngStatus As Long
Const PI = 3.14159265358979

On Error Resume Next
Set objApp = GetObject(, "SolidEdge.Application")

Set objDoc = objApp.Documents.Add("SolidEdge.PartDocument")
objApp.Visible = True

Set objProfile(1) = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:= _
objDoc.RefPlanes(3))
Set objCircles2d = objProfile(1).Circles2d
objCircles2d.AddByCenterRadius 0, 0, 0.05

Set objModel = objDoc.Models.AddFiniteExtrudedProtrusion(NumberOfProfiles:=1, _
profileArray:=objProfile, ProfilePlaneSide:= _
igRight, ExtrusionDistance:=0.05)

Set objProfile(1) = Nothing
Set objCircles2d = Nothing

Set objProfile(1) = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:= _
objDoc.RefPlanes(3))
Set objCircles2d = objProfile(1).Circles2d
objCircles2d.AddByCenterRadius 0, 0, 0.08
Set simapp = objDoc.SimplifiedModels
Set objSimpM = simapp.Item(1) ??Itemcount=0
##Set objSimpM = simapp.Add(objDoc.Models(1))
##Set objExtProt = objSimpM.ExtrudedProtrusions.AddFinite(.....)
Set objSimpM = objDoc.Models.AddFiniteExtrudedProtrusion(NumberOfProfiles:=1, _
profileArray:=objProfile, ProfilePlaneSide:= _
igLeft, ExtrusionDistance:=0.05)??objSímpM is no Protrusion
objProfile(1).Visible = False

Set objApp = Nothing
Set objDoc = Nothing
Set objProfile(1) = Nothing
Set objProfile(2) = Nothing
Set objExtProt = Nothing
Set objModel = Nothing
Set objRelns = Nothing
Set objApplication = Nothing

---

HTH pablo

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

---

Thanks !

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