6 Replies Latest reply on Sep 14, 2018 12:40 PM by Lars Ahlzen

    API Automatically Scale and Position a drawing view

    John Lindskog

      When a part or assemble changes size, we need to re-scale and re-position the drawing view on the page. We also don't want the drawing views on a page to overlap each other. This subroutine (which you can call from the Main module of your Macro) can re-scale and re-position your drawing view so that you don't have to.

       

      '******************************************************************************************************************************

      Sub ScaleAndPositionView(DrawingViewName As String, LeftSide As Double, Bottom As Double, RightSide As Double, _

          Top As Double, Optional HorizontalPosition As String, Optional VerticalPosition As String) 'Written by John D. Lindskog

      'This subroutine scales and positions a drawing view to fit inside a virtual box defined by 4 values.

      'This subroutine does not work on Detail Views or Section Views.

      '******************************************************************************************************************************

       

       

      Dim swView As SldWorks.View

       

       

      Dim ScaleRatio(1) As Double

      Dim ScaleFactor(1) As Double

      Dim RoundedScaleFactor(1) As Double

      Dim ViewOutlineMatrix As Variant

      Dim PositionMatrix As Variant

      Dim TransferMatrix(2) As Double

       

       

      swModel.ActivateView DrawingViewName                                    'Activate the Drawing View

       

       

      Set swView = swModel.ActiveDrawingView                                  'Connect the view object to the active drawing view.

       

       

      If swView Is Nothing Then                                               'If there is a problem finding the specified view then,

          MsgBox "Error Scaling View: " & DrawingViewName, vbOKOnly, "Drawing View was not found."

          Exit Sub                                                            'send the user a message and end the subroutine.

      End If

       

       

      If swView.Type = SwConst.swDrawingViewTypes_e.swDrawingDetailView Then

          MsgBox "ScaleAndPositionViews subroutine error: " & DrawingViewName, vbOKOnly, "Detail Views not supported."

          Exit Sub                                                            'Send the user a message and end the subroutine.

      ElseIf swView.Type = SwConst.swDrawingViewTypes_e.swDrawingSectionView Then

          MsgBox "ScaleAndPositionViews subroutine error: " & DrawingViewName, vbOKOnly, "Section Views not supported."

          Exit Sub                                                            'Send the user a message and end the subroutine.

      End If

       

       

      ViewOutlineMatrix = swView.GetOutline                                   'Get the x, y, min and max values for the view outline

                                                                            

      LeftSide = LeftSide * 0.0254                                            'Convert inch Values to meter values

      RightSide = RightSide * 0.0254                                          'because SW thinks in meters.

      Bottom = Bottom * 0.0254

      Top = Top * 0.0254

       

       

      ScaleRatio(0) = 1                                                       'Set the scale ratio denominator to 1.

       

       

      ScaleFactor(0) = (ViewOutlineMatrix(2) - ViewOutlineMatrix(0)) / (RightSide - LeftSide)

      ScaleFactor(1) = (ViewOutlineMatrix(3) - ViewOutlineMatrix(1)) / (Top - Bottom)

       

       

      RoundedScaleFactor(0) = Round(ScaleFactor(0) / swView.ScaleDecimal + 0.5) 'We add 0.5 to make the VBA Round function

      RoundedScaleFactor(1) = Round(ScaleFactor(1) / swView.ScaleDecimal + 0.5) 'behave like a RoundUp function.

       

       

      ScaleRatio(1) = IIf(RoundedScaleFactor(1) > RoundedScaleFactor(0), RoundedScaleFactor(1), RoundedScaleFactor(0))

       

       

      If ScaleRatio(1) = 2 Then

          swView.ScaleDecimal = swView.ScaleDecimal / IIf(ScaleFactor(1) > ScaleFactor(0), ScaleFactor(1), ScaleFactor(0))

      Else

          swView.ScaleRatio = ScaleRatio                                      'Set the scale ratio to the limiting ratio.

      End If                                                                  'which is either horizontal or vertical

       

       

      ViewOutlineMatrix = swView.GetOutline                                   'Get the new x, y, min and max values

      PositionMatrix = swView.Position                                        'Get the new x, y, position of the view origin.

       

       

      If UCase(HorizontalPosition) = "LEFT" Then

          TransferMatrix(0) = LeftSide + (ViewOutlineMatrix(2) - ViewOutlineMatrix(0)) / 2

      ElseIf UCase(HorizontalPosition) = "RIGHT" Then

          TransferMatrix(0) = RightSide - (ViewOutlineMatrix(2) - ViewOutlineMatrix(0)) / 2

      Else

          TransferMatrix(0) = (LeftSide + RightSide) / 2 + PositionMatrix(0) - (ViewOutlineMatrix(2) + ViewOutlineMatrix(0)) / 2

      End If

      If UCase(VerticalPosition) = "BOTTOM" Then

          TransferMatrix(1) = Bottom + (ViewOutlineMatrix(3) - ViewOutlineMatrix(1)) / 2

      ElseIf UCase(VerticalPosition) = "TOP" Then

          TransferMatrix(1) = Top - (ViewOutlineMatrix(3) - ViewOutlineMatrix(1)) / 2

      Else

          TransferMatrix(1) = (Top + Bottom) / 2 + PositionMatrix(1) - (ViewOutlineMatrix(3) + ViewOutlineMatrix(1)) / 2

      End If

      TransferMatrix(2) = 0                               'Yes there is a 'z' coordinate on the 2-D drawing page. Don't ask why.

       

       

      PositionMatrix = TransferMatrix                     'Pass the array data to the variant safe-array Position Matrix.

      swView.Position = PositionMatrix                    'The view position function only accepts arrays created in this way.

      Set swView = Nothing

       

       

      End Sub

        • Re: API Automatically Scale and Position a drawing view
          Marco Wu

          Hi all,

           

          I am new to VBA. Would anyone show how to use the above code? E.g. What should I put in the start up code?

           

          Thanks

          • Re: API Automatically Scale and Position a drawing view
            Lars Ahlzen

            Hello

             

            Not sure if I will get an answer but in the code I get the error message Error 424 "Object required" on this line:

             

            swModel.ActivateView DrawingViewName

             

            I have inserted the name of my drawing view, "Drawing View1", but should I declare this as an object or anything in my own code before calling this sub. Any ideas?

              • Re: API Automatically Scale and Position a drawing view
                Deepak Gupta

                Lars Ahlzen wrote:

                 

                Hello

                 

                Not sure if I will get an answer but in the code I get the error message Error 424 "Object required" on this line:

                 

                swModel.ActivateView DrawingViewName

                 

                I have inserted the name of my drawing view, "Drawing View1", but should I declare this as an object or anything in my own code before calling this sub. Any ideas?

                When you're calling this sub ScaleAndPositionView, make sure your are passing the name of your view as string.

                 

                If you can share your full macro, then someone can debug the issue easily.

                  • Re: API Automatically Scale and Position a drawing view
                    Lars Ahlzen

                    No worries Mr.Gupta I managed to figure out this one by myself. But thank you as always.

                      • Re: API Automatically Scale and Position a drawing view
                        Quinn Seys

                        Hi,

                         

                        I am having the same error of object not found. It only happens when I try to call the sub into another module. If I run the sub on it's own it works fine.

                         

                        Here is how I'm calling the sub

                         

                        Call Scale_Drawings1.ScaleAndPositionView("Drawing View1", 0, 0, PaperWidth, PaperHeight).

                         

                        Thanks for the help

                          • Re: API Automatically Scale and Position a drawing view
                            Lars Ahlzen

                            I am really new to this sorta stuff so keep this in mind but I figured it couldn't access the model that was being used. So I just implemented the classic commands:

                             

                            Set swApp = Application.SldWorks

                            Set swModel = swApp.ActiveDoc

                            swModel.ActivateView DrawingViewName                                    'Activate the Drawing View

                            Set swView = swModel.ActiveDrawingView                                  'Connect the view object to the active drawing view.

                             

                            Since you are running it through another sub that already has declared the activeDoc (usually) declaring it again in this sub and having it pointing to the active model shouldn't be a problem. But as I said, I have been trying this for a week so maybe I don't know what the hell I am talking about. This is also the excuse if my wording of the problem/solution isn't really up to code (pun intended) with how one might talk about the VBA language. But right under:

                             

                            Dim TransferMatrix(2) As Double

                             

                            And over:

                             

                            swModel.ActivateView DrawingViewName

                             

                            I declared:

                             

                            Set swApp = Application.SldWorks

                            Set swModel = swApp.ActiveDoc

                             

                            Let me know if that helps, maybe I did some other stuff too that I can't remember. I ended up writing my own with this as a template since it didn't do exactly what I wanted.