Move the designator where you click the mouse.

Click on the component and then click at the location where the designator is to be and it moves the designator to that location.


Sub ClickMoveDesPos

Dim Board
Dim Comp
Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub

While Board.ChooseLocation(x,y, "Click Via To Change") = True
  Set Comp = Board.GetObjectAtXYAskUserIfAmbiguous(x,y,MkSet(_
  eComponentObject),AllLayers,eEditAction_Focus)

  If Not(Comp is Nothing) Then
     Call Board.ChooseLocation(x,y, "Select Location")
     Call PCBServer.PreProcess
     Call PCBServer.SendMessageToRobots(Comp.I_ObjectAddress,_
     c_Broadcast, PCBM_BeginModify, c_NoEventData)

           Comp.ChangeNameAutoposition = eAutoPos_Manual
           Comp.Name.XLocation = x
           Comp.Name.YLocation = y

     Call PCBServer.SendMessageToRobots(Comp.I_ObjectAddress,_
     c_Broadcast, PCBM_EndModify , c_NoEventData)
     Call PCBServer.PostProcess
  End If
Wend


ResetParameters
Call AddStringParameter("Action", "Redraw")
RunProcess("PCB:Zoom")
End Sub

www.tdpcb.com

Change the AutoPosition of the designator

Click on a component and the designator autoposition will cycle around the 8 positions each time you click on the component.


Sub CycleDesPos

Dim Board
Dim Comp
Dim I

Dim eAutoArray
'                 0                               1                                 2
'eAutoPos_TopLeft,eAutoPos_CenterLeft,eAutoPos_BottomLeft,
'                  3                                     4                                    5
'eAutoPos_BottomCenter,eAutoPos_BottomRight,eAutoPos_CenterRight,
'                  6                                7
'eAutoPos_TopRight,eAutoPos_TopCenter
eAutoArray = Array(1,2,3,6,9,8,7,4)

Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub

Call PCBServer.PreProcess
While Board.ChooseLocation(x,y, "Click Via To Change") = True
  Set Comp = Board.GetObjectAtXYAskUserIfAmbiguous(x,y,MkSet(_
  eComponentObject),AllLayers,eEditAction_Focus)
  I= -1

   If Not(Comp is Nothing) Then

     'Look for the current setting of the autoposition
     For J = 0 to 7
      If  Comp.NameAutoposition = eAutoArray(J) Then
          I = J + 1
          'Set the array to begin again at eAutoPos_TopLeft
          If J = 7 Then
             I = 0
          End If
      End If
     Next
     'Autoposition is either manual or centercenter
     If I = -1 Then
         I = 0
     End If

     Call PCBServer.SendMessageToRobots(Comp.I_ObjectAddress,_
     c_Broadcast, PCBM_BeginModify, c_NoEventData)

           Comp.ChangeNameAutoposition = eAutoArray(I)

     Call PCBServer.SendMessageToRobots(Comp.I_ObjectAddress,_
     c_Broadcast, PCBM_EndModify , c_NoEventData)

  End If

Wend

Call PCBServer.PostProcess

ResetParameters
Call AddStringParameter("Action", "Redraw")
RunProcess("PCB:Zoom")

End Sub

www.tdpcb.com

Clone a vias net to another via

This required a few months of help from Altium, they didn't solve the problem of not being able to add a net to an exsisting via with "not net". But Altium did put me on the right path, the via with "no net" has to be added to the net object, not adding the net to the via (which works if the via already has a net). So this fixes the previous scripts inability to add a net to a via with "no net".

Sub CloneViaNetOBJ
Dim Board
Dim ObjVia
Dim Borg

Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub
Set ObjVia = Board.GetObjectAtCursor(MkSet(eViaObject)_
,AllLayers,"Select Via to Clone")

NetIterator = Board.BoardIterator_Create
NetIterator.AddFilter_ObjectSet(MkSet(eNetObject))
NetIterator.AddFilter_LayerSet(AllLayers)
NetIterator.AddFilter_Method(eProcessAll)
Set NetFound = NetIterator.FirstPCBObject

