PSWUG.INFO - Polish SolidWorks User Group.

Polish SOLIDWORKS User Group - SOLIDWORKS 2019

SolidWorks >> Makra >> Podmiana nazw wymiarów za pomocą makra

Autor	Wypowiedź
Jaroslaw Jakacki
SOLIDWORKS 2017 2019-06-24, 10:02 Pomógł 0 raz(y).	Witam, Mam problem z zamiana nazw wymiarów w szkicu za pomocą makra. Rozumiem ze po każdorazowym dodaniu wymiaru jest on zaznaczany i następnie funkcja GetDimenstion można go pobrać a następnie zmodyfikować aczkolwiek w moim przykładzie to nie działa z jakiegoś powodu... Z góry dzięki za pomoc. Dim swApp As Object Dim Part As ModelDoc2 Dim boolstatus As Boolean Dim longstatus As Long, longwarnings As Long Sub main() Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0) Part.ClearSelection2 True boolstatus = Part.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swSketchAddConstToRectEntity, swUserPreferenceOption_e.swDetailingNoOptionSpecified, True) boolstatus = Part.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swSketchAddConstLineDiagonalType, swUserPreferenceOption_e.swDetailingNoOptionSpecified, True) Dim vSkLines As Variant vSkLines = Part.SketchManager.CreateCornerRectangle(-0.423271691992487, 2.9966994054468, 0, -1.01520338584846, 3.63560980516436, 0) Part.ClearSelection2 True boolstatus = Part.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swSketchAddConstToRectEntity, swUserPreferenceOption_e.swDetailingNoOptionSpecified, True) boolstatus = Part.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swSketchAddConstLineDiagonalType, swUserPreferenceOption_e.swDetailingNoOptionSpecified, True) vSkLines = Part.SketchManager.CreateCornerRectangle(-2.63127086748697, 2.9966994054468, 0, -1.97356898542479, 3.63560980516436, 0) Part.SetPickMode Part.ClearSelection2 True Dim skSegment As Object Set skSegment = Part.SketchManager.CreateCircle(-1.015203, 3.63561, 0#, -1.146744, 3.729567, 0#) Part.ClearSelection2 True Set skSegment = Part.SketchManager.CreateCircle(-1.973569, 3.63561, 0#, -1.879612, 3.720171, 0#) ' Zoom In/Out (MouseWheel) Dim swModelView As Object Set swModelView = Part.ActiveView swModelView.Scale2 = 3.40947473135048E-02 Dim swTranslation() As Double ReDim swTranslation(0 To 2) As Double swTranslation(0) = -2.86102537804256E-03 swTranslation(1) = -6.40967336337806E-02 swTranslation(2) = 0 Dim swTranslationVar As Variant swTranslationVar = swTranslation Dim swMathUtils As Object Set swMathUtils = swApp.GetMathUtility() Dim swTranslationVector As MathVector Set swTranslationVector = swMathUtils.CreateVector((swTranslationVar)) swModelView.Translation3 = swTranslationVector ' Zoom In/Out (MouseWheel) Set swModelView = Part.ActiveView swModelView.Scale2 = 4.10780088114515E-02 ReDim swTranslation(0 To 2) As Double swTranslation(0) = -1.38203638672481E-02 swTranslation(1) = -9.45697627613358E-02 swTranslation(2) = 0 swTranslationVar = swTranslation Set swMathUtils = swApp.GetMathUtility() Set swTranslationVector = swMathUtils.CreateVector((swTranslationVar)) swModelView.Translation3 = swTranslationVector boolstatus = Part.Extension.SelectByID2("Arc1", "SKETCHSEGMENT", -1.17465994213438, 3.73914448377929, 0, True, 0, Nothing, 0) Part.SketchAddConstraints "sgSAMELENGTH" boolstatus = Part.Extension.SelectByID2("Line4", "SKETCHSEGMENT", -1.01931451588776, 3.15659913535447, 0, False, 0, Nothing, 0) boolstatus = Part.Extension.SelectByID2("Line10", "SKETCHSEGMENT", -1.97727797774191, 3.21485367019695, 0, True, 0, Nothing, 0) Part.SketchAddConstraints "sgSAMELENGTH" boolstatus = Part.Extension.SelectByID2("Line1", "SKETCHSEGMENT", -0.799241828705044, 2.98830825692063, 0, False, 0, Nothing, 0) boolstatus = Part.Extension.SelectByID2("Line7", "SKETCHSEGMENT", -2.15851430836297, 2.99478098301424, 0, True, 0, Nothing, 0) Part.SketchAddConstraints "sgSAMELENGTH" Part.ClearSelection2 True boolstatus = Part.Extension.SelectByID2("Line2", "SKETCHSEGMENT", -0.391460084807667, 3.47376271394132, 0, False, 0, Nothing, 0) boolstatus = Part.Extension.SelectByID2("Right", "PLANE", 3.37620690249096E-03, -0.215691159415911, 1.44, True, 0, Nothing, 0) Part.SketchAddConstraints "sgCOLINEAR" Part.ClearSelection2 True boolstatus = Part.Extension.SelectByID2("Line1", "SKETCHSEGMENT", -0.164914671531347, 2.98183553082702, 0, False, 0, Nothing, 0) boolstatus = Part.Extension.SelectByID2("Bottom", "PLANE", 0.501776116110396, -2.09119832678869E-03, -1.42000000000002, True, 0, Nothing, 0) Part.SketchAddConstraints "sgCOLINEAR" boolstatus = Part.Extension.SelectByID2("Line7", "SKETCHSEGMENT", -2.2491324736735, 2.9624173525462, 0, False, 0, Nothing, 0) boolstatus = Part.Extension.SelectByID2("Bottom", "PLANE", 0.521194294391224, 4.38152776682103E-03, -1.42000000000002, True, 0, Nothing, 0) Part.SketchAddConstraints "sgCOLINEAR" boolstatus = Part.Extension.SelectByID2("Left", "PLANE", -2.8187323699111, -0.222163885509519, 1.44, False, 0, Nothing, 0) boolstatus = Part.Extension.SelectByID2("Line8", "SKETCHSEGMENT", -2.63102331319644, 0.412163271664188, -5.99999999997181E-03, True, 0, Nothing, 0) Part.SketchAddConstraints "sgCOLINEAR" Part.ClearSelection2 True Dim swSelMgr As SldWorks.SelectionMgr Dim swDispDim As SldWorks.DisplayDimension Dim swDim As SldWorks.Dimension Set swSelMgr = Part.SelectionManager Set swDispDim = swSelMgr.GetSelectedObject5(1) boolstatus = Part.Extension.SelectByID2("Line4", "SKETCHSEGMENT", -1.01931451588776, 3.15659913535447, 0, False, 0, Nothing, 0) Part.AddDimension2 0, 0, 0 Set swDim = swDispDim.GetDimension2(0) swDim.Name = "TEST123" Part.SketchManager.InsertSketch True End Sub


Włodzimierz Śmieszek
. 2019-06-26, 07:54 Pomógł 52 raz(y).	Musisz przestawić ustawianie zmiennych. Końcówka makra powinna być taka: Dim swSelMgr As SldWorks.SelectionMgr Dim swDispDim As SldWorks.DisplayDimension Part.ClearSelection2 True Dim swDim As SldWorks.Dimension boolstatus = Part.Extension.SelectByID2("Line4", "SKETCHSEGMENT", -1.01931451588776, 3.15659913535447, 0, False, 0, Nothing, 0) Part.AddDimension2 0, 0, 0 Set swSelMgr = Part.SelectionManager Set swDispDim = swSelMgr.GetSelectedObject5(1) Set swDim = swDispDim.GetDimension2(0) swDim.Name = "TEST123" Part.SketchManager.InsertSketch True End Sub ... i działa :) Powodzenia.


Jaroslaw Jakacki
SOLIDWORKS 2017 2019-06-27, 08:02 Pomógł 0 raz(y).	Działa :) Dzieki!

PSWUG

Strefa Resellera

Reselerzy w Polsce

Certyfikaty resellerów

Poziomy certyfikacji

Publikuj

Dodaj tricks&tips

Dodaj film youtube

Wyślij informację o SW

Społeczność

Ankieta

Linki

3D ContentCentral

SolidWorks Launch

RSS

RSS - Aktualności

BOT