iFeature Position VBA macro

iFeature Position VBA macro

isocam
Collaborator Collaborator
646 Views
2 Replies
Message 1 of 3

iFeature Position VBA macro

isocam
Collaborator
Collaborator
I am trying to produce a macro that can extract the variables of a iFeature (eg a rectangular pocket with parameters: -Length,Width,Radius,Depth). But I am having trouble making it work. Can anybody help?

Dim CdfCounter As Long

Set partDoc = ThisApplication.ActiveDocument
Set partDef = partDoc.ComponentDefinition
Set partFeatures = partDef.Features
Set partRefFeatures = partFeatures.ReferenceFeatures

Dim Parameter(4)

If partRefFeatures.Count = 0 Then Exit Sub

EntityCount = True

Set invAPP = ThisApplication

For Each refFeature In partRefFeatures

If refFeature.ReferenceComponent.Type = kiFeatureComponentObject Then
Dim iFeatureSketch As PlanarSketch
Rem Set iFeatureSketch = GetIfeatureSketch(refFeature)

Dim sketchNormal As UnitVector
Set sketchNormal = iFeatureSketch.PlanarEntityGeometry.Normal
If sketchNormal.IsParallelTo(EyeTarget) And sketchNormal.IsEqualTo(EyeTarget) Then
Dim translation(0 To 2) As Double, rotations(0 To 2) As Double

Set refComponent = refFeature.ReferenceComponent
Set iFeatDef = refComponent.Definition
Set iFeatInputs = iFeatDef.iFeatureInputs

For Each iFeatInput In iFeatInputs

Select Case iFeatInput.Type

Case kiFeatureSketchPlaneInputObject

Case kiFeatureParameterInputObject
CdfCounter = CdfCounter + 1
Parameter(CdfCounter) = Val(Left$(iFeatInput.Expression, Len(iFeatInput.Expression) - 2))
Case Else
MsgBox "This type of iFeature input is not yet supported !"
End Select

Next

Many thanks in advance!!!

IsoCam Group
0 Likes
647 Views
2 Replies
Replies (2)
Message 2 of 3

Anonymous
Not applicable
Here's a small program that dumps out some information for each of the
iFeature inputs.

Public Sub DumpiFeatureInput()
On Error Resume Next
Dim oCompDef As PartComponentDefinition
Set oCompDef = ThisApplication.ActiveDocument.ComponentDefinition
If Err Then
MsgBox "A part document must be active."
Exit Sub
End If
On Error GoTo 0

Dim oiFeatComp As iFeatureComponent
For Each oiFeatComp In oCompDef.ReferenceComponents.iFeatureComponents
Debug.Print oiFeatComp.Name

Dim oInput As iFeatureInput
For Each oInput In oiFeatComp.Definition.iFeatureInputs
If TypeOf oInput Is iFeatureEntityInput Then
Dim oEntityInput As iFeatureEntityInput
Set oEntityInput = oInput
Debug.Print " Entity"
Debug.Print " Prompt: " & oEntityInput.Prompt
Debug.Print " Current Entity Type: " &
TypeName(oEntityInput.Entity)
ElseIf TypeOf oInput Is iFeatureParameterInput Then
Dim oParamInput As iFeatureParameterInput
Set oParamInput = oInput
Debug.Print " Parameter"
Debug.Print " Prompt: " & oParamInput.Prompt
Debug.Print " Expression: " & oParamInput.Expression
ElseIf TypeOf oInput Is iFeatureSketchPlaneInput Then
Dim oSketchPlaneInput As iFeatureSketchPlaneInput
Set oSketchPlaneInput = oInput
Debug.Print " SketchPlane"
Debug.Print " Prompt: " & oSketchPlaneInput.Prompt
ElseIf TypeOf oInput Is iFeatureVectorInput Then
Dim oVectorInput As iFeatureVectorInput
Set oVectorInput = oInput
Debug.Print " Vector"
Debug.Print " Prompt: " & oVectorInput.Prompt
ElseIf TypeOf oInput Is iFeatureWorkPlaneInput Then
Dim oWorkPlaneInput As iFeatureWorkPlaneInput
Set oWorkPlaneInput = oInput
Debug.Print " WorkPlane"
Debug.Print " Prompt: " & oWorkPlaneInput.Prompt
Debug.Print " Work Plane: " &
oWorkPlaneInput.PlaneInput.Name
Else
Debug.Print " Uknown Type"
End If
Next
Next
End Sub

--
Brian Ekins
Autodesk Consulting Services
Discussion Q&A: http://www.autodesk.com/discussion
0 Likes
Message 3 of 3

Anonymous
Not applicable
Hello,
i found this thread by Google...
how can i find out the insert angle of an iFeature ?


regards

Andreas
0 Likes