[Circuit] Orcad TCL 介紹

程式語言：Tcl
Orcad 官方文件
GitHub 範例

功能：可用 Tcl 語言控制 Orcad

執行方法

View->Toolbar->Command Window Menu

查詢指令

• 查詢
• info command *xxx*
• 印出目前動作指令
• SetOptionBool Journaling TRUE
  SetOptionBool DisplayCommands TRUE
• 記錄動作過程的指令
• Macro -> record
  Macro -> configure -> saveas

基本介紹

• Design Database Object Model
  
• 使用於電路
• Library Database Object Model
  
• 使用於 library
• Database class hierarchy
  
• 查詢指令必須連同繼承的一併查詢，才足夠完整
  例如：DboLib
  info commands DboLib_* 和 info commands DboBaseObject_*
• 基本
• 變數
• 賦值
• 名字前不用加上 $
• set x 20
• 印值
• 名字前需加上 $
• puts $x
• command 中的 subcommand
• [subcommand]
• puts [set x 20]
• 可多個，不限定個數
• 字串
• puts "xxx $abc"
  後者的 $abc 將被當作變數替換掉
• puts {xxx $abc}
  當作 raw data 直接輸出 xxx $abc
• List
• 賦值：list xxx yyy
• set ls [list "Cadence Design" Systems]
• 長度：llength $ls
• puts [llength $ls]
• 第 n 個的值：lindex $ls n
• puts [lindex $ls 0]
• 數學
• expr
• puts [expr $j-$i]
• expr abs($x)
• 可參考 expr function
• 自定函數
• proc
• proc mul {i j} {
  expr {$i*$j}
  }
