3 Mirrorcopies but only 2 in SE 1

[monirri]

Hi. I started this thread thread562-148260
a months ago. I received an answer, i tried it, but didn`t work, because I don`t understand.

I created the first protrusion of a piece using the addFiniteExtrudedProtrusion method, and the following ones using ExtrudedProtrusion.AddFinite (from parallel Refplanes added).
I tried to make a mirror copy of the first three features, but when I include the first or base feature (the first extruded protrusion), the mirror copy fails, so I have to mirror copy the last two and finish the part adding manually in VB what would be the mirror copy of the base protrusion.
I did already check the Number of Features.
So what is going on?


The code is this


'This is an attempt to create a mirror copy of
'a part having 3 protrusions. Each protrusions comes from
'a circle2D concentric profile in a parallel plane.
'The finished part looks like a gym dumbbell.
'This code isn´t working

Private Sub Command1_Click()
Dim objApp As SolidEdgeFramework.Application
Dim objDoc As SolidEdgePart.PartDocument
Const PI = 3.14159265358979
On Error Resume Next
Set objApp = GetObject(, "SolidEdge.Application")
If Err Then
Err.Clear
Set objApp = CreateObject("SolidEdge.Application")
If Err Then
MsgBox "Error: Solid Edge must be installed"
Err.Clear
End If
Set objDoc = objApp.Documents.Add("SolidEdge.PartDocument")
objApp.Visible = True
Else
Set objDoc = objApp.ActiveDocument
End If
'WINDOW MANAGING
objApp.Visible = True
objApp.Top = 0
objApp.Left = 0
objApp.Width = Screen.Width
objApp.Height = Screen.Height
objApp.WindowState = 2
'*************************
'CODE TO SHOW COMMANDBARS (Partfeatures AND MainToolBar)
Dim objEnv As SolidEdgeFramework.Environment
Dim objbar As SolidEdgeFramework.CommandBar
Dim counter As Integer
counter = 0
Set objEnv = objApp.Environments("Part")
For Each objbar In objEnv.CommandBars
objbar.Visible = True
counter = counter + 1
If counter = 2 Then
Exit For
End If
Next objbar
'*************************
'...Profiles
Dim Profile1 As SolidEdgePart.Profile
Dim Profile2 As SolidEdgePart.Profile
Dim Profile3 As SolidEdgePart.Profile
'...Profile Arrays
Dim ProfileArray(1 To 3) As SolidEdgePart.Profile
'...Solid Edge Reference planes
Dim ReferencePlanes As SolidEdgePart.RefPlanes
'...Planos de referencia individuales de Solid Edge
Dim PlaneXZ As SolidEdgePart.RefPlane
Dim PlaneYZ As SolidEdgePart.RefPlane
Dim PlaneXY As SolidEdgePart.RefPlane
'...Parallel planes
Dim ParallelPlane(1 To 4) As SolidEdgePart.RefPlane
Dim MirrorPlane As SolidEdgePart.RefPlane
Dim BaseProtrusion As SolidEdgePart.Model
Dim Protrusion2 As SolidEdgePart.ExtrudedProtrusion
Dim Protrusion3 As SolidEdgePart.ExtrudedProtrusion
Dim objMirr1 As SolidEdgePart.MirrorCopy
Dim objFtArr(1 To 3) As Object
Dim lngStatus As Long

'FIRST PROFILE
Set Profile1 = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(3))
Call Profile1.Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.1)
If lngStatus <> 0 Then
MsgBox "Profile for base protrusion is not closed"
End If
'FIRST PROTRUSION
Set ProfileArray(1) = Profile1
Set objModel = objDoc.Models
Set BaseProtrusion = objDoc.Models.AddFiniteExtrudedProtrusion(NumberOfProfiles:=1, _
ProfileArray:=ProfileArray, ProfilePlaneSide:=igLeft, _
ExtrusionDistance:=0.04) '<-------Method: addfiniteextrudedprotrusion
Profile1.Visible = False
Call objDoc.Windows(1).View.Fit

Set ReferencePlanes = objDoc.RefPlanes
Set PlaneXZ = ReferencePlanes.Item(3)

