Code:
'The Positions is set by the user selecting points within Sketches.
'A line orthogonal to the Sketch and a new point at the
'position of the selected Point are created in a new Geometric Set
'After finishing, the Sketches of the selected Points are set to NoShow.Sub CATMain()
Const length = 5.000000 'the length of the line in each direction
Const NoShowSketches = true 'will the Sketches set to noshow after script is done?
Const CreatePoints = true 'will a point be created in the Geometric Set?
COnst SetnameC = "RivetSet" 'The name of the Created geometrical Set
Dim Status as String
Dim i as Integer
Dim j as Integer
Dim partDocument1 As Document
Dim part1 As Part
Dim HybridBodies1 as HybridBodies
Dim hybridBody1 As HybridBody
'Dim sketch1 As Sketch
Dim Selection As Selection
Dim SelectedPoint
Dim oRef as Reference
Dim reference1 As Reference
Dim hybridShapeFactory1 As Factory
Dim shapes1 As Shapes
Dim Point as HybridShapePointExplicit
Dim hybridShapeDirection1 As HybridShapeDirection
Dim hybridShapeLinePtDir1 As HybridShapeLinePtDir
Dim Sketches(500) as Sketch
Dim Bodies(100)
Dim InputObjectType(0)
Dim RivetName as String
Dim LineName as String
Dim number as Integer
Dim NumberSet as Integer
Dim Name as String
Dim SetName As String
Dim oParent
Dim multi as Boolean
Dim Count
'Get the part
Set partDocument1 = CATIA.ActiveDocument
Set Selection = partDocument1.Selection
'Selection.clear
'Get the rivet type
Rivetname = InputBox("Enter the type of the Rivets")
if Rivetname = "" then
exit sub
end if
LineName=Rivetname&"-CL"
SetName=SetnameC&" ("&Rivetname&")"
if Selection.count <> 0 then
multi = true
else
multi = false
end if
'Work loop
i=1
Do
'User selects Points
if not multi then
Selection.clear
InputObjectType(0)= "ZeroDimFeatVertexOrWireBoundaryMonoDimFeatVertex"
Status = Selection.SelectElement2(InputObjectType, "Punkt auswaehlen", False)
if Status = "Cancel" then
Selection.clear
i=i-1
count=i
Do while (i>0)
Selection.add Bodies(i)
i=i-1
Loop
Selection.VisProperties.SetRealLineType 4,1
Selection.VisProperties.SetSymbolType 2
if NoShowSketches then
Selection.Clear
i=1
Do while i<=count
Selection.Add Sketches(i)
i=i+1
loop
Selection.VisProperties.SetShow 1
end if
exit sub
end if
end if
do while (selection.count > 0)
if typename(Selection.Item(1).value) = "ZeroDimFeatVertexOrWireBoundaryMonoDimFeatVertex" then
exit do
else
Selection.remove(1)
end if
loop
if selection.count = 0 then
on error resume next
part1.update
partDocument1.product.update
on error goto 0
Selection.clear
i=i-1
count=i
Do while (i>0)
Selection.add Bodies(i)
i=i-1
Loop
Selection.VisProperties.SetRealLineType 4,1
Selection.VisProperties.SetSymbolType 2
if NoShowSketches then
Selection.Clear
i=1
Do while i<=count
Selection.Add Sketches(i)
i=i+1
loop
Selection.VisProperties.SetShow 1
end if
exit sub
end if
Set SelectedPoint = Selection.Item(1)
if multi then
Selection.Remove(1)
end if
'check if the Point is within a Sketch
If TypeName(SelectedPoint.value.parent) = "Sketch" then
set oRef =SelectedPoint.Reference
'Check for Overrun
if i>500 then
msgbox "Maximum Number of Rivets exceeded (500).Stopping execution."
Selection.clear
i=i-1
count=i
Do while (i>0)
Selection.add Bodies(i)
i=i-1
Loop
Selection.VisProperties.SetRealLineType 4,1
Selection.VisProperties.SetSymbolType 2
if NoShowSketches then
Selection.Clear
i=1
Do while i<count
Selection.Add Sketches(i)
i=i+1
loop
Selection.VisProperties.SetShow 1
end if
exit sub
end if
'Remember Sketches to set on NoShow
Set Sketches(i) = SelectedPoint.value.parent
i=i+1
'get the part and the geoSet
Set oParent = SelectedPoint.value.parent.parent
Do While TypeName(oParent) <> "PartDocument"
Set oParent = oParent.parent
Loop
Set part1 = oParent.Part
Set HybridBodies1 = part1.HybridBodies
Set hybridShapeFactory1 = part1.HybridShapeFactory
'Get the right geometrical Set
Set HybridBodies1 = part1.HybridBodies
Set HybridBody1 = Nothing
For j=1 to hybridBodies1.Count
if hybridBodies1.Item(j).name=Setname then
Set hybridBody1 = hybridBodies1.Item(j)
end if
next
if hybridBody1 is Nothing then
Set hybridBody1 = hybridBodies1.Add()
hybridBody1.Name=Setname
number = 0
else
'Get the right Number
number=0
For j=1 to hybridbody1.HybridShapes.Count
name=hybridbody1.HybridShapes.Item(j).name
NumberSet = Right(name,len(Name)-InStrRev(Name, ".") )
If NumberSet > number then
if IsNumeric(NumberSet) then
number= NumberSet
end if
end if
next
end if
if CreatePoints then
'Create the Point
Set Point = hybridShapeFactory1.AddNewpointCoordWithReference (0,0,0, oRef)
Point.name= RivetName&"."& number+1
hybridBody1.AppendHybridShape point
end if
'Create the Line
Set reference1 = part1.CreateReferenceFromObject(SelectedPoint.value.parent)
Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirection(reference1)
Set hybridShapeLinePtDir1 = hybridShapeFactory1.AddNewLinePtDir(oRef, hybridShapeDirection1, -length, length, False)
hybridShapeLinePtDir1.name=LineName&"."& number+1
'Remember the Body
Set Bodies(i-1) = hybridBody1
hybridBody1.AppendHybridShape hybridShapeLinePtDir1
if not multi then
part1.Update
end if
else
msgbox "Point must be within a Sketch"
end if
Loop
End Sub
Foren auf CAD.de (alle Foren)
| 
