Hi,Everyone.I have a serious problem recently. I want to put my iFeature on my workplane,but i can't.
However, if I change my PlaneInput = oFace , it can work perfectly.My program is below:
Private WithEvents oInteraction As InteractionEvents
Private WithEvents oselect As SelectEvents
Private Sub UserForm_Initialize()
Set oInteraction = ThisApplication.CommandManager.CreateInteractionEvents
Set oselect = oInteraction.SelectEvents
oselect.AddSelectionFilter kPartFaceFilter
oselect.SingleSelectEnabled = True
oInteraction.Start
End Sub
Private Sub oselect_OnSelect(ByVal JustSelectedEntities As ObjectsEnumerator, ByVal SelectionDevice As SelectionDeviceEnum, ByVal ModelPosition As Point, ByVal ViewPosition As Point2d, ByVal View As View)
Dim oFace As Face
Set oFace = JustSelectedEntities.Item(1)
On Error Resume Next
Dim oPartDoc As PartDocument
Set oPartDoc = ThisApplication.ActiveDocument
If Err Then
MsgBox "A part must be active."
Exit Sub
End If
Dim oPartDef As PartComponentDefinition
Set oPartDef = oPartDoc.ComponentDefinition
Dim oFeatures As PartFeatures
Set oFeatures = oPartDef.Features
'Give a offset to oFace
Dim oWorkPlane As WorkPlane
Set oWorkPlane = oPartDef.WorkPlanes.AddByPlaneAndOffset(oFace, 0.5, False)
' Create an iFeatureDefinition object.
Dim oiFeatureDef As iFeatureDefinition
Set oiFeatureDef = oFeatures.iFeatures.CreateiFeatureDefinition("D:\Document\\130812\countersink\countersink.ide")
' Set the input.
Dim oInput As iFeatureInput
For Each oInput In oiFeatureDef.iFeatureInputs
Dim oParamInput As iFeatureParameterInput
Select Case oInput.Name
Case "sketch plane"
Dim oPlaneInput As iFeatureSketchPlaneInput
Set oPlaneInput = oInput
oPlaneInput.PlaneInput = oWorkPlane ' it doesn't work!!!!!!!!!!!!!!!!!!!!!!!!!!
Case "size"
Set oParamInput = oInput
oParamInput.Expression = "M5"
End Select
Next
' Create the iFeature.
Dim oiFeature As iFeature
Set oiFeature = oFeatures.iFeatures.Add(oiFeatureDef)
End Sub
Private Sub oInteraction_OnTerminate()
Set oselect = Nothing
Set oInteraction = Nothing
Unload Me
End Sub
Thanks a lot in advance
Hi,
I tested with a selected face directly. It works well. The attachments are the test snapshots and my iFeature. If you still have the proble, please isolate and send run-able code and neccesary iFeature ide. Code snippet does not always help
Sub test() Dim oPartDoc As PartDocument Set oPartDoc = ThisApplication.ActiveDocument Dim oFace As Face Set oFace = oPartDoc.SelectSet(1) Dim oPartDef As PartComponentDefinition Set oPartDef = oPartDoc.ComponentDefinition Dim oFeatures As PartFeatures Set oFeatures = oPartDef.Features 'Give a offset to oFace Dim oWorkPlane As WorkPlane Set oWorkPlane = oPartDef.WorkPlanes.AddByPlaneAndOffset(oFace, 0.5, False) ' Create an iFeatureDefinition object. Dim oiFeatureDef As iFeatureDefinition Set oiFeatureDef = oFeatures.iFeatures.CreateiFeatureDefinition("c:\temp\iFeature1.ide") ' Set the input. Dim oInput As iFeatureInput For Each oInput In oiFeatureDef.iFeatureInputs Dim oParamInput As iFeatureParameterInput Select Case oInput.Name Case "Profile Plane1" Dim oPlaneInput As iFeatureSketchPlaneInput Set oPlaneInput = oInput oPlaneInput.PlaneInput = oWorkPlane ' it doesn't work!!!!!!!!!!!!!!!!!!!!!!!!!! Debug.Print "OK!" Case "size" Set oParamInput = oInput oParamInput.Expression = "M5" End Select Next ' Create the iFeature. Dim oiFeature As iFeature Set oiFeature = oFeatures.iFeatures.Add(oiFeatureDef) End Sub