While FoundIt = 0 AND Not (NetFound Is Nothing)
      If NetFound.Name = ObjVia.Net.Name Then
         FoundIt = 1
      else
          Set NetFound = NetIterator.NextPCBObject
      End If
Wend

Call PCBServer.PreProcess
While Board.ChooseLocation(x,y, "Click Via To Change") = True
  Set Borg = Board.GetObjectAtXYAskUserIfAmbiguous(x,y,MkSet(_
  eViaObject),AllLayers,eEditAction_Focus)

  If Not(Borg is Nothing) Then
     Call PCBServer.SendMessageToRobots(Borg.I_ObjectAddress,_
     c_Broadcast, PCBM_BeginModify, c_NoEventData)
     'Need to add the via to the net group, not the other way around!
        NetFound.AddPCBObject(borg)
     Call PCBServer.SendMessageToRobots(Borg.I_ObjectAddress,_
     c_Broadcast, PCBM_EndModify , c_NoEventData)
  End If
Wend

Call Board.CleanNet(NetFound) 'How to clean all nets?
Call PCBServer.PostProcess
ResetParameters
Board.BoardIterator_Destroy(NetIterator)
Call AddStringParameter("Action", "Redraw")
RunProcess("PCB:Zoom")
End Sub

Click the via with the net that you want

Then click the ones you want to change.

www.tdpcb.com

List of Altium Shortcut keys

http://wiki.altium.com/display/ADOH/Editor+Shortcuts


www.tdpcb.com

Convert net labels to text Labels and vice versa

Click on a text label and it will be converted to a net label, click on a text label on it will be converted to a net label.

Sub Label2Text

If SchServer Is Nothing Then Exit Sub
Set CurrentSheet = SchServer.GetCurrentSchDocument
If CurrentSheet is Nothing Then Exit Sub

Call SchServer.ProcessControl.PreProcess(CurrentSheet, "")
Set Alocation = CurrentSheet.Location

While CurrentSheet.ChooseLocationInteractively(Alocation,"Select Label")

Set HitTest = CurrentSheet.CreateHitTest(eHitTest_AllObjects, ALocation)

If (HitTest.HitTestCount > 0) Then
  For I = 0 to (HitTest.HitTestCount-1)

    If HitTest.HitObject(I).ObjectId = eLabel Then
      Set SchLabel = SchServer.SchObjectFactory(eNetLabel,eCreate_GlobalCopy)
      SchLabel.FontID = HitTest.HitObject(I).FontID
      Schlabel.Text = HitTest.HitObject(I).Text
      Schlabel.Location = HitTest.HitObject(I).Location
      CurrentSheet.RegisterSchObjectInContainer(SchLabel)
      CurrentSheet.GraphicallyInvalidate
      CurrentSheet.RemoveSchObject(HitTest.HitObject(I))
      Call SchServer.RobotManager.SendMessage(CurrentSheet.I_ObjectAddress,_
      c_BroadCast,SCHM_PrimitiveRegistration,HitTest.HitObject(I).I_ObjectAddress)

    ElseIf HitTest.HitObject(I).ObjectId = eNetLabel Then

      Set SchLabel = SchServer.SchObjectFactory(eLabel,eCreate_GlobalCopy)
      SchLabel.FontID = HitTest.HitObject(I).FontID
      Schlabel.Text = HitTest.HitObject(I).Text
      Schlabel.Location = HitTest.HitObject(I).Location
      CurrentSheet.RegisterSchObjectInContainer(SchLabel)
      CurrentSheet.RemoveSchObject(HitTest.HitObject(I))
      CurrentSheet.GraphicallyInvalidate
      Call SchServer.RobotManager.SendMessage(CurrentSheet.I_ObjectAddress,_
      c_BroadCast,SCHM_PrimitiveRegistration,HitTest.HitObject(I).I_ObjectAddress)

    End If

  Next

End If
Wend

Call SchServer.ProcessControl.PostProcess(CurrentSheet, "")
CurrentSheet.GraphicallyInvalidate

End Sub

www.tdpcb.com

Loop while getting location with ChooseLocationInteractively

How to set up a loop while keeping the cursor active.

Sub LoopIt

