Dear all,
I've a small macro that works perfectly (the macro change the size of a sketch text). I try to put this macro in a macro feature, but the selection of the sketch doesn't work any more when it's inside a Function.
To be honest, I just copy past part of code I found. I'm really bad une VBA. If you have any clue for me, I take it. I'm pretty sure that the problem is somewhere at the "SelectByID2" and at the "Rebuilt", because If I manually select the Text Sketch, it works.
Thanks already !
The Working Code :
Dim App As SldWorks.SldWorks
Dim Doc As SldWorks.ModelDoc2
Dim SelMgr As SelectionMgr
Dim text As SketchText
Dim format As TextFormat
Sub main()
Set A = Application.SldWorks
Set Doc = App.ActiveDoc
Set SelMgr = Doc.SelectionManager
Doc.Extension.SelectByID2 "Sketch7", "SKETCH", 0, 0, 0, False, 0, Nothing, 0
Doc.EditSketch
Doc.Extension.SelectByID2 "SketchText1", "SKETCHTEXT", 0, 0, 0, False, 0, Nothing, 0
Set text = SelMgr.GetSelectedObject6(1, -1)
Set format = text.GetTextFormat
format.CharHeight = Doc.Parameter("D1@Fillet3").SystemValue / 1.5
text.SetTextFormat False, format
Doc.EditRebuild3
End Sub
The not Working Code :
Dim App As SldWorks.SldWorks
Dim Doc As SldWorks.ModelDoc2
Dim FeatureMgr As SldWorks.FeatureManager
Dim Methods(8) As String
Dim Names As Variant
Dim Types As Variant
Dim Values As Variant
Dim ThisFile As String
Dim Options As Long
Dim MacroFeature As Feature
Function swmRebuild(vrApp As Variant, vrPart As Variant, vrFeature As Variant) As Variant
Dim SelMgr As SelectionMgr
Dim text As SketchText
Dim format As TextFormat
'Set App = Application.SldWorks
'Set Doc = App.ActiveDoc
Set SelMgr = Doc.SelectionManager
Doc.Extension.SelectByID2 "Sketch7", "SKETCH", 0, 0, 0, False, 0, Nothing, 0
Doc.EditSketch
Doc.Extension.SelectByID2 "SketchText1", "SKETCHTEXT", 0, 0, 0, False, 0, Nothing, 0
Set text = SelMgr.GetSelectedObject6(1, -1)
Set format = text.GetTextFormat
format.CharHeight = Doc.Parameter("D1@Fillet3").SystemValue / 1.5
text.SetTextFormat False, format
Doc.EditRebuild3
End Function
Sub main()
Set App = Application.SldWorks
Set Doc = App.ActiveDoc
If Doc Is Nothing Then
App.SendMsgToUser2 "Il n'y a pas de document actif. P'tit con !", swMbWarning, swMbOk
Exit Sub
End If
ThisFile = App.GetCurrentMacroPathName
Methods(0) = ThisFile: Methods(1) = "Main_Programme": Methods(2) = "swmRebuild"
Methods(3) = ThisFile: Methods(4) = "Main_Programme": Methods(5) = "swmEditDefinition"
Methods(6) = "": Methods(7) = "": Methods(8) = "" 'A security routine is optional
Names = Empty
Types = Empty
Values = Empty
Options = swMacroFeatureByDefault
Set FeatureMgr = Doc.FeatureManager
Set MacroFeature = FeatureMgr.InsertMacroFeature("Text size", "", (Methods), Names, Types, Values, Nothing, Options)
End Sub
Function swmEditDefinition(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant
End Function
I solve a part of my problem, I replaced :
By :
Now all the transformations of the sketch text work. My next problem is to exit the sketch.