'CREATE PARALLEL PLANE FOR SECOND PROTRUSION
Set ParallelPlane(1) = ReferencePlanes.AddParallelByDistance(ParentPlane:=PlaneXZ, Distance:=0.04, _
NormalSide:=igLeft)
ParallelPlane(1).Visible = False
'SECOND PROFILE
Set Profile2 = objDoc.ProfileSets.Add.Profiles.Add(ParallelPlane(1))
Call Profile2.Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.08)
If lngStatus <> 0 Then
MsgBox "Profile for base protrusion is not closed"
End If
Call objDoc.Windows(1).View.Fit
'SECOND PROTRUSION
Set Protrusion2 = BaseProtrusion.ExtrudedProtrusions.AddFinite(Profile:=Profile2, _
ProfileSide:=igLeft, ProfilePlaneSide:= _
igLeft, Depth:=0.04) '<-------Method: extrudedprotrusions.addfinite
Profile2.Visible = False


'CREATE PARALLEL PLANE FOR THIRD PROTRUSION
Set ParallelPlane(2) = ReferencePlanes.AddParallelByDistance(ParentPlane:=PlaneXZ, Distance:=0.08, _
NormalSide:=igLeft)
ParallelPlane(2).Visible = False
'THIRD PROFILE
Set Profile3 = objDoc.ProfileSets.Add.Profiles.Add(ParallelPlane(2))
Call Profile3.Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.06)
If lngStatus <> 0 Then
MsgBox "Profile for base protrusion is not closed"
End If
Call objDoc.Windows(1).View.Fit
'THIRD PROTRUSION
Set Protrusion3 = BaseProtrusion.ExtrudedProtrusions.AddFinite(Profile:=Profile3, _
ProfileSide:=igLeft, ProfilePlaneSide:= _
igLeft, Depth:=0.04) '<-------Method: extrudedprotrusions.addfinite
Profile3.Visible = False

'CREATE THE MIRROR PLANE
Set MirrorPlane = ReferencePlanes.AddParallelByDistance(ParentPlane:=PlaneXZ, _
Distance:=0.12, NormalSide:=igLeft)
MirrorPlane.Visible = True
'CREATE FEATURES ARRAY FOR MIRROR COPY
Set objFtArr(1) = BaseProtrusion '<-----HERE IS THE PROBLEM
'if I introduce BaseProtrusion
'in the array, MirrorCopy fails
'If I put
'Set objFtArr(1) = Protrusion2
'Set objFtArr(2) = Protrusion3
'and
'NumberofFeatures:=2 then works
'but only 2 protrusions I need all 3
Set objFtArr(2) = Protrusion2
Set objFtArr(3) = Protrusion3
' Create the Mirror
Set objMirr1 = BaseProtrusion.MirrorCopies.Add(PatternPlane:=MirrorPlane, NumberOfFeatures:=3, FeatureArray:=objFtArr)
Call objDoc.Windows(1).View.Fit

'FIT SCREEN
Call objDoc.Windows(1).View.Fit
objDoc.RefPlanes.Item(1).Visible = False
objDoc.RefPlanes.Item(2).Visible = False
objDoc.RefPlanes.Item(3).Visible = False
DoEvents


End Sub



Thanks a lot

 

[donyoung]

Hi monirri,

changed some lines, look for 'added dy'.. The problem was
you tried to store the MODEL not the protrusion as first
element into the array and on that SE choked.

===================== coding
'This is an attempt to create a mirror copy of
'a part having 3 protrusions. Each protrusions comes from
'a circle2D concentric profile in a parallel plane.
'The finished part looks like a gym dumbbell.
'This code isn´t working

