11 Replies Latest reply on Mar 24, 2017 4:41 AM by wilfried.bauer

    Is there a way to fix plane shapes being off grid?

    wilfried.bauer

      Sometimes it happens that plane shape coordinates jump off grid. I'm searching for an automated way to get the coordinates back to nearest grid. Does anybody have a hint on how to do it? Looks like the geometry of plane shapes is read-only.

        • 1. Re: Is there a way to fix plane shapes being off grid?
          Patrick.Cashman

          1. get the plane shape.

          2. get the geometry of the shape, then the pointsarray of the geometry

          3. delete the shape.

          4. cycle through the pointsarray, moving each point to the nearest grid point

          5. redraw the plane shape using the modified pointsarray

           

          How to round to nearest grid point: if grid is n, then

          new_value = math.round(old_value / n, 0) * n

           

          Here's an example .net script:

           

          Sub snap_plane_to_grid()

                   Dim planes As MGCPCB.PlaneShapes

                   Dim plane As MGCPCB.PlaneShape

                   Dim geom As MGCPCB.Geometry

                   Dim ptary As Object

                   Dim n, i, layer, pts As Integer

                   Dim val, newval As Double

                   Dim grid As Double

                   Dim net As MGCPCB.Net

                   Dim edc As MGCPCB.EditorControl

                  

                   edc = doc.EditorControl

                   grid = edc.Grid(2)    'get drawing grid value

                  

                   planes = doc.PlaneShapes(1)

                   For Each plane In planes

                       layer = plane.Layer

                       net = plane.Net

                       geom = plane.Geometry

                       ptary = geom.PointsArray

                       pts = UBound(ptary, 2) + 1

                      

                       'cycle through the pointsarray

                       For n = 0 To UBound(ptary, 2)

                           'cycle through the x, y, r of the pointsarray values

                           For i = 0 To 2

                               val = ptary(i, n)

                               newval = Math.Round(val / grid, 0) * grid

                               ptary(i, n) = newval

                           Next

                       Next

                      

                       plane.Delete

                       plane = Nothing

                       Try

                           If doc.TransactionStart(0) = True Then

                               plane = doc.PutPlaneShape(layer, pts, ptary, net)

                               doc.TransactionEnd(True)

                           End If

                       Catch ex As Exception

                           Debug.Print(ex.Message)

                           Continue For

                       End Try

                   Next

          End Sub

          1 of 1 people found this helpful
          • 2. Re: Is there a way to fix plane shapes being off grid?
            wilfried.bauer

            Delete and build new - good idea, thanks.

            I'm now translating it to VBscript. Almost done; just the row

             

            plane = doc.PutPlaneShape(layer, pts, ptary, net)

             

            refuses to work up to now. Ends up in a type mismatch. I need to debug it.

            • 3. Re: Is there a way to fix plane shapes being off grid?
              wilfried.bauer

              Months' later I need to come back to this topic again.

              I almost managed to convert the .net script to VbScript. But close to end at line

               

                      PlShape = pcbDoc.PutPlaneShape(layer, pts, ptary, net)

               

              I get an error message

               

                      Error:0x800a000d 'Type mismatch: 'pcbDoc.PutPlaneShape''

               

              I cannot imagine where it comes from. Does anybody have a hint?

               

              Thanks for your help and Best Regards

              Wilfried 

               

               

              The code: (I added lots of debug msgbox's which will vanish finally)

               

              Option Explicit    

              '---------------------------------------

              ' Main program

              '---------------------------------------

              ' Get the application object

              Dim pcbApp

              Set pcbApp = Application

              Scripting.AddTypeLibrary("MGCPCB.ExpeditionPCBApplication")

               

              ' Get the active document

              Dim pcbDoc

              Set pcbDoc = pcbApp.ActiveDocument

              ' License the document

              If (ValidateServer(pcbDoc) = 1) Then

                  Call main

              End If

               

               

              Sub main()

                  pcbApp.lockserver

                  pcbDoc.transactionStart (epcbDRCModeNone)

               

                  Dim PlShape, planeShapeCount, planeShapeGrid, edcontrol, PlaneShapeNew, planes

                  Dim layer, net, ptary, pts, val, newval, n, i

                 

                  Set edcontrol = pcbDoc.EditorControl

                  planeShapeGrid = edcontrol.Grid(2, 2) * 25.4 / 1000        ' convert grid to metric value

                  msgbox ("set all selected planeShapes to DrawGrid = " & planeShapeGrid & " mm")

               

                  planeShapeCount = 0

                  set planes = pcbDoc.PlaneShapes(epcbSelectAll,0)

                  For Each PlShape In planes

                      If PlShape.selected = True Then

                          layer = PlShape.Layer

                          net = PlShape.Net

                          ptary = PlShape.Geometry.PointsArray

                          pts = UBound(ptary, 2) + 1

                          msgbox ("pts: " & pts)

                          msgbox("ptary old:" & vbcrlf & ptary(0,0) & vbTab & ptary(1,0) & vbTab & ptary(2,0) & vbcrlf & ptary(0,1)     & vbTab & ptary(1,1) & vbTab & ptary(2,1) & vbcrlf & ptary(0,2) & vbTab & ptary(1,2) & vbTab & ptary(2,2) & vbcrlf & ptary(0,3) & vbTab & ptary(1,3) & vbTab & ptary(2,3) & vbcrlf & ptary(0,4) & vbTab & ptary(1,4) & vbTab & ptary(2,4))

                         

                          'cycle through the pointsarray

                          For n = 0 To UBound(ptary, 2)

                              'cycle through the x, y, r of the pointsarray values

                              For i = 0 To 2

                                  val = ptary(i, n)

                                  newval = Round(val*(1/planeShapeGrid),0)/(1/planeShapeGrid)   

                                  'msgbox ("n: " & n & "  i: " & i & "  val: " & val & "  newval: " & newval)

                                  ptary(i, n) = newval

                              Next

                          Next

                         

                          PlShape.Delete

                          Set PlShape = Nothing

                          ' Try

                              If pcbDoc.TransactionStart(0) = True Then

                                  ' no Try Catch available in VB Script => workaround

                                  'On Error Resume Next        '' commented out for debugging purposes

                                  msgbox ("pcbDoc: " & pcbDoc)

                                  msgbox ("layer: " & layer & "  pts: " & pts & "  net: " & net)

                                  msgbox(    "ptary new:" & vbcrlf & ptary(0,0) & vbTab & ptary(1,0) & vbTab & ptary(2,0) & vbcrlf & ptary(0,1)     & vbTab & ptary(1,1) & vbTab & ptary(2,1) & vbcrlf & ptary(0,2) & vbTab & ptary(1,2) & vbTab & ptary(2,2) & vbcrlf & ptary(0,3) & vbTab & ptary(1,3) & vbTab & ptary(2,3) & vbcrlf & ptary(0,4) & vbTab & ptary(1,4) & vbTab & ptary(2,4))

                                 

                                  PlShape = pcbDoc.PutPlaneShape(layer, pts, ptary, net)

                                  planeShapeCount = planeShapeCount + 1

                                  pcbDoc.TransactionEnd(True)

                              End If

                      End If

                  Next

                  MsgBox(planeShapeCount & " planeShapes set to grid")

                  pcbDoc.transactionEnd

                  pcbApp.unlockServer

              End Sub

              • 4. Re: Is there a way to fix plane shapes being off grid?
                kendall_hiles

                set PlShape = pcbDoc.PutPlaneShape

                 

                or

                 

                call pcbDoc.PutPlaneShape

                • 5. Re: Is there a way to fix plane shapes being off grid?
                  wilfried.bauer

                  Thanks for your help, but unfortunately this doesn't solve the issue. I had already tried with 'set'; now also the 'call' version doesn't work. Both end up in same error message as mentioned above.

                  • 6. Re: Is there a way to fix plane shapes being off grid?
                    kendall_hiles

                    You also need the set on the net.

                     

                    There are many examples in AATK for reference.  I do not use .net because I need all the scripts to run on Linux as well.

                    • 7. Re: Is there a way to fix plane shapes being off grid?
                      wilfried.bauer

                      After having a look into some AATK code examples I added some more parameters to the questionable row:

                       

                      Set PlShape = pcbDoc.PutPlaneShape(layer, pts, ptary, net, False, , , , Nothing, epcbUnitCurrent)

                       

                      One of these solved the issue.

                       

                      Thanks again for your help.

                      Wilfried

                      • 8. Re: Is there a way to fix plane shapes being off grid?
                        matthias.cosaert

                        You can also set the new geometry on the existing plane shape:

                        PlShape.Geometry.Outline(epcbunitcurrent) = ptary


                        Then you don't have to worry about having to set the planeclass (parameter) overwrites and the planeshape properties to the same setting again.
                        (would have to compare every planeclass property to the default setting for that planeclass and maintaining the script when switching to a newer version that has new plane shape or class properties)

                        • 9. Re: Is there a way to fix plane shapes being off grid?
                          wilfried.bauer

                          Did you try it?

                          PCB Automation Reference says Geometry property of plane shapes has just read-only access. So I won't wonder if it doesn't work in your way.

                          • 10. Re: Is there a way to fix plane shapes being off grid?
                            matthias.cosaert

                            I Haven't tried in .net but it works for me in vbscript  (used it in a script to chamfer corners)
                            The geometry.outline property has read\\write acces

                            • 11. Re: Is there a way to fix plane shapes being off grid?
                              wilfried.bauer

                              So finally, after having implemented all hints from Patrick Cashman, Kendall Hiles and Matthias Cosaert the solution looks as follows:

                               

                              Option Explicit    

                               

                              '---------------------------------------

                              ' Main program

                              '---------------------------------------

                              ' Get the application object

                              Dim pcbApp

                              Set pcbApp = Application

                              Scripting.AddTypeLibrary("MGCPCB.ExpeditionPCBApplication")

                               

                              ' Get the active document

                              Dim pcbDoc

                              Set pcbDoc = pcbApp.ActiveDocument

                              ' License the document

                              If (ValidateServer(pcbDoc) = 1) Then

                                  Call main

                              End If

                               

                               

                              Sub main()

                                pcbApp.lockserver

                                pcbDoc.transactionStart (epcbDRCModeNone)

                               

                                Dim PlShape, planeShapeCount, planeShapeGrid, edcontrol, PlaneShapeNew, planes

                                Dim layer, net, ptary, pts, val, newval, n, i

                               

                                Set edcontrol = pcbDoc.EditorControl

                                planeShapeGrid = edcontrol.Grid(2, 2) * 25.4 / 1000 ' convert grid to metric value

                                if planeShapeGrid = 0 then

                                    msgbox ("ERROR: Drawing grid is set to 'None' => abort script")

                                    exit sub

                                end if

                                msgbox ("set all selected planeShapes to DrawGrid = " & planeShapeGrid & " mm")

                               

                                planeShapeCount = 0

                                set planes = pcbDoc.PlaneShapes(epcbSelectAll,0)

                                For Each PlShape In planes

                                  If PlShape.selected = True Then

                                        layer = PlShape.Layer

                                        set net = PlShape.Net

                                        ptary = PlShape.Geometry.PointsArray

                                        pts = UBound(ptary, 2) + 1

                                        'msgbox ("pts: " & pts) ' debugging output

                                        'msgbox( "ptary old:" & vbcrlf & ptary(0,0) & vbTab & ptary(1,0) & vbTab & ptary(2,0) & vbcrlf & ptary(0,1) & vbTab & ptary(1,1) & vbTab & ptary(2,1) & vbcrlf & ptary(0,2) & vbTab & ptary(1,2) & vbTab & ptary(2,2) & vbcrlf & ptary(0,3) & vbTab & ptary(1,3) & vbTab & ptary(2,3) & vbcrlf & ptary(0,4) & vbTab & ptary(1,4) & vbTab & ptary(2,4)) ' debugging output

                                         

                                        'cycle through the pointsarray

                                        For n = 0 To UBound(ptary, 2)

                                            'cycle through the x, y, r of the pointsarray values

                                          For i = 0 To 2

                                               val = ptary(i, n)

                                              newval = Round(val*(1/planeShapeGrid),0)/(1/planeShapeGrid)

                                                'msgbox ("n: " & n & "  i: " & i & "  val: " & val & "  newval: " & newval) ' debugging output

                                              ptary(i, n) = newval

                                            Next

                                       Next

                                         

                                        If pcbDoc.TransactionStart(0) = True Then

                                          'On Error Resume Next '' commented out for debugging purposes

                                         'msgbox ("pcbDoc: " & pcbDoc) ' debugging output

                                           'msgbox ("layer: " & layer & "  pts: " & pts & "  net: " & net) ' debugging output

                                           'msgbox( "ptary new:" & vbcrlf & ptary(0,0) & vbTab & ptary(1,0) & vbTab & ptary(2,0) & vbcrlf & ptary(0,1) & vbTab & ptary(1,1) & vbTab & ptary(2,1) & vbcrlf & ptary(0,2) & vbTab & ptary(1,2) & vbTab & ptary(2,2) & vbcrlf & ptary(0,3) & vbTab & ptary(1,3) & vbTab & ptary(2,3) & vbcrlf & ptary(0,4) & vbTab & ptary(1,4) & vbTab & ptary(2,4)) ' debugging output

                               

                                          PlShape.Geometry.Outline(epcbunitcurrent) = ptary

                                          planeShapeCount = planeShapeCount + 1

                                         pcbDoc.TransactionEnd(True)

                                      End If

                                  End If

                                Next

                               

                                if planeShapeCount > 0 then

                                    MsgBox(planeShapeCount & " planeShape(s) set to grid")

                                else

                                    MsgBox("No  planeShapes selected => nothing to do")

                                end if

                               

                                pcbDoc.transactionEnd

                                pcbApp.unlockServer

                              End Sub

                               

                               

                              '---------------------------------------

                              ' Begin Validate Server Function

                              '---------------------------------------

                              Private Function ValidateServer(doc)

                                Dim key, licenseServer, licenseToken

                                ' Ask Expedition’s document for the key

                                key = doc.Validate(0)

                                ' Get license server

                                Set licenseServer = CreateObject("MGCPCBAutomationLicensing.Application")

                                ' Ask the license server for the license token

                                licenseToken = licenseServer.GetToken(key)

                                ' Release license server

                                Set licenseServer = Nothing

                                ' Turn off error messages.  Validate may fail if the token is incorrect

                                On Error Resume Next

                                Err.Clear

                                ' Ask the document to validate the license token

                                doc.Validate(licenseToken)

                                If Err Then

                                ValidateServer = 0   

                                Else

                                ValidateServer = 1

                                End If

                              End Function

                              '---------------------------------------

                              ' End Validate Server Function

                              '---------------------------------------

                               

                              Feel free to copy it and use for your own purposes.

                               

                              @ Matthias Cosaert:

                              Would you like to share your script to chamfer corners as well?