AnsweredAssumed Answered

Macro only works near origin.

Question asked by J. Legtenberg on Aug 19, 2015
Latest reply on Aug 19, 2015 by J. Legtenberg

Hello,

 

I am working on a macro. I want to insert a sketch with my custom properties as text. After that, the sketch has to be renamed to "Gravering". When i click near the origin the name changes correct. If i click further away from the origin the name does not change.  The custom properties are "PARTNO" and "Revisie1". I also want to know if it is possible to check if there already is a sketch with the name "gravering"

 

Here is my code:

 

Dim swApp As Object

 

 

Dim Part As Object

Dim boolstatus As Boolean

Dim longstatus As Long, longwarnings As Long

Dim Point As Variant

 

 

Sub main()

 

 

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

Set SelMgr = Part.SelectionManager

   

'Get xyz of seected face edge point etc.

Point = SelMgr.GetSelectionPoint2(1, -1)

'Print xyz

Debug.Print "X= " & Point(0)

Debug.Print "Y= " & Point(1)

Debug.Print "Z= " & Point(2)

'Print result of selecting component

Debug.Print Part.Extension.SelectByID2("", "COMPONENT", Point(0), Point(1), Point(2), False, 0, Nothing, 0)

 

 

Part.Extension.SelectByID2 "", "FACE", Point(0), Point(1), Point(2), False, 0, Nothing, 0

Part.SketchManager.InsertSketch True

Part.InsertSketchText Point(0), Point(1), Point(2), "$PRP:""PartNo""+$PRP:""Revisie1""", 0, 0, 0, 100, 100

Part.ClearSelection2 True

Part.SketchManager.InsertSketch True

Part.ActivateSelectedFeature

Part.Extension.SelectByID2 "", "SKETCH", 0, 0, 0, False, 0, Nothing, 0

Part.SelectedFeatureProperties 0, 0, 0, 0, 0, 0, 0, 1, 0, "Gravering"

End Sub

 

Thanks!

Outcomes