Orcad中调整Value和partreference位置的宏教学提纲

1、精品文档Sub AdjustPartsPropsLocation()'MACROMENU AdLoc'MACROKEY CTRL+P'MACRODESCRIPTION Auto adjust Location of Part's display properties'SelectObject -52.32,-20.83, FALSE'SelectObject-14.22, -1.02, FALSEConst MB_OKCANCEL = 1' Define buttons.Const vbOKOnly = 0Const IDCANCEL =

2、 2Const MaxNumOfParts = 500Dim DgDef, Msg, Response, Title ' Declare variables.Title =" 注意:kurbylee"Msg = "1.该宏将自动调整原理图页面中元件的Part Refrence 和Value的位置；"& (Chr(13) & _"2.该宏将自动创建 C:test.txt 文件，如果该文件存在，其内容将被覆盖；” & (Chr(13) & _"3.该程序正常情况下首先弹出一个对话框begin,如果在

3、该begin出现之前oread弹出"& (Chr(13) &" Select filter请手动选择：parts (只选择parts,其他一概不要选)；"& (Chr(13) & _"4.如果在 begin 对话框之后还出现 select filter,请手动选择 display properties;" & (Chr(13) &"5.该宏在oread capture 10.3 及winxp下测试通过，其他情况未测试"& (Chr(13) & _"6.

