Eng-Tips is the largest engineering community on the Internet
Intelligent Work Forums for Engineering Professionals
-
Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!
How can we use reference in loop, t 1
- Thread starter Neerajjo
- Start date
- Thread starter
- #2
I have made the point but refetence is not working.
Sub CATMain()
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")
'selection of curve
Dim varSelection As Variant
Set varSelection = partDocument1.Selection
ReDim sFilter(1)
MsgBox "Select Curve"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
sStatus1 = varSelection.SelectElement2(sFilter, "Select Curve", False)
Dim oCurve As Object
Set oCurve = varSelection.Item(1).Value
Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(oCurve)
' Calculate curve length
Dim SpaWorkbench As SpaWorkbench
Dim theMeasurable As Measurable
Set SpaWorkbench = partDocument1.GetWorkbench("SPAWorkbench")
Set theMeasurable = SpaWorkbench.GetMeasurable(part1.CreateReferenceFromObject(oCurve))
part1.Update
'MsgBox CStr(theMeasurable.Length)
B = theMeasurable.Length
MsgBox "Curve length" & B
'Enter no of section
C = CInt(InputBox("Enter Required number of section"))
D = B / C
'Selection of Point
Dim Selection1 As Object
Set Selection1 = CATIA.ActiveDocument.Selection
ReDim InPutObjectType(0)
MsgBox "Select Point"
'InPutObjectType(0) = "CATPoint"
'InPutObjectType(0) = "AnyObject"
InPutObjectType(0) = "Point"
Status = Selection1.SelectElement2(InPutObjectType, "Select a point", False)
Dim opoint As Object
Set opoint = Selection1.Item(1).Value
Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(opoint)
'Creating point using loop
For i = 1 To C
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridShapePointOnCurve1 As HybridShapePointOnCurve
Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveWithReferenceFromDistance(reference2, reference1, D, False)
hybridShapePointOnCurve1.DistanceType = 1
hybridBody1.AppendHybridShape hybridShapePointOnCurve1
part1.InWorkObject = hybridShapePointOnCurve1
Next i
part1.Update
End Sub
Sub CATMain()
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")
'selection of curve
Dim varSelection As Variant
Set varSelection = partDocument1.Selection
ReDim sFilter(1)
MsgBox "Select Curve"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
sStatus1 = varSelection.SelectElement2(sFilter, "Select Curve", False)
Dim oCurve As Object
Set oCurve = varSelection.Item(1).Value
Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(oCurve)
' Calculate curve length
Dim SpaWorkbench As SpaWorkbench
Dim theMeasurable As Measurable
Set SpaWorkbench = partDocument1.GetWorkbench("SPAWorkbench")
Set theMeasurable = SpaWorkbench.GetMeasurable(part1.CreateReferenceFromObject(oCurve))
part1.Update
'MsgBox CStr(theMeasurable.Length)
B = theMeasurable.Length
MsgBox "Curve length" & B
'Enter no of section
C = CInt(InputBox("Enter Required number of section"))
D = B / C
'Selection of Point
Dim Selection1 As Object
Set Selection1 = CATIA.ActiveDocument.Selection
ReDim InPutObjectType(0)
MsgBox "Select Point"
'InPutObjectType(0) = "CATPoint"
'InPutObjectType(0) = "AnyObject"
InPutObjectType(0) = "Point"
Status = Selection1.SelectElement2(InPutObjectType, "Select a point", False)
Dim opoint As Object
Set opoint = Selection1.Item(1).Value
Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(opoint)
'Creating point using loop
For i = 1 To C
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridShapePointOnCurve1 As HybridShapePointOnCurve
Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveWithReferenceFromDistance(reference2, reference1, D, False)
hybridShapePointOnCurve1.DistanceType = 1
hybridBody1.AppendHybridShape hybridShapePointOnCurve1
part1.InWorkObject = hybridShapePointOnCurve1
Next i
part1.Update
End Sub
-
1
- #3
you need to increase your distance with i...
since you are referencing your input point.
change your line to:
Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveWithReferenceFromDistance(reference2, reference1, D * i, False)
regards,
LWolf
since you are referencing your input point.
change your line to:
Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveWithReferenceFromDistance(reference2, reference1, D * i, False)
regards,
LWolf
- Thread starter
- #4
- Thread starter
- #5
how can i select surface?
i am using this code but its shows error.
Dim varSelection1 As Variant
Set varSelection1 = partDocument1.Selection
ReDim sFilter2(1)
MsgBox "Select surface"
sFilter2(0) = "HybridShapesurfaceExplicit"
sFilter2(1) = "MonoDim"
sStatus2 = varSelection1.SelectElement2(sFilter2, "Select surface", False)
Dim osurface As Object
Set osurface = varSelection1.Item(1).Value
Dim surface As Reference
Set surface = part1.CreateReferenceFromObject(osurface)
i am using this code but its shows error.
Dim varSelection1 As Variant
Set varSelection1 = partDocument1.Selection
ReDim sFilter2(1)
MsgBox "Select surface"
sFilter2(0) = "HybridShapesurfaceExplicit"
sFilter2(1) = "MonoDim"
sStatus2 = varSelection1.SelectElement2(sFilter2, "Select surface", False)
Dim osurface As Object
Set osurface = varSelection1.Item(1).Value
Dim surface As Reference
Set surface = part1.CreateReferenceFromObject(osurface)
- Thread starter
- #6
nope, sorry...
anyways, capital S in "HybridShapeSurfaceExplicit" -btw you do realise that you are restricting selection to isolated surfaces only?...
and you need to define part1 and partDocument1 (which I assume come from the above code...)
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As part
Set part1 = partDocument1.part
regards,
LWolf
anyways, capital S in "HybridShapeSurfaceExplicit" -btw you do realise that you are restricting selection to isolated surfaces only?...
and you need to define part1 and partDocument1 (which I assume come from the above code...)
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As part
Set part1 = partDocument1.part
regards,
LWolf
- Thread starter
- #8
- Thread starter
- #9
this is my code , which i am writing.
Dim Pdirection As Variant
Set Pdirection = partDocument1.Selection
MsgBox "Select Press direction"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
sStatus3 = Pdirection.SelectElement2(sFilter, "Select press direction", False)
Dim direction As Object
Set direction = Pdirection.Item(1).Value
Dim hybridShapeDirection1 As HybridShapeDirection
Set hybridShapeDirection1 = hybridShapeFactory2.AddNewDirection(direction)
Dim Pdirection As Variant
Set Pdirection = partDocument1.Selection
MsgBox "Select Press direction"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
sStatus3 = Pdirection.SelectElement2(sFilter, "Select press direction", False)
Dim direction As Object
Set direction = Pdirection.Item(1).Value
Dim hybridShapeDirection1 As HybridShapeDirection
Set hybridShapeDirection1 = hybridShapeFactory2.AddNewDirection(direction)
- Thread starter
- #10
this is my complete code which i have done... except line creation is not completing.
Sub CATMain()
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")
'selection of curve
Dim varSelection As Variant
Set varSelection = partDocument1.Selection
ReDim sFilter(1)
MsgBox "Select Curve"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
sStatus1 = varSelection.SelectElement2(sFilter, "Select Curve", False)
Dim oCurve As Object
Set oCurve = varSelection.Item(1).Value
Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(oCurve)
'selecting surface
Dim varSelection1 As Variant
Set varSelection1 = partDocument1.Selection
ReDim sFilter2(1)
MsgBox "Select surface"
sFilter2(0) = "HybridShape"
sFilter2(1) = "MonoDim"
sStatus2 = varSelection1.SelectElement2(sFilter2, "Select surface", False)
Dim osurface As Object
Set osurface = varSelection1.Item(1).Value
Dim surface As Reference
Set surface = part1.CreateReferenceFromObject(osurface)
' Calculate curve length
Dim SpaWorkbench As SpaWorkbench
Dim theMeasurable As Measurable
Set SpaWorkbench = partDocument1.GetWorkbench("SPAWorkbench")
Set theMeasurable = SpaWorkbench.GetMeasurable(part1.CreateReferenceFromObject(oCurve))
part1.Update
'MsgBox CStr(theMeasurable.Length)
B = theMeasurable.Length
MsgBox "Curve length" & B
'Enter no of section
C = CInt(InputBox("Enter Required number of section"))
D = B / C
'Selection of Point
Dim Selection1 As Object
Set Selection1 = CATIA.ActiveDocument.Selection
ReDim InputObjectType(0)
MsgBox "Select Point"
'InPutObjectType(0) = "CATPoint"
'InPutObjectType(0) = "AnyObject"
InputObjectType(0) = "Point"
Status = Selection1.SelectElement2(InputObjectType, "Select a point", False)
Dim opoint As Object
Set opoint = Selection1.Item(1).Value
Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(opoint)
'select press direction
Dim Pdirection As Variant
Set Pdirection = partDocument1.Selection
MsgBox "Select Press direction"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
sStatus3 = Pdirection.SelectElement2(sFilter, "Select press direction", False)
Dim direction As Object
Set direction = Pdirection.Item(1).Value
Dim hybridShapeDirection1 As HybridShapeDirection
Set hybridShapeDirection1 = hybridShapeFactory2.AddNewDirection(direction)
'Creating point using loop
For i = 1 To C
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridShapePointOnCurve1 As HybridShapePointOnCurve
Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveWithReferenceFromDistance(reference2, reference1, D * i, False)
hybridShapePointOnCurve1.DistanceType = 1
hybridBody1.AppendHybridShape hybridShapePointOnCurve1
part1.InWorkObject = hybridShapePointOnCurve1
' creating plane
Dim hybridShapePlaneNormal1 As HybridShapePlaneNormal
Set hybridShapePlaneNormal1 = hybridShapeFactory1.AddNewPlaneNormal(reference2, hybridShapePointOnCurve1)
hybridBody1.AppendHybridShape hybridShapePlaneNormal1
part1.InWorkObject = hybridShapePlaneNormal1
'Intersection curve
Dim hybridShapeIntersection1 As HybridShapeIntersection
Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(hybridShapePlaneNormal1, surface)
hybridShapeIntersection1.PointType = 0
hybridBody1.AppendHybridShape hybridShapeIntersection1
part1.InWorkObject = hybridShapeIntersection1
' selecting near curve
Dim hybridShapeNear1 As HybridShapeNear
Set hybridShapeNear1 = hybridShapeFactory1.AddNewNear(hybridShapeIntersection1, hybridShapePointOnCurve1)
hybridBody1.AppendHybridShape hybridShapeNear1
part1.InWorkObject = hybridShapeNear1
'creating perpendicular line
Dim hybridShapeLinePtDir1 As HybridShapeLinePtDir
Set hybridShapeLinePtDir1 = hybridShapeFactory1.AddNewLinePtDir(hybridShapePointOnCurve1, hybridShapeDirection1, 0#, 20#, False)
Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies1.Item("Geometrical Set.1")
hybridBody2.AppendHybridShape hybridShapeLinePtDir1
part1.InWorkObject = hybridShapeLinePtDir1
Next i
part1.Update
End Sub
Sub CATMain()
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")
'selection of curve
Dim varSelection As Variant
Set varSelection = partDocument1.Selection
ReDim sFilter(1)
MsgBox "Select Curve"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
sStatus1 = varSelection.SelectElement2(sFilter, "Select Curve", False)
Dim oCurve As Object
Set oCurve = varSelection.Item(1).Value
Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(oCurve)
'selecting surface
Dim varSelection1 As Variant
Set varSelection1 = partDocument1.Selection
ReDim sFilter2(1)
MsgBox "Select surface"
sFilter2(0) = "HybridShape"
sFilter2(1) = "MonoDim"
sStatus2 = varSelection1.SelectElement2(sFilter2, "Select surface", False)
Dim osurface As Object
Set osurface = varSelection1.Item(1).Value
Dim surface As Reference
Set surface = part1.CreateReferenceFromObject(osurface)
' Calculate curve length
Dim SpaWorkbench As SpaWorkbench
Dim theMeasurable As Measurable
Set SpaWorkbench = partDocument1.GetWorkbench("SPAWorkbench")
Set theMeasurable = SpaWorkbench.GetMeasurable(part1.CreateReferenceFromObject(oCurve))
part1.Update
'MsgBox CStr(theMeasurable.Length)
B = theMeasurable.Length
MsgBox "Curve length" & B
'Enter no of section
C = CInt(InputBox("Enter Required number of section"))
D = B / C
'Selection of Point
Dim Selection1 As Object
Set Selection1 = CATIA.ActiveDocument.Selection
ReDim InputObjectType(0)
MsgBox "Select Point"
'InPutObjectType(0) = "CATPoint"
'InPutObjectType(0) = "AnyObject"
InputObjectType(0) = "Point"
Status = Selection1.SelectElement2(InputObjectType, "Select a point", False)
Dim opoint As Object
Set opoint = Selection1.Item(1).Value
Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(opoint)
'select press direction
Dim Pdirection As Variant
Set Pdirection = partDocument1.Selection
MsgBox "Select Press direction"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
sStatus3 = Pdirection.SelectElement2(sFilter, "Select press direction", False)
Dim direction As Object
Set direction = Pdirection.Item(1).Value
Dim hybridShapeDirection1 As HybridShapeDirection
Set hybridShapeDirection1 = hybridShapeFactory2.AddNewDirection(direction)
'Creating point using loop
For i = 1 To C
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridShapePointOnCurve1 As HybridShapePointOnCurve
Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveWithReferenceFromDistance(reference2, reference1, D * i, False)
hybridShapePointOnCurve1.DistanceType = 1
hybridBody1.AppendHybridShape hybridShapePointOnCurve1
part1.InWorkObject = hybridShapePointOnCurve1
' creating plane
Dim hybridShapePlaneNormal1 As HybridShapePlaneNormal
Set hybridShapePlaneNormal1 = hybridShapeFactory1.AddNewPlaneNormal(reference2, hybridShapePointOnCurve1)
hybridBody1.AppendHybridShape hybridShapePlaneNormal1
part1.InWorkObject = hybridShapePlaneNormal1
'Intersection curve
Dim hybridShapeIntersection1 As HybridShapeIntersection
Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(hybridShapePlaneNormal1, surface)
hybridShapeIntersection1.PointType = 0
hybridBody1.AppendHybridShape hybridShapeIntersection1
part1.InWorkObject = hybridShapeIntersection1
' selecting near curve
Dim hybridShapeNear1 As HybridShapeNear
Set hybridShapeNear1 = hybridShapeFactory1.AddNewNear(hybridShapeIntersection1, hybridShapePointOnCurve1)
hybridBody1.AppendHybridShape hybridShapeNear1
part1.InWorkObject = hybridShapeNear1
'creating perpendicular line
Dim hybridShapeLinePtDir1 As HybridShapeLinePtDir
Set hybridShapeLinePtDir1 = hybridShapeFactory1.AddNewLinePtDir(hybridShapePointOnCurve1, hybridShapeDirection1, 0#, 20#, False)
Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies1.Item("Geometrical Set.1")
hybridBody2.AppendHybridShape hybridShapeLinePtDir1
part1.InWorkObject = hybridShapeLinePtDir1
Next i
part1.Update
End Sub
- Thread starter
- #11
final update:
But still error.
Sub CATMain()
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")
'selection of curve
Dim varSelection As Variant
Set varSelection = partDocument1.Selection
ReDim sFilter(1)
MsgBox "Select Curve"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
Dim oCurve As Object
Set oCurve = varSelection.Item(1).Value
Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(oCurve)
'selecting surface
Dim varSelection1 As Variant
Set varSelection1 = partDocument1.Selection
ReDim sFilter2(1)
MsgBox "Select surface"
sFilter2(0) = "HybridShape"
sFilter2(1) = "MonoDim"
sStatus2 = varSelection1.SelectElement2(sFilter2, "Select surface", False)
Dim osurface As Object
Set osurface = varSelection1.Item(1).Value
Dim surface As Reference
Set surface = part1.CreateReferenceFromObject(osurface)
' Calculate curve length
Dim SpaWorkbench As SpaWorkbench
Dim theMeasurable As Measurable
Set SpaWorkbench = partDocument1.GetWorkbench("SPAWorkbench")
Set theMeasurable = SpaWorkbench.GetMeasurable(part1.CreateReferenceFromObject(oCurve))
part1.Update
'MsgBox CStr(theMeasurable.Length)
B = theMeasurable.Length
MsgBox "Curve length" & B
'Enter no of section
C = CInt(InputBox("Enter Required number of section"))
D = B / C
'Selection of Point
Dim Selection1 As Object
Set Selection1 = CATIA.ActiveDocument.Selection
ReDim InputObjectType(0)
MsgBox "Select Point"
'InPutObjectType(0) = "CATPoint"
'InPutObjectType(0) = "AnyObject"
InputObjectType(0) = "Point"
Status = Selection1.SelectElement2(InputObjectType, "Select a point", False)
Dim opoint As Object
Set opoint = Selection1.Item(1).Value
Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(opoint)
'select press direction
Dim varSelection5 As Variant
Set varSelection5 = partDocument1.Selection
ReDim sFilter5(1)
MsgBox "Select cutting direction"
sFilter5(0) = "HybridShapeCurveExplicit"
sFilter5(1) = "MonoDim"
Dim Pdirection As Object
Set Pdirection = varSelection5.Item(1).Value
Dim reference5 As Reference
Set reference5 = part1.CreateReferenceFromObject(Pdirection)
Dim direction As HybridShapeDirection
Set direction = hybridShapeFactory2.AddNewDirection(reference5)
'Creating point using loop
For i = 1 To C
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridShapePointOnCurve1 As HybridShapePointOnCurve
Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveWithReferenceFromDistance(reference2, reference1, D * i, False)
hybridShapePointOnCurve1.DistanceType = 1
hybridBody1.AppendHybridShape hybridShapePointOnCurve1
part1.InWorkObject = hybridShapePointOnCurve1
' creating plane
Dim hybridShapePlaneNormal1 As HybridShapePlaneNormal
Set hybridShapePlaneNormal1 = hybridShapeFactory1.AddNewPlaneNormal(reference2, hybridShapePointOnCurve1)
hybridBody1.AppendHybridShape hybridShapePlaneNormal1
part1.InWorkObject = hybridShapePlaneNormal1
'Intersection curve
Dim hybridShapeIntersection1 As HybridShapeIntersection
Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(hybridShapePlaneNormal1, surface)
hybridShapeIntersection1.PointType = 0
hybridBody1.AppendHybridShape hybridShapeIntersection1
part1.InWorkObject = hybridShapeIntersection1
' selecting near curve
Dim hybridShapeNear1 As HybridShapeNear
Set hybridShapeNear1 = hybridShapeFactory1.AddNewNear(hybridShapeIntersection1, hybridShapePointOnCurve1)
hybridBody1.AppendHybridShape hybridShapeNear1
part1.InWorkObject = hybridShapeNear1
'creating perpendicular line
Dim hybridShapeLinePtDir1 As HybridShapeLinePtDir
Set hybridShapeLinePtDir1 = hybridShapeFactory1.AddNewLinePtDir(hybridShapePointOnCurve1, hybridShapeDirection1, 0#, 20#, False)
Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies1.Item("Geometrical Set.1")
hybridBody2.AppendHybridShape hybridShapeLinePtDir1
part1.InWorkObject = hybridShapeLinePtDir1
Next i
part1.Update
End Sub
But still error.
Sub CATMain()
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")
'selection of curve
Dim varSelection As Variant
Set varSelection = partDocument1.Selection
ReDim sFilter(1)
MsgBox "Select Curve"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
Dim oCurve As Object
Set oCurve = varSelection.Item(1).Value
Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(oCurve)
'selecting surface
Dim varSelection1 As Variant
Set varSelection1 = partDocument1.Selection
ReDim sFilter2(1)
MsgBox "Select surface"
sFilter2(0) = "HybridShape"
sFilter2(1) = "MonoDim"
sStatus2 = varSelection1.SelectElement2(sFilter2, "Select surface", False)
Dim osurface As Object
Set osurface = varSelection1.Item(1).Value
Dim surface As Reference
Set surface = part1.CreateReferenceFromObject(osurface)
' Calculate curve length
Dim SpaWorkbench As SpaWorkbench
Dim theMeasurable As Measurable
Set SpaWorkbench = partDocument1.GetWorkbench("SPAWorkbench")
Set theMeasurable = SpaWorkbench.GetMeasurable(part1.CreateReferenceFromObject(oCurve))
part1.Update
'MsgBox CStr(theMeasurable.Length)
B = theMeasurable.Length
MsgBox "Curve length" & B
'Enter no of section
C = CInt(InputBox("Enter Required number of section"))
D = B / C
'Selection of Point
Dim Selection1 As Object
Set Selection1 = CATIA.ActiveDocument.Selection
ReDim InputObjectType(0)
MsgBox "Select Point"
'InPutObjectType(0) = "CATPoint"
'InPutObjectType(0) = "AnyObject"
InputObjectType(0) = "Point"
Status = Selection1.SelectElement2(InputObjectType, "Select a point", False)
Dim opoint As Object
Set opoint = Selection1.Item(1).Value
Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(opoint)
'select press direction
Dim varSelection5 As Variant
Set varSelection5 = partDocument1.Selection
ReDim sFilter5(1)
MsgBox "Select cutting direction"
sFilter5(0) = "HybridShapeCurveExplicit"
sFilter5(1) = "MonoDim"
Dim Pdirection As Object
Set Pdirection = varSelection5.Item(1).Value
Dim reference5 As Reference
Set reference5 = part1.CreateReferenceFromObject(Pdirection)
Dim direction As HybridShapeDirection
Set direction = hybridShapeFactory2.AddNewDirection(reference5)
'Creating point using loop
For i = 1 To C
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridShapePointOnCurve1 As HybridShapePointOnCurve
Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveWithReferenceFromDistance(reference2, reference1, D * i, False)
hybridShapePointOnCurve1.DistanceType = 1
hybridBody1.AppendHybridShape hybridShapePointOnCurve1
part1.InWorkObject = hybridShapePointOnCurve1
' creating plane
Dim hybridShapePlaneNormal1 As HybridShapePlaneNormal
Set hybridShapePlaneNormal1 = hybridShapeFactory1.AddNewPlaneNormal(reference2, hybridShapePointOnCurve1)
hybridBody1.AppendHybridShape hybridShapePlaneNormal1
part1.InWorkObject = hybridShapePlaneNormal1
'Intersection curve
Dim hybridShapeIntersection1 As HybridShapeIntersection
Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(hybridShapePlaneNormal1, surface)
hybridShapeIntersection1.PointType = 0
hybridBody1.AppendHybridShape hybridShapeIntersection1
part1.InWorkObject = hybridShapeIntersection1
' selecting near curve
Dim hybridShapeNear1 As HybridShapeNear
Set hybridShapeNear1 = hybridShapeFactory1.AddNewNear(hybridShapeIntersection1, hybridShapePointOnCurve1)
hybridBody1.AppendHybridShape hybridShapeNear1
part1.InWorkObject = hybridShapeNear1
'creating perpendicular line
Dim hybridShapeLinePtDir1 As HybridShapeLinePtDir
Set hybridShapeLinePtDir1 = hybridShapeFactory1.AddNewLinePtDir(hybridShapePointOnCurve1, hybridShapeDirection1, 0#, 20#, False)
Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies1.Item("Geometrical Set.1")
hybridBody2.AppendHybridShape hybridShapeLinePtDir1
part1.InWorkObject = hybridShapeLinePtDir1
Next i
part1.Update
End Sub
- Thread starter
- #12
some tips: [ol 1]
[li]use option explicit [/li]
[li]no need to redefine selection[/li]
[li]Sstatus = varSelection.SelectElement2(sFilter, "Select a point", False) ... the message "Select a point" is shown in lower left of CATIA[/li]
[li] do some error handling with Sstatus[/li]
[li]clear selection after you're done with it[/li]
[li]I've only appended the near, all the other items are aggregated under it (intersect and plane), this you can of course change with append [/li]
[li]UpdateObject does exactly that... no need to update the entire part[/li]
[/ol]
regards,
LWolf
[li]use option explicit [/li]
[li]no need to redefine selection[/li]
[li]Sstatus = varSelection.SelectElement2(sFilter, "Select a point", False) ... the message "Select a point" is shown in lower left of CATIA[/li]
[li] do some error handling with Sstatus[/li]
[li]clear selection after you're done with it[/li]
[li]I've only appended the near, all the other items are aggregated under it (intersect and plane), this you can of course change with append [/li]
[li]UpdateObject does exactly that... no need to update the entire part[/li]
[/ol]
Code:
Option Explicit
Sub CATMain()
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As part
Set part1 = partDocument1.part
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.item("Geometrical Set.1")
Dim varSelection As Variant
Set varSelection = partDocument1.Selection
Dim Sstatus
'selection of curve
ReDim sFilter(1)
'MsgBox "Select Curve"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
Sstatus = varSelection.SelectElement2(sFilter, "Select curve", False)
Dim oCurve As Object
Set oCurve = varSelection.item(1).Value
Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(oCurve)
varSelection.Clear
'selecting surface
ReDim sFilter(1)
'MsgBox "Select surface"
sFilter(0) = "HybridShape"
sFilter(1) = "MonoDim"
Sstatus = varSelection.SelectElement2(sFilter, "Select surface", False)
Dim osurface As Object
Set osurface = varSelection.item(1).Value
Dim surface As Reference
Set surface = part1.CreateReferenceFromObject(osurface)
varSelection.Clear
' Calculate curve length
Dim SpaWorkbench As SpaWorkbench
Dim theMeasurable As Measurable
Set SpaWorkbench = partDocument1.GetWorkbench("SPAWorkbench")
Set theMeasurable = SpaWorkbench.GetMeasurable(part1.CreateReferenceFromObject(oCurve))
part1.Update
'MsgBox CStr(theMeasurable.Length)
Dim b, C, D
b = theMeasurable.Length
'MsgBox "Curve length" & b
'Enter no of section
C = CInt(InputBox("Enter Required number of section"))
D = b / C
'Selection of Point
ReDim sFilter(0)
'MsgBox "Select Point"
sFilter(0) = "Point"
Sstatus = varSelection.SelectElement2(sFilter, "Select a point", False)
Dim opoint As Object
Set opoint = varSelection.item(1).Value
Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(opoint)
varSelection.Clear
'select press direction
ReDim sFilter(1)
'MsgBox "Select cutting direction"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
Sstatus = varSelection.SelectElement2(sFilter, "Select curve for direction", False)
Dim Pdirection As Object
Set Pdirection = varSelection.item(1).Value
Dim reference5 As Reference
Set reference5 = part1.CreateReferenceFromObject(Pdirection)
Dim direction As HybridShapeDirection
Set direction = part1.HybridShapeFactory.AddNewDirection(reference5)
'Creating geometries using loop
Dim i As Integer
For i = 1 To C
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridShapePointOnCurve1 As HybridShapePointOnCurve
Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveWithReferenceFromDistance(reference2, reference1, D * i, False)
hybridShapePointOnCurve1.DistanceType = 1
hybridBody1.AppendHybridShape hybridShapePointOnCurve1
part1.InWorkObject = hybridShapePointOnCurve1
' creating plane
Dim hybridShapePlaneNormal1 As HybridShapePlaneNormal
Set hybridShapePlaneNormal1 = hybridShapeFactory1.AddNewPlaneNormal(reference2, hybridShapePointOnCurve1)
'Intersection curve
Dim hybridShapeIntersection1 As HybridShapeIntersection
Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(hybridShapePlaneNormal1, surface)
hybridShapeIntersection1.PointType = 0
Dim hybridShapeNear1 As HybridShapeNear
Set hybridShapeNear1 = hybridShapeFactory1.AddNewNear(hybridShapeIntersection1, hybridShapePointOnCurve1)
hybridBody1.AppendHybridShape hybridShapeNear1
part1.UpdateObject hybridShapeNear1
'creating perpendicular line
Dim hybridShapeLinePtDir1 As HybridShapeLinePtDir
Set hybridShapeLinePtDir1 = hybridShapeFactory1.AddNewLinePtDir(hybridShapePointOnCurve1, direction, 0, 20, False)
' Dim hybridBody2 As HybridBody
' Set hybridBody2 = hybridBodies1.item("Geometrical Set.1")
hybridBody1.AppendHybridShape hybridShapeLinePtDir1
part1.UpdateObject hybridShapeLinePtDir1
Next i
'part1.Update
End Subregards,
LWolf
- Thread starter
- #14
It is better to post whole code as it is not clear how your oCurve object is defined. I am also not sure, why you need to measure the same object oCurve 3 times.
Tesak
- Play Tetris in CATIA V5 drawing
Tesak
- Play Tetris in CATIA V5 drawing
- Thread starter
- #18
- Thread starter
- #19
- Thread starter
- #20
- Status
Similar threads
- Locked
- Question
- Locked
- Question