http://wiki.altium.com/display/ADOH/Editor+Shortcuts
www.tdpcb.com
Altium Designer Script Information in VB for PCB Layout and Schematic Capture by Bill Smock from Tru Designs, San Diego, CA.
Friday, July 22, 2011
Thursday, July 14, 2011
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
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
Labels:
Hit Test,
Net Labels,
Schematic,
Text
Tuesday, July 05, 2011
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
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
Subscribe to:
Posts (Atom)