Private Sub Command1_Click()
Dim objApp As SolidEdgeFramework.Application
Dim objDoc As SolidEdgePart.PartDocument
Dim Profile1 As SolidEdgePart.Profile
Dim Profile2 As SolidEdgePart.Profile
Dim Profile3 As SolidEdgePart.Profile
'...Profile Arrays
Dim ProfileArray(1 To 3) As SolidEdgePart.Profile
'...Solid Edge Reference planes
Dim ReferencePlanes As SolidEdgePart.RefPlanes
'...Planos de referencia individuales de Solid Edge
Dim PlaneXZ As SolidEdgePart.RefPlane
Dim PlaneYZ As SolidEdgePart.RefPlane
Dim PlaneXY As SolidEdgePart.RefPlane
'...Parallel planes
Dim ParallelPlane(1 To 4) As SolidEdgePart.RefPlane
Dim MirrorPlane As SolidEdgePart.RefPlane
Dim BaseProtrusion As SolidEdgePart.Model
Dim Protrusion1 As SolidEdgePart.ExtrudedProtrusion ' added dy
Dim Protrusion2 As SolidEdgePart.ExtrudedProtrusion
Dim Protrusion3 As SolidEdgePart.ExtrudedProtrusion
Dim objMirr1 As SolidEdgePart.MirrorCopy
Dim objFtArr(1 To 3) As Object
Dim lngStatus As Long
Dim objEnv As SolidEdgeFramework.Environment
Dim objbar As SolidEdgeFramework.CommandBar
Dim counter As Integer
Const PI = 3.14159265358979
'
' start here
'
On Error Resume Next
Set objApp = GetObject(, "SolidEdge.Application")
If Err.Number <> 0 Then
Err.Clear
Set objApp = CreateObject("SolidEdge.Application")
If Err Then
MsgBox "Error: Solid Edge must be installed"
Exit Sub ' < --- Added dy
End If
Set objDoc = objApp.Documents.Add("SolidEdge.PartDocument")
objApp.Visible = True
Else
Set objDoc = objApp.ActiveDocument
'
' added dy
If Err.Number <> 0 Then
Err.Clear
Set objDoc = objApp.Documents.Add("SolidEdge.PartDocument")
If Err.Number <> 0 Then
MsgBox "could not add part document"
Exit Sub
End If
End If
End If
'
On Error GoTo 0
'WINDOW MANAGING
objApp.Visible = True
'objApp.Top = 0
'objApp.Left = 0
'objApp.Width = Screen.Width
'objApp.Height = Screen.Height
objApp.WindowState = 2
'*************************
'CODE TO SHOW COMMANDBARS (Partfeatures AND MainToolBar)
counter = 0
Set objEnv = objApp.Environments("Part")
For Each objbar In objEnv.CommandBars
objbar.Visible = True
counter = counter + 1
If counter = 2 Then
Exit For
End If
Next objbar
'*************************
'...Profiles

'FIRST PROFILE
Set Profile1 = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(3))
Call Profile1.Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.1)
If lngStatus <> 0 Then
MsgBox "Profile for base protrusion is not closed"
Profile1.Delete
Exit Sub
End If
'FIRST PROTRUSION
Set ProfileArray(1) = Profile1
Set objModel = objDoc.Models
Set BaseProtrusion = objDoc.Models.AddFiniteExtrudedProtrusion(NumberOfProfiles:=1, _
ProfileArray:=ProfileArray, ProfilePlaneSide:=igLeft, _
ExtrusionDistance:=0.04) '<-------Method: addfiniteextrudedprotrusion
Profile1.Visible = False
Call objDoc.Windows(1).View.Fit

Set ReferencePlanes = objDoc.RefPlanes
Set PlaneXZ = ReferencePlanes.Item(3)

'CREATE PARALLEL PLANE FOR SECOND PROTRUSION
Set ParallelPlane(1) = ReferencePlanes.AddParallelByDistance(ParentPlane:=PlaneXZ, Distance:=0.04, _
NormalSide:=igLeft)
ParallelPlane(1).Visible = False
'SECOND PROFILE
Set Profile2 = objDoc.ProfileSets.Add.Profiles.Add(ParallelPlane(1))
Call Profile2.Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.08)
If lngStatus <> 0 Then
MsgBox "Profile for base protrusion is not closed"
Profile2.Delete
Exit Sub
End If
Call objDoc.Windows(1).View.Fit
'SECOND PROTRUSION
Set Protrusion2 = BaseProtrusion.ExtrudedProtrusions.AddFinite(Profile:=Profile2, _
ProfileSide:=igLeft, ProfilePlaneSide:= _
igLeft, Depth:=0.04) '<-------Method: extrudedprotrusions.addfinite
Profile2.Visible = False


