I'm trying to make a macro to build a simple rectangle centered on the
origin by selecting midpoint of a side and making it horizontal with
the origin (same thing for the top line). I don't want the diagonal
construction ligne midpointed to the origin...
When I record it I get this but if I play it back I don't get it
centered. Is it possible code it so to preselect a point other than
the origin and build a centered rectangle? This is my first macro by
the way...
Somebody did it before? We often start basic rectangle centered on the
origin so I'd like to programm it.
Thank!
Robin
------------
Dim swApp As Object
Dim Part As Object
Dim SelMgr As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As Object
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
Dim SkLine As Object
Set SkLine = Part.SketchManager.CreateLine(-0.1, 0.1, 0, 0.1, 0.1, 0)
Set SkLine = Part.SketchManager.CreateLine(0.1, 0.1, 0, 0.1, -0.1, 0)
Set SkLine = Part.SketchManager.CreateLine(0.1, -0.1, 0, -0.1, -0.1,
0)
Set SkLine = Part.SketchManager.CreateLine(-0.1, -0.1, 0, -0.1, 0.1,
0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Line53", "SKETCHSEGMENT", 0,
0.1, 0, False, 0, Nothing, 0)
Part.SelectMidpoint
boolstatus = Part.Extension.SelectByID2("Point1@[EMAIL PROTECTED]
",
"EXTSKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
Part.SketchAddConstraints "sgVERTICALPOINTS2D"
Part.SketchAddConstraints "sgVERTICALPOINTS2D"
boolstatus = Part.Extension.SelectByID2("Line56", "SKETCHSEGMENT",
-0.1, 0, 0, False, 0, Nothing, 0)
Part.SelectMidpoint
boolstatus = Part.Extension.SelectByID2("Point1@[EMAIL PROTECTED]
",
"EXTSKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
Part.SketchAddConstraints "sgHORIZONTALPOINTS2D"
Part.SketchAddConstraints "sgHORIZONTALPOINTS2D"
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Point95", "SKETCHPOINT", 0,
0, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Point1@[EMAIL PROTECTED]
",
"EXTSKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
End Sub
|
