; ** 24-Mar-09 NEHolt
; -------   P A N E L _ C R O S S R E F . L S P  --------
(defun c:panel_crossref ( / ss active_dwg_INST active_dwg_LOC x tag loc inst 
            slen ix ben hit cross_ref_str rec ref str query_data sheet
            termno scratch_fnam panel_xref_attrib_name)
  ; PURPOSE: push schematic parent cross-reference info on to panel footprint
  ;          symbols if target cross-reference attribute is present.
  
  ; Set the target attribute name for this special cross-referencing
  (setq panel_xref_attrib_name "XREF") 
  
  ; Get active project's "scratch database" file name
  (if (setq scratch_fnam (c:wd_mdb_get_proj_scratch_dbnam nil)) 
    (progn ; Now have active project's scratch database filename

      ; Read the active drawing's "WD_M" block values. This will carry
      ; the active drawing's default INST and LOC assignments which
      ; may be needed later.            
      (if (not GBL_wd_m) (wd_cfg_read_dwg_params))
      (setq active_dwg_INST (nth 52 GBL_wd_m))
      (setq active_dwg_LOC (nth 53 GBL_wd_m))      
            
      ; Now prompt user to select footprint and panel terminal symbols
      ; to process.
      (princ "\nSelect footprint and/or panel terminals to process:")
      (setq ss (ssget '((0 . "INSERT")))) ; gather up selected INSERTs
      (if (/= ss nil)
        (progn ; some INSERT instances selected, okay to proceed
            
          ; Begin to process the picked block INSERT instances on active
          ; drawing.
          (setq slen (sslength ss)) ; number of entities picked
          (setq ix 0) ; will be used to index through them
          (while (< ix slen)
            (setq ben (ssname ss ix)) ; get next entity to process
            (setq ix (1+ ix)) ; increment index for next time
            ; Determine what this block insert is
            (setq x (c:wd_is_it_pnl ben))
            (cond
              ((= x "FP") ; panel footprint
                (setq tag (c:wd_get_pnlval ben "P_TAG*"))
                (setq loc (c:wd_get_pnlval ben "LOC"))
                (setq inst (c:wd_get_pnlval ben "INST"))
                
                
                ; if LOC or INST blank, substitute in the drawing-wide
                ; default assignment.                
                (if (= loc "")(setq loc active_dwg_LOC))
                (if (= inst "")(setq inst active_dwg_INST))
                
                ; Call internal "surfer" query function                
                (setq query_data (wd_surfa_getcmprefs (list tag inst loc) nil nil))
                ; Sort through returned data. Look for schematic parent 
                (setq hit nil)
                (foreach rec (car query_data)
                  (if (not hit)
                    (progn
                      ; Format of rec will be: (list type par1chld2 nonc ref sheet ? ? ...)
                      ; where type = "1" for schem parent
                      (if (AND (= (nth 0 rec) "1") ; schematic symbol 
                               (= (nth 1 rec) "1")) ; and it's a parent
                        (progn
                          (setq hit rec) 
                ) ) ) ) )
                (if hit
                  (progn ; Found match. Format the cross reference text
                    (setq sheet (nth 4 hit))
                    (setq ref (nth 3 hit))
                    (setq cross_ref_str (strcat sheet "/" ref))
                    ; Push cross-ref out to target attribute
                    (if (not (c:wd_modattrval ben panel_xref_attrib_name cross_ref_str nil))
                      (progn ; problem
                        (princ "\nNo ")
                        (princ panel_xref_attrib_name)
                        (princ " attribute found on panel footprint ")
                        (princ tag)
                        (princ " for cross-ref ")
                        (princ cross_ref_str)
                    ) )
              ) ) )
              ((= x "FPT") ; panel terminal
                (setq tag (c:wd_get_pnlval ben "P_TAGSTRIP*"))
                (setq termno (c:wd_getattrval ben "WIRENO,TERM01,TERM"))
                (setq loc (c:wd_get_pnlval ben "LOC"))
                (setq inst (c:wd_get_pnlval ben "INST"))              
                ; if LOC or INST blank, substitute in the drawing-wide
                ; default assignment.                
                (if (= loc "")(setq loc active_dwg_LOC))
                (if (= inst "")(setq inst active_dwg_INST))
                ; Call internal "surfer" query function                
                (setq query_data (wd_surfa_getcmprefs (list tag inst loc) nil "2"))
                ; Sort through returned data. Look for schematic parent with same terminal
                ; number value.
                (setq hit nil)
                (foreach rec (car query_data)
                  (if (not hit)
                    (progn
                      ; Format of rec will be: (list type ? ? ref sheet ? termno ...)
                      ; where type = "T" for schem terminal
                      (if (AND (= (nth 0 rec) "T") ; schematic terminal
                               (= (nth 6 rec) termno)) ; match on schem terminal number
                        (progn
                          (setq hit rec) 
                ) ) ) ) )
                (if hit
                  (progn ; Found match. Format the cross reference text
                    (setq sheet (nth 4 hit))
                    (setq ref (nth 3 hit))
                    (setq cross_ref_str (strcat sheet "/" ref))
                    ; Push cross-ref out to target attribute
                    (if (not (c:wd_modattrval ben panel_xref_attrib_name cross_ref_str nil))
                      (progn ; problem
                        (princ "\nNo ")
                        (princ panel_xref_attrib_name)
                        (princ " attribute found on panel terminal ")
                        (princ termno)
                        (princ " for cross-ref ")
                        (princ cross_ref_str)
                    ) )
              ) ) )
          ) )
          (setq ss nil) ; release the selection set
      ) )    
  ) )
  (princ)
)