'CREATE PARALLEL PLANE FOR THIRD PROTRUSION
Set ParallelPlane(2) = ReferencePlanes.AddParallelByDistance(ParentPlane:=PlaneXZ, Distance:=0.08, _
NormalSide:=igLeft)
ParallelPlane(2).Visible = False
'THIRD PROFILE
Set Profile3 = objDoc.ProfileSets.Add.Profiles.Add(ParallelPlane(2))
Call Profile3.Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.06)
If lngStatus <> 0 Then
MsgBox "Profile for base protrusion is not closed"
Profile3.Delete
Exit Sub
End If
Call objDoc.Windows(1).View.Fit
'THIRD PROTRUSION
Set Protrusion3 = BaseProtrusion.ExtrudedProtrusions.AddFinite(Profile:=Profile3, _
ProfileSide:=igLeft, ProfilePlaneSide:= _
igLeft, Depth:=0.04) '<-------Method: extrudedprotrusions.addfinite
Profile3.Visible = False

'CREATE THE MIRROR PLANE
Set MirrorPlane = ReferencePlanes.AddParallelByDistance(ParentPlane:=PlaneXZ, _
Distance:=0.12, NormalSide:=igLeft)
MirrorPlane.Visible = True
'CREATE FEATURES ARRAY FOR MIRROR COPY
objDoc.Models.Item(1).ExtrudedProtrusions.Item (1)
'
' set the first protrusion
Set Protrusion1 = objDoc.Models.Item(1).ExtrudedProtrusions.Item(1) ' added dy
Set objFtArr(1) = Protrusion1 ' ' added dy
'if I introduce BaseProtrusion
'in the array, MirrorCopy fails
'If I put
'Set objFtArr(1) = Protrusion2
'Set objFtArr(2) = Protrusion3
'and
'NumberofFeatures:=2 then works
'but only 2 protrusions I need all 3
Set objFtArr(2) = Protrusion2
Set objFtArr(3) = Protrusion3
' Create the Mirror
Call BaseProtrusion.MirrorCopies.Add(PatternPlane:=MirrorPlane, NumberOfFeatures:=3&, FeatureArray:=objFtArr)
Call objDoc.Windows(1).View.Fit

'FIT SCREEN
Call objDoc.Windows(1).View.Fit
objDoc.RefPlanes.Item(1).Visible = False
objDoc.RefPlanes.Item(2).Visible = False
objDoc.RefPlanes.Item(3).Visible = False
DoEvents


End Sub

 

[donyoung]

Hi,

correction
in the revised coding this line should be deleted:

'CREATE FEATURES ARRAY FOR MIRROR COPY
objDoc.Models.Item(1).ExtrudedProtrusions.Item (1) < -- This

Overlooked that lngStatus is always 0 because it's never set
replace the line (3 times):

If lngStatus <> 0 Then

by this one (replace the X by 1, 2, 3)

If ProfileX.End(igProfileClosed) <> 0 Then

The method ProfileX.End() will return the status as long

In general the error handling should be refined

dy

 

[monirri]

Aahhh.........
Now I know what happened: I was fooled because the Model was created using a statement similar to ExtrudedProtrusions.Addfinite so i actually thought the model was a protrusion by itself. That shows my inexperience.