If SchServer Is Nothing Then Exit Sub
Set CurrentSheet = SchServer.GetCurrentSchDocument
If CurrentSheet is Nothing Then Exit Sub
Set Alocation = CurrentSheet.Location

While CurrentSheet.ChooseLocationInteractively(Alocation,"Select Label")
'tempStr = LocationtoStr(Alocation)
ShowMessage("Location: " & CoordToMils(Alocation.X)_
       & "," & CoordToMils(Alocation.Y))

Wend

www.tdpcb.com

End Sub

Hit Test Usage for Schematic

Using the ChooseLocationInteractively function to determine what is located at the cursor location when it is clicked.  The HitTest stores all of the objects located at the cursor when clicked.

Sub HitTestExample

If SchServer Is Nothing Then Exit Sub
Set CurrentSheet = SchServer.GetCurrentSchDocument
If CurrentSheet is Nothing Then Exit Sub

Set Alocation = CurrentSheet.Location
Call CurrentSheet.ChooseLocationInteractively(Alocation,"Select Label")
Set HitTest = CurrentSheet.CreateHitTest(eHitTest_AllObjects, ALocation)

If (HitTest.HitTestCount > 0) Then
   For I = 0 to (HitTest.HitTestCount-1)
      ShowMessage ("ObjectID Is " & HitTest.HitObject(I).ObjectId)
   Next

End If

End Sub

www.tdpcb.com

Renumbering PCB pads with a mouse click

Quick way to renumber pads, mostly useful in the pcb library editor.
Click on the pad with the first number and then click on the other pads and they will incremently change numbers.

Sub RenumberPads

Dim Board
Dim Rpad
Dim PadNumber

Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub
Pcbserver.PreProcess
Set PadObject = Board.GetObjectAtCursor(MkSet(ePadObject),_
AllLayers,"Select Pad To Start With")
PadNumber = PadObject.Name + 1

While Board.ChooseLocation(x,y, "Click Next Pad To Renumber") = True
  Set Rpad = Board.GetObjectAtXYAskUserIfAmbiguous(x,y,MkSet(_
  ePadObject),AllLayers,eEditAction_Change)

  If Not(Rpad is Nothing) Then
     Call PCBServer.SendMessageToRobots(Rpad.I_ObjectAddress,_
     c_Broadcast, PCBM_BeginModify, c_NoEventData)

     Rpad.Name = PadNumber

     Call PCBServer.SendMessageToRobots(Rpad.I_ObjectAddress,_
     c_Broadcast, PCBM_EndModify , c_NoEventData)
  End If

  PadNumber = PadNumber + 1
Wend

Pcbserver.PostProcess
ResetParameters
Call AddStringParameter("Action", "Redraw")
RunProcess("PCB:Zoom")

End Sub

www.tdpcb.com

Via Rules

Get the details of the via routing style rule.

Sub GetViaRule

Dim Board
Dim tmpStr

Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub

Iterator = Board.BoardIterator_Create
Iterator.AddFilter_ObjectSet(MkSet(eRuleObject))
Iterator.AddFilter_LayerSet(AllLayers)
Iterator.AddFilter_Method(eProcessAll)
Set Rule = Iterator.FirstPCBObject

While Not (Rule Is Nothing)

 If  Rule.Rulekind =  eRule_RoutingViaStyle Then
 tmpStr = "Name: " & Rule.Name & vbcrlf
 tmpStr = tmpStr & "Pref Via Width: " & CoordtoMils(Rule.PreferedWidth)
 tmpStr = tmpStr & "mils" & vbcrlf
 tmpStr = tmpStr & "Min Via Width: " & CoordtoMils(Rule.MinWidth)
 tmpStr = tmpStr & "mils" & vbcrlf
 tmpStr = tmpStr & "Max Via Width: " & CoordtoMils(Rule.MaxWidth)
 tmpStr = tmpStr & "mils" & vbcrlf
 tmpStr = tmpStr & "Pref Via Hole Width: " & CoordtoMils(Rule.PreferedHoleWidth)
 tmpStr = tmpStr & "mils" & vbcrlf
 tmpStr = tmpStr & "Min Via Hole Width: " & CoordtoMils(Rule.MinHoleWidth)
 tmpStr = tmpStr & "mils" & vbcrlf
 tmpStr = tmpStr & "Max Via Hole Width: " & CoordtoMils(Rule.MaxHoleWidth)
 tmpStr = tmpStr & "mils" & vbcrlf
 tmpStr = tmpStr & "Scope1: " & Rule.Scope1Expression & vbcrlf
 tmpStr = tmpStr & "Scope2: " & Rule.Scope2Expression
 ShowMessage( tmpStr )
 End If

 Set Rule = Iterator.NextPCBObject