• 輸入變數前不用加上 $
• if、foreach、proc 等的大括號 { 必須在同一行，不然會出錯
• Tcl 版本
• puts $tcl_version
• 呼叫的方法
• command_with_classname $object <parameters>
• DboLib_GetName $lLib $lName
• $object command_without_classname <parameters>
• $lLib GetName $lName
• 字串轉換
• set lName [DboTclHelper_sMakeCString]
• 因大部分的指令參數皆為 CString，需進行轉換
• puts [DboTclHelper_sGetConstCharPtr $lName]
• 要印出時，還得再轉換回來
• 內建的轉換函式
• DboTclHelper_sMakeLOGFONT
• DboTclHelper_sMakeBitmap
• DboTclHelper_sMakeBitMapData
• DboTclHelper_sMakeDboValue
• DboTclHelper_sMakeStdVector
• DboTclHelper_sMakeInt
• DboTclHelper_sMakeStdStr
• DboTclHelper_sMakeCPoint
• DboTclHelper_sMakeCString
• DboTclHelper_sMakeDboValueType
• DboTclHelper_sMakeCRect
• DboTclHelper_sGetCRectTopLeft
• DboTclHelper_sGetCPointX
• DboTclHelper_sGetCPointY
• DboTclHelper_sGetVectorSize
• DboTclHelper_sGetConstCharPtr
• DboTclHelper_sGetCRectBottomRight
• DboTclHelper_sGetConstCharPtrFromVector
• source {xxx.tcl}
• 執行 tcl script
• set lSelObjs [GetSelectedObjects]
• 得到選取的物件
• RegisterAction <Label> <Enabler> <Accel> <Callback> <ViewType>
• 註冊指令至右鍵 more
• <Label>
• 顯示的名字
• <Enabler>
• Enable 的條件
• <Accel>
• 快捷鍵
• <Callback>
• 執行的 function
• <ViewType>
• 指定可作用的 View，例： Schematic, PM, Empty; Value

RegisterAction "Context-Aware Rotate" "::capGUIUtils::capCARotateEnabler" "Ctrl+R" "::capGUIUtils::capCARotate" "Schematic

• 得到 Parts 的 attributes

# get the name 
set lName [DboTclHelper_sMakeCString] 
$lInst GetName $lName 
   
# get the location point 
set lLocation [$lInst GetLocation $lStatus] 
   
# get the location x 
set lStartx [DboTclHelper_sGetCPointX $lLocation] 
   
# get the location y 
set lStarty [DboTclHelper_sGetCPointY $lLocation] 
   
# get the source library name 
set lLibName [DboTclHelper_sMakeCString] 
$lInst GetSourceLibName $lLibName  
   
# get the device designator 
set lDeviceDesignator [DboTclHelper_sMakeCString] 
$lInst GetReferenceDesignator $lDeviceDesignator  
  
# get the rotation 
set lRot [$lInst GetRotation $lStatus] 
   
#get the contents lib name 
set lContentsLibName [DboTclHelper_sMakeCString] 
$lInst GetContentsLibName $lContentsLibName 
   
# get the contents view name 
set lContentsViewName [DboTclHelper_sMakeCString] 
$lInst GetContentsViewName $lContentsViewName 
   
# get the contents view type 
set lType [$lInst GetContentsViewType $lStatus] 
   
# get the primitive type 
set lPrimitiveType [$lInst GetIsPrimitiveProp $lStatus] 
   
# get the part value 
set lValue [DboTclHelper_sMakeCString] 
$lInst GetPartValue $lValue 
   
# get the reference 
set lReferenceName [DboTclHelper_sMakeCString] 
$lInst GetReference $lReferenceName 
   
# get the bounding box on the page 
set lBBox [$lInst GetOffsetBoundingBox $lStatus] 
   
# get the top-left of the bbox 
set lTopLeft [DboTclHelper_sGetCRectTopLeft $lBBox] 
   
# get the bottom-right of the bbox 
set lBottomRight [DboTclHelper_sGetCRectBottomRight $lBBox] 
   
# get the x1 
set lStartx [DboTclHelper_sGetCPointX $lTopLeft] 
   
# get the y1 
set lStarty [DboTclHelper_sGetCPointY $lTopLeft] 
   
# get the x2 
set lEndx [DboTclHelper_sGetCPointX $lBottomRight] 
   
# get the y2 
set lEndy [DboTclHelper_sGetCPointY $lBottomRight] 

• 得到 wire attributes

# get the name 
set lName [DboTclHelper_sMakeCString] 
$ lWire GetName $lName 

# get the net name 
set lNetName [DboTclHelper_sMakeCString] 
$lWire GetNetName $lNetName 

# get the start point 
set  lStart [$lWire GetStartPoint $lStatus] 
set lStartx [DboTclHelper_sGetCPointX $lStart] 
set lStarty [DboTclHelper_sGetCPointY $lStart] 

# get the end point 
set lEnd [$lWire GetEndPoint $lStatus] 
set lEndx [DboTclHelper_sGetCPointX $lEnd] 
set lEndy [DboTclHelper_sGetCPointY $lEnd] 

# get the color 
set lColor [$lWire GetColor $lStatus] 

# get the net 
set lNet [$lWire GetNet $lStatus]

• 其他範例可參考官方文件的 3.2.2~3.2.28.6

程式碼

Custom_Launch.tcl
放到右鍵執行

# 放到 C:\Cadence\SPB_16.6\tools\capture\tclscripts\capAutoLoad

package require Tcl 8.4
package require DboTclWriteBasic 16.3.0
package provide capGUIUtils 1.0

set root {D:\Sun\Work\Software\MyCode\Tcl\Orcad}

source [file join $root replaceGlobalPower.tcl]
source [file join $root AddNetsToParts.tcl]
source [file join $root showProperty.tcl]
source [file join $root controlDBC.tcl]

showProperty.tcl
顯示所有的 Property

# source {D:\Sun\Work\Software\MyCode\Tcl\Orcad\showProperty.tcl}
package require Tcl 8.4
package require DboTclWriteBasic 16.3.0

namespace eval ::capGUIUtils {
    RegisterAction "ShowProperty" "::capGUIUtils::capShowPropertyEnabler" "" "::capGUIUtils::capShowProperty" "Schematic"
}

proc ::capGUIUtils::capShowPropertyEnabler {} {
    set lEnableAdd 0
    # Get the selected objects
    set lSelObjs [GetSelectedObjects]

    # Enable only for single object selection
    if { [llength $lSelObjs] == 1 } { 
        # Enable only if a part or a hierarchical block is selected 
        set lObj [lindex $lSelObjs 0] 
        set lObjType [DboBaseObject_GetObjectType $lObj] 
        set lEnableAdd 1 
    } 
            
    return $lEnableAdd
}

proc ::capGUIUtils::capShowProperty {} {
    set lStatus [DboState]
    set lNullObj NULL
    
    set lSelObjs [GetSelectedObjects]
    set lInst [lindex $lSelObjs 0] 
    ::capGUIUtils::showUserPropsIter $lInst
    ::capGUIUtils::showDisplayProps $lInst
    ::capGUIUtils::showEffectiveProps $lInst
}

proc ::capGUIUtils::showUserPropsIter {lObject} {
    set lStatus [DboState]
    set lPropsIter [$lObject NewUserPropsIter $lStatus] 

    set lNullObj NULL 

    #get the first user property on the object 
    set lUProp [$lPropsIter NextUserProp $lStatus] 

    while {$lUProp != $lNullObj } { 

        #placeholder: do your processing on $lUProp 
        set lName [DboTclHelper_sMakeCString] 

        set lValue [DboTclHelper_sMakeCString] 

        $lUProp GetName $lName 
        $lUProp GetStringValue $lValue 
        puts "[DboTclHelper_sGetConstCharPtr $lName]: [DboTclHelper_sGetConstCharPtr $lValue]"


        #get the next user property on the object 
        set lUProp [$lPropsIter NextUserProp $lStatus] 

    } 

    delete_DboUserPropsIter $lPropsIter
}

proc ::capGUIUtils::showDisplayProps {lObject} {
    set lStatus [DboState]
    set lPropsIter [$lObject NewDisplayPropsIter $lStatus] 

    set lNullObj NULL 

    #get the first display property on the object 
    set lDProp [$lPropsIter NextProp $lStatus] 

    while {$lDProp != $lNullObj } { 

        #placeholder: do your processing on $lDProp 

        #get the name 
        set lName [DboTclHelper_sMakeCString] 
        $lDProp GetName $lName

        #get the location 
        set lLocation [$lDProp GetLocation $lStatus] 

        #get the rotation 
        set lRot [$lDProp GetRotation $lStatus] 

        #get the font 
        set lFont [DboTclHelper_sMakeLOGFONT] 
        set lStatus [$lDProp GetFont $::DboLib_DEFAULT_FONT_PROPERTY $lFont] 

        #get the color 
        set lColor [$lDProp GetColor $lStatus] 
        
        puts "lName:[DboTclHelper_sGetConstCharPtr $lName], lLocation:([DboTclHelper_sGetCPointX $lLocation], [DboTclHelper_sGetCPointY $lLocation]), lRot:$lRot, lFont:$lFont, lColor:$lColor"

        #get the next display property on the object 
        set lDProp [$lPropsIter NextProp $lStatus] 

    } 

    delete_DboDisplayPropsIter $lPropsIter 
}

proc ::capGUIUtils::showEffectiveProps {lObject} {
    set lStatus [DboState]
    set lPropsIter [$lObject NewEffectivePropsIter $lStatus] 

    set lNullObj NULL 

    #create the input/output parameters 
    set lPrpName [DboTclHelper_sMakeCString] 
    set lPrpValue [DboTclHelper_sMakeCString] 
    set lPrpType [DboTclHelper_sMakeDboValueType] 
    set lEditable [DboTclHelper_sMakeInt] 

    #get the first effective property 
    set lStatus [$lPropsIter NextEffectiveProp $lPrpName $lPrpValue $lPrpType $lEditable] 

    while {[$lStatus OK] == 1} { 

    #placeholder: do your processing for $lPrpName $lPrpValue $lPrpType $lEditable 
    puts "lPrpName:[DboTclHelper_sGetConstCharPtr $lPrpName], lPrpValue:[DboTclHelper_sGetConstCharPtr $lPrpValue], lPrpType:$lPrpType, lEditable:$lEditable"

    #get the next effective property 
    set lStatus [$lPropsIter NextEffectiveProp $lPrpName $lPrpValue $lPrpType $lEditable] 

    } 

    delete_DboEffectivePropsIter $lPropsIter
}

replaceGlobalPower.tcl
取代 Global Power 改為命名的線

# source {D:\Sun\Work\Software\MyCode\Tcl\Orcad\replaceGlobalPower.tcl}
package require Tcl 8.4
package require DboTclWriteBasic 16.3.0
# package provide capGUIUtils 1.0

namespace eval ::capGUIUtils {
    # namespace export capRemoveSelectedGlobalsEnabler
    # namespace export capRemoveSelectedGlobals
    # namespace export capRemoveAllGlobals

    RegisterAction "Remove Selected Globals" "::capGUIUtils::capRemoveSelectedGlobalsEnabler" "" "::capGUIUtils::capRemoveSelectedGlobals" "Schematic"
    RegisterAction "Remove All Globals" "return 1" "" "::capGUIUtils::capRemoveAllGlobals" "Schematic"
}

proc ::capGUIUtils::capRemoveSelectedGlobalsEnabler {} {
    set lEnableDS 0
    # Get the selected objects
    set lSelObjs [GetSelectedObjects]

    # Enable only for single object selection
    foreach lSelObj $lSelObjs {
        set lObjType [DboBaseObject_GetObjectType $lSelObj]
        puts "objType: $lObjType"
        if { $lObjType == 37} {
            return 1
        }        
    }
            
    return $lEnableDS
}

proc ::capGUIUtils::capRemoveAllGlobals {} {    
    set lStatus [DboState]
    set lNullObj NULL
    
    set lSession $::DboSession_s_pDboSession
    DboSession -this $lSession
    
    # set lDesignsIter [$lSession NewDesignsIter $lStatus]
    # get the first design
    # set lDesign [$lDesignsIter NextDesign $lStatus]
    # delete_DboSessionDesignsIter $lDesignsIter
    set lDesign [$lSession GetActiveDesign]

    set lSchematicIter [$lDesign NewViewsIter $lStatus $::IterDefs_SCHEMATICS]
    #get the first schematic view
    set lView [$lSchematicIter NextView $lStatus]
    while {$lView != $lNullObj} {
        #dynamic cast from DboView to DboSchematic
        set lSchematic [DboViewToDboSchematic $lView]
        set lSchematicName [_getName $lSchematic]
        #placeholder: do your processing on $lSchematic
        set lPagesIter [$lSchematic NewPagesIter $lStatus]
        #get the first page
        set lPage [$lPagesIter NextPage $lStatus]
        while {$lPage != $lNullObj} {
            #placeholder: do your processing on $lPage  
            set lPageName [_getName $lPage]
            OPage $lSchematicName $lPageName
            ::capGUIUtils::IterAllGlobal $lPage
            
            #get the next page
            set lPage [$lPagesIter NextPage $lStatus]
        }
        delete_DboSchematicPagesIter $lPagesIter
        
        #get the next schematic view
        set lView [$lSchematicIter NextView $lStatus]
    }
    delete_DboLibViewsIter $lSchematicIter  
}

proc ::capGUIUtils::replaceNowPageAll {} {
    if { [IsSchematicViewActive] == 1 } { 
        set lPage [GetActivePage]
        ::capGUIUtils::IterAllGlobal $lPage
    } else {
        capDisplayMessageBox "No schematic view active" "warning"
    }
}

proc ::capGUIUtils::IterAllGlobal {lPage} {
    set lStatus [DboState]
    set lNullObj NULL
    
    #placeholder: do your processing on $lPage            
    set lGlobalsIter [$lPage NewGlobalsIter $lStatus]      
    #get the first global 
    set lGlobal [$lGlobalsIter NextGlobal $lStatus] 
    while { $lGlobal != $lNullObj } { 
        #placeholder: do your processing on $lGlobal 
        ::capGUIUtils::replacePowerToNetName $lGlobal

        #get the next global 
        set lGlobal [$lGlobalsIter NextGlobal $lStatus] 
    } 
    delete_DboPageGlobalsIter $lGlobalsIter 
}
    
proc ::capGUIUtils::capRemoveSelectedGlobals {} {
    set lSelObjs [GetSelectedObjects]
    foreach lSelObj $lSelObjs {
        set lObjType [DboBaseObject_GetObjectType $lSelObj]
        # puts $lObjType
        if { $lObjType == 37} {
            ::capGUIUtils::replacePowerToNetName $lSelObj
        }
        
    }
}

proc ::capGUIUtils::replacePowerToNetName {lGlobal} {
    set ClSymbolName [DboTclHelper_sMakeCString]
    $lGlobal GetSourceSymbolName $ClSymbolName
    set lSymbolName [DboTclHelper_sGetConstCharPtr $ClSymbolName]
    puts "\nSymbolName: $lSymbolName"
            
    # 得到名字
    set lGlobalName [DboTclHelper_sMakeCString]
    $lGlobal GetName $lGlobalName
    set lWireName [DboTclHelper_sGetConstCharPtr $lGlobalName]
    puts "WireName: $lWireName"
    if { [regexp {GND} $lWireName] } {
        return
    }
    
    # 得到座標
    set lStatus [DboState]
    set lLocation [$lGlobal GetLocation $lStatus]
    set lStartX [expr [DboTclHelper_sGetCPointX $lLocation]/100.0]
    set lStartY [expr [DboTclHelper_sGetCPointY $lLocation]/100.0]
    puts "Start: $lStartX , $lStartY"
    
    # 得到端點座標
    set lHotSpotPoint [$lGlobal GetOffsetHotSpot $lStatus]
    set lHotSpotPointX [expr [DboTclHelper_sGetCPointX $lHotSpotPoint]/100.0]
    set lHotSpotPointY [expr [DboTclHelper_sGetCPointY $lHotSpotPoint]/100.0]
    puts "HotSpotPointY: $lHotSpotPointX , $lHotSpotPointY"
    
    # 得到中心座標
    set center [::capGUIUtils::_getCenter $lGlobal]
    set centerX [expr [DboTclHelper_sGetCPointX $center]/100.0]
    set centerY [expr [DboTclHelper_sGetCPointY $center]/100.0]
    puts "center: $centerX , $centerY"
    
    # 得到旋轉方向
    set rotattion [$lGlobal GetRotation $lStatus]
    
    # 命名線並畫線
    switch $rotattion {
        0 { # 上
            set wireX [expr $lHotSpotPointX]
            set wireY [expr $lHotSpotPointY]
            PlaceWire $lHotSpotPointX $lHotSpotPointY [expr $lHotSpotPointX+0.01] [expr $lHotSpotPointY+0]
        }
        1 { # 左
            set wireX [expr $lHotSpotPointX]
            set wireY [expr $lHotSpotPointY]
            PlaceWire $lHotSpotPointX $lHotSpotPointY [expr $lHotSpotPointX+0] [expr $lHotSpotPointY-0.01]
        }
        2 { # 下
            set wireX [expr $lHotSpotPointX]
            set wireY [expr $lHotSpotPointY]
            PlaceWire $lHotSpotPointX $lHotSpotPointY [expr $lHotSpotPointX+0.01] [expr $lHotSpotPointY+0]
        }
        3 { # 右
            set wireX [expr $lHotSpotPointX]
            set wireY [expr $lHotSpotPointY]
            PlaceWire $lHotSpotPointX $lHotSpotPointY [expr $lHotSpotPointX+0] [expr $lHotSpotPointY-0.01]
        }
        default {
            puts "No define $rotattion"
        }
    }
    puts "wire: $wireX , $wireY"
    
    # 刪除 Global
    UnSelectAll
    SelectObject [expr $centerX] [expr $centerY] True
    Delete
    
    PlaceNetAlias $wireX $wireY $lWireName
}

proc ::capGUIUtils::_getName {obj} {
    set lname [DboTclHelper_sMakeCString]
    $obj GetName $lname
    return [DboTclHelper_sGetConstCharPtr $lname]
}

proc ::capGUIUtils::_getCenter {obj} {
    set lStatus [DboState]
    # set lBBox [$obj GetBoundingBox]
    
    # set left [DboTclHelper_sGetCPointX [DboTclHelper_sGetCRectTopLeft  $lBBox]]
    # set top [DboTclHelper_sGetCPointY [DboTclHelper_sGetCRectTopLeft  $lBBox]]
    # set right [DboTclHelper_sGetCPointX [DboTclHelper_sGetCRectBottomRight  $lBBox]]
    # set Bottom [DboTclHelper_sGetCPointY [DboTclHelper_sGetCRectBottomRight  $lBBox]]
    
    # 得到端點座標
    set lHotSpotPoint [$obj GetOffsetHotSpot $lStatus]
    set lHotSpotPointX [DboTclHelper_sGetCPointX $lHotSpotPoint]
    set lHotSpotPointY [DboTclHelper_sGetCPointY $lHotSpotPoint]
    
    # 加入 offset
    switch [$obj GetRotation $lStatus] {
        0 { # 上
            set offsetX 0
            set offsetY -5
        }
        1 { # 左
            set offsetX -5
            set offsetY 0
        }
        2 { # 下
            set offsetX 0
            set offsetY 5
        }
        3 { # 右
            set offsetX 5
            set offsetY 0
        }
        default {
            set offsetX 0
            set offsetY 0
        }
    }
    
    set centerX [expr $lHotSpotPointX + $offsetX]
    set centerY [expr $lHotSpotPointY + $offsetY]
    
    set center [DboTclHelper_sMakeCPoint $centerX $centerY]
    return $center
}

AddNetsToParts.tcl
將 Parts 的 Pin 畫上線

# source {D:\Sun\Work\Software\MyCode\Tcl\Orcad\AddNetsToParts.tcl}
package require Tcl 8.4
package require DboTclWriteBasic 16.3.0
# package provide capGUIUtils 1.0

namespace eval ::capGUIUtils {
    # namespace export capAddNetsToPartEnabler
    # namespace export capAddNetsToPart

    RegisterAction "Add Nets To Part" "::capGUIUtils::capAddNetsToPartEnabler" "" "::capGUIUtils::capAddNetsToPart" "Schematic"
}

proc ::capGUIUtils::capAddNetsToPartEnabler {} {
    set lEnableAdd 0
    # Get the selected objects
    set lSelObjs [GetSelectedObjects]

    # Enable only for single object selection
    if { [llength $lSelObjs] == 1 } { 
        # Enable only if a part or a hierarchical block is selected 
        set lObj [lindex $lSelObjs 0] 
        set lObjType [DboBaseObject_GetObjectType $lObj] 
        puts "objType: $lObjType"
        if { $lObjType == 13} { 
            set lEnableAdd 1 
        } 
    } 
            
    return $lEnableAdd
}

proc ::capGUIUtils::capAddNetsToPart {} {    
    set lPage [GetActivePage]
    set lUnits [$lPage GetIsMetric]
    if { $lUnits } {
        capDisplayMessageBox "請將 Page Units 改為 inch" "Error"
        return
    }
    
    set lStatus [DboState]
    set lNullObj NULL
    
    set lSelObjs [GetSelectedObjects]
    set lInst [lindex $lSelObjs 0] 
    
    set lIter [$lInst NewPinsIter $lStatus] 

    #get the first pin of the part 
    set lPin [$lIter NextPin $lStatus] 

    while {$lPin != $lNullObj } { 
        #placeholder: do your processing on $lPin 
        ::capGUIUtils::capAddNetToPin $lPin

        #get the next pin of the part 
        set lPin [$lIter NextPin $lStatus] 
    } 
    delete_DboPartInstPinsIter $lIter 
}

proc ::capGUIUtils::capAddNetToPin {lPin} {    
    set lStatus [DboState]
    set lNullObj NULL
    set lWireLength 0.5
    
    # 跳過已畫線
    set lWire [$lPin GetWire $lStatus]
    puts "lWire：$lWire"
    if {$lWire != $lNullObj} {
        return
    }
    
    # 得到 Pin Name
    set lPinName [DboTclHelper_sMakeCString]
    $lPin GetPinName $lPinName
    set lPinName [DboTclHelper_sGetConstCharPtr $lPinName]
    puts "lPinName: $lPinName"
    
    # 得到起始座標
    set lStatus [DboState]
    set lStartPoint [$lPin GetOffsetStartPoint $lStatus]
    set lStartPointX [expr [DboTclHelper_sGetCPointX $lStartPoint]/100.0]
    set lStartPointY [expr [DboTclHelper_sGetCPointY $lStartPoint]/100.0]
    puts "Start: $lStartPointX , $lStartPointY"
    
    # 得到端點座標
    set lHotSpotPoint [$lPin GetOffsetHotSpot $lStatus]
    set lHotSpotPointX [expr [DboTclHelper_sGetCPointX $lHotSpotPoint]/100.0]
    set lHotSpotPointY [expr [DboTclHelper_sGetCPointY $lHotSpotPoint]/100.0]
    puts "HotSpotPointY: $lHotSpotPointX , $lHotSpotPointY"
    

    # 畫線方向
    set offsetX 0
    set offsetY 0
    if {$lHotSpotPointX > $lStartPointX} {
        set offsetX $lWireLength
    } elseif {$lHotSpotPointX < $lStartPointX} {
        set offsetX [expr -$lWireLength]
    }
    if {$lHotSpotPointY > $lStartPointY} {
        set offsetY $lWireLength
    } elseif {$lHotSpotPointY < $lStartPointY} {
        set offsetY [expr -$lWireLength]
    }    
    puts "offset: $offsetX , $offsetY"
    
    PlaceWire $lHotSpotPointX $lHotSpotPointY [expr $lHotSpotPointX+$offsetX] [expr $lHotSpotPointY+$offsetY]
    PlaceNetAlias [expr $lHotSpotPointX+$offsetX/2] [expr $lHotSpotPointY+$offsetY/2] $lPinName
    
    if {$offsetY != 0} {
        set lWire [$lPin GetWire $lStatus]
        set lAliasIter [$lWire NewAliasesIter $lStatus] 
        #get the first alias of wire  
        set lAlias [$lAliasIter NextAlias $lStatus] 
        $lAlias SetRotation 3
        delete_DboWireAliasesIter $lAliasIter
    }
}

controlDBC.tcl
控制 Database

# source {D:\Sun\Work\Software\MyCode\Tcl\Orcad\controlDBC.tcl}

# 顯示 DBC 路徑
proc showDBCName {} {
    set lCfg [OrCISGetDbcConfig]
    set lString [::CPMgtCfg_GetIniDBCName $lCfg]
    puts [DboTclHelper_sGetConstCharPtr $lString]
}

# 進資料庫選擇元件，並擺放位置
proc placePartsInDB {value x y} {
    MenuCommand "14567" 
    # "0402/0R*"
    CISAddSearchQuery VALUE = $value
    CISExecuteQuery
    CISExplorerSelectOption 1 1 0
    CISExplorerSelectOption 1 1 1
    capMoveMouseAndClick $x $y
    EndPlace()
}

#選擇指定值的零件
proc selectRefbyValue {lregValue} {
    set lSession $::DboSession_s_pDboSession
    DboSession -this $lSession

    set lStatus [DboState]
    set lNullObj NULL

    set lDesignsIter [$lSession NewDesignsIter $lStatus]
    # get the first design
    set lDesign [$lDesignsIter NextDesign $lStatus]

    while {$lDesign != $lNullObj} {
        # placeholder: do your processing on $lDesign
        set lSchematicIter [$lDesign NewViewsIter $lStatus $::IterDefs_SCHEMATICS]
        #get the first schematic view
        set lView [$lSchematicIter NextView $lStatus]
        while {$lView != $lNullObj} {
            #dynamic cast from DboView to DboSchematic
            set lSchematic [DboViewToDboSchematic $lView]
            #placeholder: do your processing on $lSchematic
            set lPagesIter [$lSchematic NewPagesIter $lStatus]
            #get the first page
            set lPage [$lPagesIter NextPage $lStatus]
            set lNullObj NULL
            while {$lPage != $lNullObj} {
                #placeholder: do your processing on $lPage
                set lPartInstsIter [$lPage NewPartInstsIter $lStatus]
                #get the first part inst
                set lInst [$lPartInstsIter NextPartInst $lStatus]
                while { $lInst != $lNullObj } {
                    set lRef [DboTclHelper_sMakeCString] 
                    $lInst GetReference $lRef
                    set lRef [DboTclHelper_sGetConstCharPtr $lRef]
                    
                    set lValue [DboTclHelper_sMakeCString] 
                    $lInst GetPartValue $lValue
                    set lValue [DboTclHelper_sGetConstCharPtr $lValue]
                    
                    puts "$lRef: $lValue"
                    if { [regexp $lregValue $lValue] } {
                        selectRefInDBC $lRef
                    }                    

                    set lInst [$lPartInstsIter NextPartInst $lStatus]
                }
                delete_DboPagePartInstsIter $lPartInstsIter
                
                #get the next page
                set lPage [$lPagesIter NextPage $lStatus]
            }
            delete_DboSchematicPagesIter $lPagesIter

            
            #get the next schematic view
            set lView [$lSchematicIter NextView $lStatus]
        }
        delete_DboLibViewsIter $lSchematicIter


        # get the next design
        set lDesign [$lDesignsIter NextDesign $lStatus]
    }
    delete_DboSessionDesignsIter $lDesignsIter
}


proc selectRefInDBC {lRef} {
    # ui::PMActivate "c:/users/chihchieh.sun/desktop/test/tt.opj"
    # Menu "Tools::Part Manager::Open"
    # set lPM [GetPartManagerView]
    SelectGroup Groups Common $lRef
}

proc linkDB {} {
    LinkDataBasePart
    CISExplorerSelectOption 1 1 0
    CISExplorerSelectOption 1 1 1
}

proc deleteSelect {} {
    MenuCommand "33014"  | MessageBox "YES" "INFO(ORCIS-6327): Are you sure"
}

參考

Tcl/Tk 教學文件
Welcome to the Tclers Wiki!