Message 1 of 3
iFeature Position VBA macro
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
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