2 Replies Latest reply on May 7, 2016 5:59 AM by Yong Ning

    don't Prompt box for Adddimension2

    Yong Ning

      use Adddimension2, Prompt box ,See Fig.

       

      Help me, don't Prompt box

      Thanks

      2.jpg

       

       

      Sub ll()

        Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

        Dim SwSelMgr As SelectionMgr, tmp

        Set SwModel = Application.SldWorks.ActiveDoc

        Dim SwSeg As SketchSegment

        Set SwSelMgr = SwModel.SelectionManager

        Set SwSeg = SwSelMgr.GetSelectedObject5(1)

        SwSeg.Select True

        With SwModel

          '.AddDimension2 0.15, 0.2, 0

          .AddDimension 0.15, 0.2, 0

          .ClearSelection2 False

          '.EditUndo 0

        End With

      End Sub

        • Re: don't Prompt box for Adddimension2
          Artem Taturevych

          Dim swApp As SldWorks.SldWorks

           

          Sub main()

           

              Set swApp = Application.SldWorks

           

              swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, False

             

          End Sub

          ____________________________________________________

          Regards,

          Artem Taturevych, Application Engineer at Intercad (Australia)

           

          translationXpert – add-in to translate SolidWorks models

          myIntercad an integrated tool for SolidWorks Professionals

          LinkedIn SolidWorks API Education Group

          • Re: don't Prompt box for Adddimension2
            Yong Ning

            Thans Artem Taturevych , Thans yor tips

            the code is

            Sub lll()

             

                Dim SwApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swSketch As SldWorks.Sketch

                Dim swSketchSeg As SldWorks.SketchSegment, swSelMgr As SldWorks.SelectionMgr

                Dim vSketchSeg As Variant, vSketchSegID As Variant

                Dim ii As Long, bRet As Boolean

                Dim SwDim As Dimension, SwDisp As DisplayDimension, SwAnn As Annotation

                ''

                Set SwApp = Application.SldWorks

             

                SwApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, False

                Set swModel = SwApp.ActiveDoc

                Set swSelMgr = swModel.SelectionManager

                Set swSketch = swModel.GetActiveSketch2

                vSketchSeg = swSketch.GetSketchSegments

                For ii = 0 To UBound(vSketchSeg)

                    Set swSketchSeg = vSketchSeg(i)

                    vSketchSegID = swSketchSeg.GetID

                    Debug.Print "    SketchSegID(" & ii & ") = [" & vSketchSegID(0) & ", " & vSketchSegID(1) & "]"

                    Debug.Print "      Type       = " & swSketchSeg.GetType

                    Debug.Print "      Length     = " & swSketchSeg.GetLength

                    swSketchSeg.Select True

                    Set SwDisp = swModel.AddDimension2(0.15, 0.2, 0)

                    Set SwDim = SwDisp.GetDimension

                    Debug.Print SwDim.FullName, SwDim.SystemValue, SwDim.Value

                Next

                SwApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, True

            End Sub

             

            ***************************************************************************************************

             

             

            Private Sub ll()

               Dim Xls As Excel.Application, Sht As Worksheet, Rng As Range, EquationRng As Range

                   Set Xls = GetObject(, "Excel.Application")

                   Set Sht = Xls.Worksheets("JB4715")

                   Set Rng = Xls.Selection

                   Set EquationRng = Sht.Range("A:AZ").Find("CutPlateEquationRng").CurrentRegion

                   ''Debug.Print EquationRng.Address

                  

              

               Dim x1(2), y1(2), x2(2), y2(2), DimArr: DimArr = Array("L", "W", "THK")

                   x1(0) = 0:    x1(1) = 0.1: x1(2) = 0.1

                   y1(1) = 0:    y1(1) = 0:    y1(2) = 0.05

                   x2(0) = 0.1: x2(1) = 0.1: x2(2) = 0.1 - 0.01

                   y2(0) = 0:    y2(1) = 0.05: y2(2) = 0.05

              

               Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

                   Set SwApp = Application.SldWorks

                   SwApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, False

                   Set SwModel = SwApp.ActiveDoc

               Dim SwSelMgr As SelectionMgr, Tmp, ii, jj

                   'Tmp = SwModel.Extension.SelectByID2("Top Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

                   ''

               Dim SwSketch As Sketch, SwSketchSeg As SketchSegment, SwAnn As Annotation

               Dim SwFeat As Feature, SwDim As Dimension, SwDispDim As DisplayDimension

                   SwModel.InsertSketch2 True

                   For ii = 0 To 2

                       Set SwSketchSeg = SwModel.CreateLine2(x1(ii), y1(ii), 0, x2(ii), y2(ii), 0)

                       SwSketchSeg.Select True

                       Set SwDispDim = SwModel.AddDimension2(x1(ii), y1(ii), 0)

                       Set SwDim = SwDispDim.GetDimension

                       SwDim.Name = DimArr(ii)

                       Debug.Print SwDim.Name

                      

                   Next ii

                   Set SwSketch = SwSketchSeg.GetSketch

                   Set SwFeat = SwSketch

                   SwFeat.Name = "PlateSize"

                   SwModel.InsertSketch2 True

               Dim SwEqnMgr As EquationMgr

                   Set SwEqnMgr = SwModel.GetEquationMgr

                   For ii = 2 To EquationRng.Rows.Count

                       SwEqnMgr.Add ii - 2, EquationRng(ii)

                   Next ii

                  

               SwApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, True

                  

            End Sub