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

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