But now there is a round isn`t copying. Why?

By the way.. ¿Wich SE command should I investigate to see my part solid, and not only like a wire frame?

I don´t know how long took you to watch this thread and code, so Thanks a lot for your help again.

 

[donyoung]

monirri,

when you added a Round you must add that feature to the objFtArr
so that it will be mirrored. In the above coding you only added
the Protrusions.
You may switch to shaded within the part itself (upper Bar) When
stored this option activated along with the normal.par it will
then always come up on new parts activated.

To switch the view from within VB use

Call objApp.StartCommand(PartFormatShaded) ' shaded
PartFormatShadedwithVisibleEdges

Use Object browser and look for 'PartCommandConstants'

Modfied coding bewlow (sans Round Feature)

dy

==============================



'This is an attempt to create a mirror copy of
'a part having 3 protrusions. Each protrusions comes from
'a circle2D concentric profile in a parallel plane.
'The finished part looks like a gym dumbbell.

Private Sub Command1_Click()
'... Application and Document
Dim objApp As SolidEdgeFramework.Application
Dim objDoc As SolidEdgePart.PartDocument
'...Profile Arrays
Dim ProfileArray(1 To 1) As SolidEdgePart.Profile
'...Solid Edge Reference planes
Dim ReferencePlanes As SolidEdgePart.RefPlanes
'...Planos de referencia individuales de Solid Edge
Dim PlaneXZ As SolidEdgePart.RefPlane
Dim PlaneYZ As SolidEdgePart.RefPlane
Dim PlaneXY As SolidEdgePart.RefPlane
'...Parallel planes
Dim ParallelPlane(1 To 4) As SolidEdgePart.RefPlane

Dim MirrorPlane As SolidEdgePart.RefPlane
Dim BaseProtrusion As SolidEdgePart.Model
Dim objMirr1 As SolidEdgePart.MirrorCopy
Dim objFtArr(1 To 3) As Object
Dim counter As Integer
Const PI = 3.14159265358979
'
' start here
'
On Error Resume Next
'
Set objApp = GetObject(, "SolidEdge.Application")
If Err.Number <> 0 Then
Err.Clear
Set objApp = CreateObject("SolidEdge.Application")
If Err Then
MsgBox "Error: Solid Edge must be installed"
Exit Sub ' < --- Added dy
End If
Set objDoc = objApp.Documents.Add("SolidEdge.PartDocument")
objApp.Visible = True
Else
Set objDoc = objApp.ActiveDocument
'
' added dy
If Err.Number <> 0 Then
Err.Clear
Set objDoc = objApp.Documents.Add("SolidEdge.PartDocument")
If Err.Number <> 0 Then
MsgBox "could not add part document"
GoTo cleanup
End If
End If
End If
'
On Error GoTo Err_Handler:
'
Set objModel = objDoc.Models
Set ReferencePlanes = objDoc.RefPlanes
Set PlaneXZ = ReferencePlanes.Item(3)

'...Profiles

'FIRST PROFILE
Set ProfileArray(1) = objDoc.ProfileSets.Add.Profiles.Add(pRefPlaneDisp:=objDoc.RefPlanes(3))
Call ProfileArray(1).Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.1)
If ProfileArray(1).End(igProfileClosed) <> 0 Then
MsgBox "Profile for 1st feature is not closed"
ProfileArray(1).Delete
GoTo cleanup
End If
'
'FIRST PROTRUSION
Set BaseProtrusion = objDoc.Models.AddFiniteExtrudedProtrusion(NumberOfProfiles:=1, _
ProfileArray:=ProfileArray, ProfilePlaneSide:=igLeft, _
ExtrusionDistance:=0.04) '<-------Method: addfiniteextrudedprotrusion
If BaseProtrusion.ExtrudedProtrusions.Item(1).Status <> igFeatureOK Then
MsgBox "unable to create 1st feature"
ProfileArray(1).Delete
GoTo cleanup
End If
Set objFtArr(1) = BaseProtrusion.ExtrudedProtrusions.Item(1)
ProfileArray(1).Visible = False
'
'CREATE PARALLEL PLANE FOR SECOND PROTRUSION
Set ParallelPlane(1) = ReferencePlanes.AddParallelByDistance(ParentPlane:=PlaneXZ, _
Distance:=0.04, NormalSide:=igLeft)
ParallelPlane(1).Visible = False
'
'SECOND PROFILE
Set ProfileArray(1) = objDoc.ProfileSets.Add.Profiles.Add(ParallelPlane(1))
Call ProfileArray(1).Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.08)
If ProfileArray(1).End(igProfileClosed) <> 0 Then
MsgBox "Profile for 2nd feature is not closed"
ProfileArray(1).Delete
GoTo cleanup
End If
'
'SECOND PROTRUSION
Set objFtArr(2) = BaseProtrusion.ExtrudedProtrusions.AddFinite(Profile:=ProfileArray(1), _
ProfileSide:=igLeft, ProfilePlaneSide:= _
igLeft, Depth:=0.04) '<-------Method: extrudedprotrusions.addfinite
If objFtArr(2).Status <> igFeatureOK Then
MsgBox "unable to create 2nd feature"
ProfileArray(1).Delete
GoTo cleanup
End If
ProfileArray(1).Visible = False
'
'CREATE PARALLEL PLANE FOR THIRD PROTRUSION
Set ParallelPlane(2) = ReferencePlanes.AddParallelByDistance(ParentPlane:=PlaneXZ, Distance:=0.08, _
NormalSide:=igLeft, local:=True)
'
'THIRD PROFILE
Set ProfileArray(1) = objDoc.ProfileSets.Add.Profiles.Add(ParallelPlane(2))
Call ProfileArray(1).Circles2d.AddByCenterRadius(x:=0, y:=0, Radius:=0.06)
If ProfileArray(1).End(igProfileClosed) <> 0 Then
MsgBox "Profile for 3rd feature is not closed"
ProfileArray(1).Delete
GoTo cleanup
End If
'
'THIRD PROTRUSION
Set objFtArr(3) = BaseProtrusion.ExtrudedProtrusions.AddFinite(Profile:=ProfileArray(1), _
ProfileSide:=igLeft, ProfilePlaneSide:= _
igLeft, Depth:=0.04) '<-------Method: extrudedprotrusions.addfinite
If objFtArr(3).Status <> igFeatureOK Then
MsgBox "unable to create 3rd feature"
ProfileArray(1).Delete
GoTo cleanup
End If
ProfileArray(1).Visible = False
'
'CREATE THE MIRROR PLANE
Set MirrorPlane = ReferencePlanes.AddParallelByDistance(ParentPlane:=PlaneXZ, _
Distance:=0.12, NormalSide:=igLeft)
MirrorPlane.Visible = True
'
' Create the Mirror
Set objMirr1 = BaseProtrusion.MirrorCopies.Add(PatternPlane:=MirrorPlane, NumberOfFeatures:=UBound(objFtArr), FeatureArray:=objFtArr)
If objMirr1.Status <> igFeatureOK Then
MsgBox "unable to create mirror copy"
End If
'
'FIT SCREEN
Call objApp.StartCommand(PartViewFit)
Call objApp.StartCommand(PartFormatShaded)
'
objDoc.RefPlanes.Item(1).Visible = False
objDoc.RefPlanes.Item(2).Visible = False
objDoc.RefPlanes.Item(3).Visible = False
'
' for we don't know when Windows will do the garbage
' collection we delete obsolete objects now

cleanup:
On Error Resume Next

Set ReferencePlanes = Nothing
Set PlaneXZ = Nothing
Set PlaneYZ = Nothing
Set PlaneXY = Nothing
Set MirrorPlane = Nothing
Set BaseProtrusion = Nothing
Set objMirr1 = Nothing
Set objDoc = Nothing
Set objApp = Nothing
Erase objFtArr
Erase ProfileArray
Erase ParallelPlane
MsgBox "End of run"
Exit Sub
'
Err_Handler:
MsgBox "Error encountered: " & Err.Number & " Desc.: " & Err.Description
Resume cleanup:
End Sub

 

[donyoung]

monirri,

yo may also use the mthod:

Call BaseProtrusion.MirrorParts.Add(MirrorPlane:=MirrorPlane)

instead of the one now used. This should mirror all features.
It is equivalent to the 'Mirror Copy' function whereas the
one used is euqivalent to 'Mirror Copy Feature' which
may be used when not all features should be mirrored.

dy

 

[monirri]

Hi. Problems solved.
The fact is that this is not the code I`m working on. This is the example more closely related and is for the forum only. That`s why there are not all the details (I have to translate)

Thanks donyoung. I will examine your codes further.