4、请确保您使用的电阻电容形状和大小类似Capture库中的相应元件，并注意它们在库中的"& (Chr(13) & _"原始图形是垂直放置的，即印脚在上下位置，而不是左右位置” & (Chr(13) & _"7.本程序假设 R*,r*,L*,l*,C*,c* 与 Caputre 的 Discrete.olb 中的 R,C 外形大致相似；"& (Chr(13) &"其他字母开头的统一当作矩形行状的元件处理,其Part Refrence 和Value置上。"& (Chr(13)&

5、 _"8.为防止出错死循环，本宏中设置了页面最大元件数为500;" & (Chr(13) & _"9.请在 Option->preference->select下设置选择方式为 interselect, 并确定；"& (Chr(13) & _"10.请在 Option->schematic Page Properties->page size下选择 inch ，" & (Chr(13) & _"并确保您的原理图尺寸小于43X33" &

6、(Chr(13) & _"11.程序运行期间，请不要动键盘和鼠标，以免程序出错产生数据破坏；"& (Chr(13) & _"12.请确保您在运行该程序之前做好了备份，如有数据丢失或损坏，概不负责"& (Chr(13)Msg = Msg & (Chr(13) & "您确认要继续吗 ？"DgDef = MB_OKCANCEL' Describe dialog.Response = MsgBox(Msg, DgDef, Title)' Get user response.If

7、Response = IDCANCEL ThenMsgBox "退出程序!Exit SubElse' action.End IfDim ExitLoop As IntegerExitLoop = 0Dim partName As StringDim TxtFileName As StringTxtFileName = "c:test.txt"Dim PartLocX As StringDim PartLocY As StringDim ReturnValue As Integer'sometimes the following is ok,some

8、times is unvalid :(SendKeys "%vfaTAB 2 enter", True'popup a select filter dialo and set parts filterMsg ="如果您刚才看到了 select filter 对话框，而您没有只选择 Parts," & (Chr(13) & _"建议您立刻退岀，否则可以继续！”Response = MsgBox(Msg, DgDef,"您要继续吗？ ")' Get user response.If Respons

9、e = IDCANCEL ThenMsgBox ("退出程序！")Exit SubElse' action.End If'SendKeys "%vfaUP 12 enter",True'popup a select filter dialo and set parts filterunselectallGoToAbsolute 0#, 0#SelectBlock 0#, 0#, 43#, 33#, FalseRemoveDisplayProperty "Part Reference"RemoveDisplayP

10、roperty "Value"'Open Property Editor and then Select,copy to clipboard and close Property Editor ShowSpreadsheetSendKeys "LEFT+DOWNAc%-DOWN 5ENTER"'creat a empty text: c:test.txtOpen TxtFileName For Output As #1CloseRun NotepadPaste from clipboard aReturnValue = Shell(&qu

11、ot;notepad.EXE c:test.txt", 1)AppActivate "test.txt -记事本"SendKeys "AaAv%fs%fx", Truend save on the disk c:.ExitLoop = 0Dim FileData As StringDim PartRotation As StringDim PartRef As StringDim displayPro As StringDim K As IntegerdisplayPro =""Dim aa As StringDim nTa

12、bNameBegin As IntegerDim nTabNum As IntegerDim nPreTab As IntegerDim nEndTab As IntegernTabNum = 0Dim TmpCnt As Integer'popup a select filter dialog and set display property filterSelectAll unselectallMsg = "1:请使用鼠标点击确定按钮，不要直接使"& (Chr(13) & _" 用ENTER因为此时焦点可能不再该窗口上"&am

13、p; (Chr(13) & (Chr(13) & _"2:确定后开始调整 Part ref 和value的位置，这"& (Chr(13) & _"可能要花费较长的时间，请耐心等候"Response = MsgBox(Msg, 48," 警告")'MsgBox("开始调整Part ref 和value的位置，这可能要花费较长的时间，请耐心等候")'SendKeys "%vfaTAB 8",TrueSendKeys "%vfaUP 8 ENT

14、ER", True unselectallOpen TxtFileName For Input As #1 'Get File header informationIf (Not EOF(1) ThenLine Input #1, FileData FileData = LCase(FileData)'MsgBox(FileData)If (Not (Len(FileData) > 0) ThenMsgBox ("1:文件格式错误或文件不存在")Exit SubEnd IfnTabNameBegin = lnStr(1, FileData,

15、Chr$(9) & "name"& Chr$(9), 1)If nTabNameBegin = 0 ThenMsgBox ("2:文件格式错误或文件不存在")Exit SubEnd IfFileData = Left(FileData, nTabNameBegin - 1)TmpCnt = InStr(1, FileData, Chr$(9), 1)Do While 仃 mpCnt > 0 And TmpCnt < Len(FileData)nTabNum = nTabNum + 1TmpCnt = InStr(TmpCnt

16、+ 1, FileData, Chr$(9), 1)LoopEnd IfDo While Not EOF(1)TmpCnt = 1K = nTabNum + 1Line Input #1, FileDataDo While (K)nPreTab = InStr(TmpCnt, FileData, Chr$(9), 1)TmpCnt = nPreTab + 1'MsgBox(Str$(NTabNum)&":" & Str$(nPreTab)K = K - 1LoopnEndTab = InStr(TmpCnt, FileData, Chr$(9), 1

17、)partName = Mid(FileData, nPreTab + 1, Abs(nEndTab - nPreTab - 1)'MsgBox(Str$(nPreTab)& Str$(nEndTab) & ":" & partName )Findparts partName, FalseGetProperty "Rotation", PartRotationGetProperty "Part Reference", PartRef'The following for ResistorIf (L

18、eft$(PartRef, 1) = "R") Or (Left$(PartRef, 1) = "r") Or (Left$(PartRef, 1) = "L")Or (Left$(PartRef, 1) = "l") ThenDisplayProperty "Value", "Arial", 9, False, False, 48, 0SelectBlock 0#, 0#, 0.1,0.1, False'GetProperty "Rotation"

19、; , PartRotationIf (Left$(PartRotation, 3) = "0" Or Left$(PartRotation, 3) = "180") ThenDrag 0.12, 0.3, FalseElseDrag 0.3, 0#, FalseEnd IfSetfont "Arial", 1, False, FalseFindparts partName, FalseDisplayproperty "Part Reference", "Arial", 9, False, Fa

20、lse, 48, 0SelectBlock 0#, 0#, 0.1,0.1, False'GetProperty "Rotation" , PartRotationIf (Left$(PartRotation, 3) = "0" Or Left$(PartRotation, 3) = "180") ThenDrag 0.12, -0.1, FalseElseDrag -0.1,0#, FalseEnd IfSetfont "Arial", 1, False, False'The following

21、for CapacityElseIf (Left$(PartRef, 1) = "C") Or (Left$(PartRef, 1) = "c") ThenDisplayProperty "Value", "Arial", 9, False, False, 48, 0SelectBlock 0#, 0#, 0.1,0.1, False'GetProperty "Rotation" , PartRotationIf (Left$(PartRotation, 3) = "0&quo

22、t; Or Left$(PartRotation, 3) = "180") ThenDrag 0.12, 0.1, FalseElseDrag 0.12, 0#, FalseEnd IfSetfont "Arial", 1, False, FalseFindparts partName, FalseDisplayProperty "Part Reference", "Arial", 9, False, False, 48, 0SelectBlock 0#, 0#, 0.1,0.1, False'GetProperty "Rotation" , PartRotationIf (Left$(PartRotation, 3) = "0" Or Left$(PartRotation, 3) = "180") ThenDrag 0.12, -0.1, FalseElseDrag -0.2, 0#, FalseEnd IfSetfont "Arial", 1, False, False'The following for other