Wend

Board.BoardIterator_Destroy(Iterator)
End Sub

www.tdpcb.com

PCB rules and how to access them.

Get access to the PCB rules. Get the width rules and list the details.

Sub GetWidthRule

Dim Board
Dim tmpStr

Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub

Iterator = Board.BoardIterator_Create
Iterator.AddFilter_ObjectSet(MkSet(eRuleObject))
Iterator.AddFilter_LayerSet(AllLayers)
Iterator.AddFilter_Method(eProcessAll)
Set Rule = Iterator.FirstPCBObject

While Not (Rule Is Nothing)
 If  Rule.Rulekind =  eRule_MaxMinWidth Then
  tmpStr = "Name: " & Rule.Name & vbcrlf
  tmpStr = tmpStr & "Preferred: " & CoordtoMils(Rule.FavoredWidth(eTopLayer))
  tmpStr = tmpStr & "mils" & vbcrlf
  tmpStr = tmpStr & "Minimum: " & CoordtoMils(Rule.MinWidth(eTopLayer))
  tmpStr = tmpStr & "mils" & vbcrlf
  tmpStr = tmpStr & "Maximum: " & CoordtoMils(Rule.MaxWidth(eTopLayer))
  tmpStr = tmpStr & "mils" & vbcrlf
  tmpStr = tmpStr & "Scope1: " & Rule.Scope1Expression & vbcrlf
  tmpStr = tmpStr & "Scope2: " & Rule.Scope2Expression
  ShowMessage( tmpStr )
 End If
 Set Rule = Iterator.NextPCBObject
Wend

Board.BoardIterator_Destroy(Iterator)

End Sub

www.tdpcb.com


A list of available rules:

eRule_Clearance,
eRule_ParallelSegment,
eRule_MaxMinWidth,
eRule_MaxMinLength,
eRule_MatchedLengths,
eRule_DaisyChainStubLength,
eRule_PowerPlaneConnectStyle,
eRule_RoutingTopology,
eRule_RoutingPriority,
eRule_RoutingLayers,
eRule_RoutingCornerStyle,
eRule_RoutingViaStyle,
eRule_PowerPlaneClearance,
eRule_SolderMaskExpansion,
eRule_PasteMaskExpansion,
eRule_ShortCircuit,
eRule_BrokenNets,
eRule_ViasUnderSMD,
eRule_MaximumViaCount,
eRule_MinimumAnnularRing,
eRule_PolygonConnectStyle,
eRule_AcuteAngle,
eRule_ConfinementConstraint,
eRule_SMDToCorner,
eRule_ComponentClearance,
eRule_ComponentRotations,
eRule_PermittedLayers,
eRule_NetsToIgnore,
eRule_SignalStimulus,
eRule_Overshoot_FallingEdge,
eRule_Overshoot_RisingEdge,
eRule_Undershoot_FallingEdge,
eRule_Undershoot_RisingEdge,
eRule_MaxMinImpedance,
eRule_SignalTopValue,
eRule_SignalBaseValue,
eRule_FlightTime_RisingEdge,
eRule_FlightTime_FallingEdge,
eRule_LayerStack,
eRule_MaxSlope_RisingEdge,
eRule_MaxSlope_FallingEdge,
eRule_SupplyNets,
eRule_MaxMinHoleSize,
eRule_TestPointStyle,
eRule_TestPointUsage

Swap Component Positions

This will swap the positions of two components that are choosen, including the rotation of the part and the rotation and position of the designators. Based on a script that came with Summer '09 but more useful. If a component is not selected the script will end to avoid a crash.

