PCB Filter

Select a group of components with the traces and vias.
Type:
Not( (ObjectKind = 'Component')) And IsSelected
in to the PCB Filter panel.

Below in  the Object passing the filter check the "Select" box
and in the Objects not passing the filter check the "Deselect" and choose "Normal" in the drop down box.

This will deselect the components and leave all of the other primitives selected so they can be copied without copying the components to be used on another group of parts.

Before Filter

After Filter 

www.tdpcb.com

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

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