Net Classes and the members

Iterate through the net classes and the members but skip pass any net class that begins with "All"

Sub ClassMembers
Dim I
' Checks if the current document is a PCB document
  Set Board = PCBServer.GetCurrentPCBBoard
  If Board is Nothing Then Exit Sub
  Iterator = Board.BoardIterator_Create
  Iterator.AddFilter_ObjectSet(MkSet(eClassObject))
  Iterator.AddFilter_LayerSet(AllLayers)
  Set NetClass = Iterator.FirstPCBObject
  I = 0

  While Not (NetClass Is Nothing) 'Get Net Classes
    If NetClass.MemberKind = eClassMemberKind_Net Then
       If Left(NetClass.Name,3) <> "All"   Then  'Ignore any class the begins with "All"
           ShowMessage NetClass.Name & " is a netclass"
        
          While NetClass.MemberName(I) <> ""
              ShowMessage NetClass.MemberName(I) & " is in the netclass " & NetClass.Name
              I = I + 1
          Wend
       End If

       I = 0
    End if
    Set NetClass = Iterator.NextPcbObject
  Wend

Board.BoardIterator_Destroy(Iterator)
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

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

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

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