Sub SwapComps

Dim Board
Dim CompA
Dim CompB
Dim CompX
Dim CompY
Dim CompR
Dim DesX
Dim DesY
Dim DesR

Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub
Pcbserver.PreProcess

While Board.ChooseLocation(x,y, "Select First Componet") = True

  Set CompA = Board.GetObjectAtXYAskUserIfAmbiguous(x,y,MkSet(eComponentObject)_
  ,AllLayers, eEditAction_Select)
  If CompA Is Nothing Then Exit Sub 'Needed, if no comp is selected, crash

   Call Board.ChooseLocation(x,y, "Select Second Componet")
  Set CompB = Board.GetObjectAtXYAskUserIfAmbiguous(x,y,MkSet(eComponentObject)_
  ,AllLayers, eEditAction_Select)
  If CompB Is Nothing Then Exit Sub 'Needed, if no comp is selected, crash

   CompX = CompA.X
   CompY = CompA.Y
   CompR = CompA.Rotation
   DesX  = CompA.Name.XLocation
   DesY  = CompA.Name.YLocation
   DesR  = CompA.Name.Rotation

   Call PCBServer.SendMessageToRobots(CompA.I_ObjectAddress,c_Broadcast,_
   PCBM_BeginModify, c_NoEventData)
   CompA.X = CompB.X
   CompA.Y = CompB.Y
   CompA.Rotation = CompB.Rotation
   CompA.ChangeNameAutoposition = eAutoPos_Manual
   Call PCBServer.SendMessageToRobots(CompA.I_ObjectAddress,c_Broadcast,_
   PCBM_EndModify , c_NoEventData)

   Call PCBServer.SendMessageToRobots(CompA.Name.I_ObjectAddress, c_Broadcast,_
   PCBM_BeginModify, c_NoEventData)
   CompA.Name.XLocation = CompB.Name.XLocation
   CompA.Name.YLocation = CompB.Name.YLocation
   CompA.Name.Rotation = CompB.Name.Rotation
   Call PCBServer.SendMessageToRobots(CompA.Name.I_ObjectAddress, c_Broadcast,_
   PCBM_EndModify , c_NoEventData)

   Call PCBServer.SendMessageToRobots(CompB.I_ObjectAddress,c_Broadcast,_
   PCBM_BeginModify, c_NoEventData)
   CompB.X = CompX
   CompB.Y = CompY
   CompB.Rotation = CompR
   CompB.ChangeNameAutoposition = eAutoPos_Manual
   Call PCBServer.SendMessageToRobots(CompB.I_ObjectAddress,c_Broadcast,_
   PCBM_EndModify , c_NoEventData)

   Call PCBServer.SendMessageToRobots(CompB.Name.I_ObjectAddress, c_Broadcast,_
    PCBM_BeginModify, c_NoEventData)
   CompB.Name.XLocation = DesX
   CompB.Name.YLocation = DesY
   CompB.Name.Rotation = DesR
   Call PCBServer.SendMessageToRobots(CompB.Name.I_ObjectAddress, c_Broadcast,_
    PCBM_EndModify , c_NoEventData)

Wend

Pcbserver.PostProcess
ResetParameters
Call AddStringParameter("Action", "Redraw")
RunProcess("PCB:Zoom")

End Sub

www.tdpcb.com

Set the DRC error for a component

Simple test to look for the "R2" componet and set it's DRC flag.


Sub SetDRC

Dim Board
Dim CompDes
Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub

Iterator = Board.BoardIterator_Create
Iterator.AddFilter_ObjectSet(MkSet(eComponentObject))
Iterator.AddFilter_LayerSet(AllLayers)
Iterator.AddFilter_Method(eProcessComponents)
Set CompDes = Iterator.FirstPCBObject
PCBServer.PreProcess

While Not(CompDes Is Nothing)
  If CompDes.Name.Text = "R2" then
     CompDes.SetState_DRCError = True
  End If
  Set CompDes = Iterator.NextPCBObject
Wend

Board.BoardIterator_Destroy(Iterator)
Pcbserver.PostProcess
ResetParameters
Call AddStringParameter("Action", "Redraw")
RunProcess("PCB:Zoom")

End Sub

www.tdpcb.com

Clone a net from one object to another

I can see this one as being a little dangerous, it's meant to show how to click an object with a net and then any pad, via, or track that you click (that already has a net assigned) will then be changed to the first net that was choosen.

Sub CloneNet

Dim Board
Dim NetObject
Dim Borg

Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub

NetObject = Board.GetObjectAtCursor(MkSet(ePadObject,eTrackObject,eViaObject)_
,AllLayers,"Select Net to Clone")
Call PCBServer.PreProcess
While Board.ChooseLocation(x,y, "Click Item To Change") = True

  Set Borg = Board.GetObjectAtXYAskUserIfAmbiguous(x,y,MkSet(_
  ePadObject,eTrackObject,eViaObject),AllLayers,eEditAction_Change)

  If Not(Borg is Nothing) Then
     Call PCBServer.SendMessageToRobots(Borg.I_ObjectAddress,_
     c_Broadcast, PCBM_BeginModify, c_NoEventData)

     Borg.Net = NetObject.Net

     Call PCBServer.SendMessageToRobots(Borg.I_ObjectAddress,_
     c_Broadcast, PCBM_EndModify , c_NoEventData)
  End If
Wend

Call PCBServer.PostProcess
ResetParameters
Call AddStringParameter("Action", "Redraw")
RunProcess("PCB:Zoom")

End Sub

www.tdpcb.com

Count selected objects

How many objects are currently selected on the PCB.

Sub CountSelObj
Dim Board

Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub

ShowMessage (Board.SelectecObjectCount & " Items are selected.")

End Sub

www.tdpcb.com

Toggle Component Designators

Toggle all component designators on PCB from shown to hidden.

Sub ToggleDesignators

Dim Board
Dim Component

Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub

Iterator = Board.BoardIterator_Create
Iterator.AddFilter_ObjectSet(MkSet(eComponentObject))
Iterator.AddFilter_LayerSet(AllLayers)
Iterator.AddFilter_Method(eProcessAll)
Set Component= Iterator.FirstPCBObject
PCBServer.PreProcess

While Not(Component is Nothing)
  Component.NameOn = Not(Component.NameOn)
  Set Component= Iterator.NextPCBObject
Wend

Board.BoardIterator_Destroy(Iterator)
Pcbserver.PostProcess
ResetParameters
Call AddStringParameter("Action", "Redraw")
RunProcess("PCB:Zoom")

End Sub

 

www.tdpcb.com

Open a text file and read the contents line by line.

As written this needs to be run with a PCB file active.

Sub ReadTextFile

'Constants for File Handling
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateUseDefault = -2
Const TristateTrue = -1
Const TristateFalse = 0
Dim Board
Dim FileName
Dim oFS
Dim oFile
Dim oStream

Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub

'File Handling - Place a text file named "TextFile.txt" in
'the same directory as the current board that is open.
FileName=Left(Board.FileName, InstrRev(Board.FileName, "\") ) & "TextFile.txt"

'Check for the text file
If Not FileExists(FileName) Then
   ShowMessage ( FileName & " was not found.")
   Exit Sub
End If
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oFile = oFS.GetFile(FileName)
Set oStream = oFile.OpenAsTextStream(ForReading, TristateUseDefault)

I = 1
'Read the file in
Do While Not oStream.AtEndOfStream
      sRecord = oStream.ReadLine
      ShowMessage ( "Line #" & I & " " & sRecord )
      I = I + 1
Loop
oStream.Close

End Sub


www.tdpcb.com

Place a track and via with the choosen pad net assigned to them.

Select a pad with a net and a stinger (a track and a via) will be placed with the pads net.

Sub TagPadWithNet

Dim Board
Dim Track
Dim Via
Dim NetObject
Dim PadX
Dim PadY
Dim PadNet
Dim ViasSize
Dim ViaHole

Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub

NetObject = Board.GetObjectAtCursor(MkSet(ePadObject),AllLayers,"Select Net")
PadX = CoordToMils(NetObject.X)
PadY = CoordToMils(NetObject.Y)
PadNet = NetObject.Net.Name
X1 = PadX
X2 = PadX - CoordToMils(NetObject.TopXSize) - 10
Y1 = PadY
Y2 = PadY
Layer = NetObject.Layer
Width = 10
Call PCBServer.PreProcess

'Add the Track
Track           = PCBServer.PCBObjectFactory(eTrackObject, eNoDimension, eCreate_Default)
Track.X1        = MilsToCoord(X1)
Track.X2        = MilsToCoord(X2)
Track.Y1        = MilsToCoord(Y1)
Track.Y2        = MilsToCoord(Y2)
Track.Layer     = Layer
Track.Net       = NetObject.Net
Track.Width     = MilsToCoord(Width)
Board.AddPCBObject(Track)
Call PCBServer.SendMessageToRobots(Board.I_ObjectAddress,_
 c_Broadcast, PCBM_BoardRegisteration, Track.I_ObjectAddress)

'Add the via
ViaSize = 26
ViaHole = 12
Via           = PCBServer.PCBObjectFactory(eViaObject, eNoDimension, eCreate_Default)
Via.X         = MilsToCoord(X2)
Via.Y         = MilsToCoord(Y2)
Via.Size      = MilsToCoord(ViaSize)
Via.HoleSize  = MilsToCoord(ViaHole)
Via.LowLayer  = eTopLayer
Via.HighLayer = eBottomLayer
Via.Net       = NetObject.Net
Board.AddPCBObject(Via)
Call PCBServer.SendMessageToRobots(Board.I_ObjectAddress,_
 c_Broadcast, PCBM_BoardRegisteration, Via.I_ObjectAddress)

Call PCBServer.PostProcess
ResetParameters
Call AddStringParameter("Action", "Redraw")
RunProcess("PCB:Zoom")

End Sub

www.tdpcb.com

Get the board dimensions as defined by the board outline.

Sub BoardDimension
Dim Board
Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub

ShowMessage ( "X=" & CoordToMils(Board.BoardOutline.BoundingRectangle.right _
 - Board.BoardOutline.BoundingRectangle.left) & " mils,Y=" & _
 CoordToMils(Board.BoardOutline.BoundingRectangle.top _
  - Board.BoardOutline.BoundingRectangle.bottom) & " mils")

End Sub

www.tdpcb.com

Identify a pads net.

Simple way to get a pads net.

Sub GetPadNet

Dim Board
Dim NetObject
Dim tmpString
Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub

NetObject = Board.GetObjectAtCursor(MkSet(ePadObject),AllLayers,"Select Net")
tmpString = NetObject.Net.Name
ShowMessage (tmpString)

End Sub

www.tdpcb.com

Report a list of net names in PCB to a file.

Get a list of net names in the PCB and write a report (text file).

Sub ReportNets

Dim Board
Dim FileName
Dim ReportFile
Dim ReportDocument
Dim fso

BeginHourGlass
Set Board = PCBServer.GetCurrentPCBBoard
If Board is Nothing Then Exit Sub

FileName =  Left(Board.FileName, InstrRev(Board.FileName, "\") ) & "ReportNets.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ReportFile = fso.CreateTextFile(FileName, True)

NetIterator = Board.BoardIterator_Create
NetIterator.AddFilter_ObjectSet(MkSet(eNetObject))
NetIterator.AddFilter_LayerSet(AllLayers)
NetIterator.AddFilter_Method(eProcessAll)
Set NetFound = NetIterator.FirstPCBObject

While Not (NetFound Is Nothing)
     Call ReportFile.WriteLine( NetFound.Name )
     Set NetFound = NetIterator.NextPCBObject
Wend

Board.BoardIterator_Destroy(NetIterator)
Call AddStringParameter("Action", "Redraw")
RunProcess("PCB:Zoom")
ReportFile.Close
Set ReportDocument = Client.OpenDocument("Text", FileName)
If Not (ReportDocument Is Nothing) Then
       Client.ShowDocument(ReportDocument)
End If
EndHourGlass

End Sub

www.tdpcb.com