; ** 30-Mar-07 NEHolt created ; ---------- C A T 4 _ C O M B O . L S P ---------------- ; PURPOSE: pick on existing relay coil. Display part numbers that include enough contacts to ; handle all of the related child contacts. (defun xref_get_data ( tag inst loc hdl / ii xxx parentlst sheetlst active_dwg_dwgix reftxt active_dwg_inst active_dwg_loc hit child_dwgix pins_lst child_inst child_loc child_lref childlst childrec comppins_lst comppins_rec hdl ix parent_ben parent_inst parent_loc parentrec scratch_fnam rtrn rec x child_sheet active_dwg_sheet 4codes_lst combos fail contact_type found_match ixn output_child_data output_parent_data pinlist_lst options parent_pins_lst parent_wirenums_lst parent_termdesc_lst parent_termcode_lst parent_xterm_lst parentpins_lst parent_pinlist_data parent_pinlist_value qlst rec2 termcode_lst termdesc_lst wcon_lst wqlst wirenums_lst xterm_lst) (setq rtrn nil) (if (setq scratch_fnam (c:wd_mdb_get_proj_scratch_dbnam nil)) ; "nil"=get current proj mdb file name (progn ; have active project's scratch database filename ; First do a query on the FILETIME table to get a list of drawing SHEET assignments (setq sheetlst (wd_oledb_select scratch_fnam (strcat "SELECT DWGIX,SH,SHDWGNAM FROM [FILETIME]" " WHERE DWGIX <> ''"))) (if (not GBL_wd_prj_ixlst)(wd_mdb2_upd_prj_ixlst)) (if (not GBL_wd_m) (wd_cfg_read_dwg_params)) (if GBL_wd_prj_ixlst (progn ; good list of project data, process it ; (nth 0 GBL_wd_prj_ixlst) = DWGIX key field values ; (nth 1 GBL_wd_prj_ixlst) = list of drawing file sequence in the ; drawing list portion of the project's ".wdp" file ; (nth 2 GBL_wd_prj_ixlst) = list of full drawing name and paths ; (nth 3 GBL_wd_prj_ixlst) = list of SHEET values (the %S value) ; (nth 4 GBL_wd_prj_ixlst) = list of DWGNAM values (the %D value) ; (nth 5 GBL_wd_prj_ixlst) = list of IEC Proj values (the %P value) ; (nth 6 GBL_wd_prj_ixlst) = list of IEC Installation values (the %I value) ; (nth 7 GBL_wd_prj_ixlst) = list of IEC Location values (the %L value) ; (nth 8 GBL_wd_prj_ixlst) = list of inter-dwg cross-ref format strings ; (nth 9 GBL_wd_prj_ixlst) = list of "Section" assignments (the %A value) ; (nth 10 GBL_wd_prj_ixlst) = list of "Sub-section" assignments (the %B value) ; (nth 11 GBL_wd_prj_ixlst) = list of default panel "level/routing" assignments ; (nth 12 GBL_wd_prj_ixlst) = list of panel X-offset assignments for each drawing ; (nth 13 GBL_wd_prj_ixlst) = list of panel Y-offset assignments for each drawing ; (nth 14 GBL_wd_prj_ixlst) = list of panel Z-offset assignments for each drawing ; (nth 15 GBL_wd_prj_ixlst) = list of description line assignments for each drawing (wd_wdp_is_active_in_proj) ; sets GBL_wd_cip (if (AND GBL_wd_cip ; global carries active dwg's position in project wdp file dwg list (> GBL_wd_cip 0)) ; active dwg is in the active project (progn (if (setq xxx (member GBL_wd_cip (cadr GBL_wd_prj_ixlst))) (progn (setq ii (- (length (cadr GBL_wd_prj_ixlst)) (length xxx))) (setq active_dwg_dwgix (nth ii (car GBL_wd_prj_ixlst))) ; map to DWGIX in scratch database (setq active_dwg_inst (nth ii (nth 6 GBL_wd_prj_ixlst))) (setq active_dwg_loc (nth ii (nth 7 GBL_wd_prj_ixlst))) (setq active_dwg_sheet (nth ii (nth 3 GBL_wd_prj_ixlst))) ) ) ; Get all schematic child components for whole project. Do a ; query of the COMP table in the project scratch database. (setq childlst (wd_oledb_select scratch_fnam (strcat "SELECT DWGIX,TAGNAME,INST,LOC,HDL,REF,CONTACT,XREFFLAG,COILPINS,BLOCK FROM [COMP]" " WHERE PAR1_CHLD2='2'" ) ) ) ) ) ) ) ) ) ; Now process the picked parent (setq parentlst (list (list nil tag inst loc hdl))) ; fake in single entry for picked parent (foreach parentrec parentlst (setq output_parent_data nil) (setq output_child_data nil) (setq hdl (nth 4 parentrec)) (setq parent_ben (handent hdl)) ; convert to entity name of the parent block insert (if GBL_wd_combined_tagloc ; IEC-tag mode is "ON" (progn ; figure out INST/LOC of this parent (setq parent_inst (nth 2 parentrec)) (setq parent_loc (nth 3 parentrec)) (if (= parent_inst "")(setq parent_inst active_dwg_inst)) (if (= parent_loc "")(setq parent_loc active_dwg_loc)) ) ) ; First check this parent to see if it carried a PINLIST value. This will be stored ; in the PINLIST table of the project's scratch database. (setq parent_pinlist_data nil) ; Now find all child contacts for this parent (foreach childrec childlst (setq child_dwgix (car childrec)) (setq hit nil) (setq child_sheet "") (if (= (cadr childrec) (cadr parentrec)) ; match on tag-ID (progn (setq ii nil) ; Figure out child drawing's index into GBL_wd_prj_ixlst global list (if (setq xxx (member child_dwgix (car GBL_wd_prj_ixlst))) (progn (setq ii (- (length (car GBL_wd_prj_ixlst)) (length xxx))) (setq child_sheet (nth ii (nth 3 GBL_wd_prj_ixlst))) ; %S value ) ) (cond ((not GBL_wd_combined_tagloc) ; non-IEC mode, don't check INST/LOC (setq hit T) ; flag that this child is a match with the parent ) (T ; IEC mode active. Need to do compare on LOC and INST as well as the tag-ID ; Figure out child INST/LOC values from dwg-wide defaults if no value found ; in database (i.e. attrib blank on the child symbol) (setq child_inst (nth 2 childrec)) (if (= child_inst "") (progn ; get dwg-wide IEC_INST value on dwg that this child is on (if ii(setq xxx (member child_dwgix (car GBL_wd_prj_ixlst))) (progn (setq ii (- (length (car GBL_wd_prj_ixlst)) (length xxx))) (setq child_inst (nth ii (nth 6 GBL_wd_prj_ixlst))) ) ) ) ) (if (= child_inst parent_inst) (progn ; match on INST, okay to keep going. Check for LOC match. (setq child_loc (nth 3 childrec)) (if (= child_loc "") (progn ; get dwg-wide IEC_LOC value on dwg that this child is on (setq child_dwgix (car childrec)) (if (setq xxx (member child_dwgix (car GBL_wd_prj_ixlst))) (progn (setq ii (- (length (car GBL_wd_prj_ixlst)) (length xxx))) (setq child_loc (nth ii (nth 7 GBL_wd_prj_ixlst))) ) ) ) ) (if (= child_loc parent_loc) (setq hit T)) ; flag that this child is tied to ; parent being processed. ) ) ) ) ) ) (if hit (progn ; childrec = child contact tied to parentrec parent. Query COMPPINS table ; to now get the child's terminal "pin" number assignments. (setq comppins_lst (wd_oledb_select scratch_fnam (strcat "SELECT TERM,TERMCODE,TERMDESC,WIRENO,XTERMHDL FROM [COMPPINS]" " WHERE DWGIX='" child_dwgix "'" " AND HDL='" (nth 4 childrec) "'" " ORDER BY TERM"))) (setq pins_lst nil) (setq wirenums_lst nil) (setq termdesc_lst nil) (setq termcode_lst nil) (setq xterm_lst nil) (foreach comppins_rec comppins_lst (setq pins_lst (cons (car comppins_rec) pins_lst)) (setq termcode_lst (cons (nth 1 comppins_rec) termcode_lst)) (setq termdesc_lst (cons (nth 2 comppins_rec) termdesc_lst)) (setq xterm_lst (cons (nth 4 comppins_rec) xterm_lst)) ; Find wires that connect to this X?TERMxx attribute (setq wcon_lst nil) (setq qlst (wd_oledb_select scratch_fnam (strcat "SELECT HDL FROM [WIRENET]" " WHERE DWGIX='" child_dwgix "'" " AND XTERMHDL='" (nth 4 comppins_rec) "'"))) (foreach rec2 qlst (setq wqlst (wd_oledb_select scratch_fnam (strcat "SELECT WIRENO,DWGIX,WIRENOHDL FROM [WIRESEG]" " WHERE DWGIX='" child_dwgix "'" " AND HDL='" (car rec2) "'"))) (setq wcon_lst (cons (reverse (cons (car rec2)(reverse (car wqlst)))) wcon_lst)) ) (setq wirenums_lst (cons wcon_lst wirenums_lst)) ) ; Put back into original order (ordered by the "xx" termcode of TERMxx (setq pins_lst (reverse pins_lst)) (setq wirenums_lst (reverse wirenums_lst)) (setq termdesc_lst (reverse termdesc_lst)) (setq termcode_lst (reverse termcode_lst)) (setq xterm_lst (reverse xterm_lst)) (setq found_match nil) (setq contact_type nil) (if (/= parent_pinlist_data nil) (progn ; child's parent has PINLIST assignment, look for child in the PINLIST list ; "parent_pinlist_data" = ; (nth 0 parent_pinlist_data) = N.O (A) contact pins ; (nth 1 parent_pinlist_data) = N.C (B) contact pins ; (nth 3 parent_pinlist_data) = "Type 4" pins ; (nth 4 parent_pinlist_data) = Form-C (C) contact pins ; (nth 6 parent_pinlist_data) = "Type 4*" pins (if (AND (wcmatch (nth 6 childrec) "NONC*,NCNO*") (nth 4 parent_pinlist_data) (= (length pins_lst) 3)) (progn ; contact appears to be marked as a 3pin Form-C contact ; Look for match in parent's PINLIST (foreach combos (nth 4 parent_pinlist_data) (setq fail nil) (if (not found_match) (progn (foreach x pins_lst (if (not (member x (cdr combos)))(setq fail T)) ) (if (not fail) (progn (setq contact_type "C") (setq found_match T) ) ) ) ) ) ) ) (if (AND (not contact_type)(wcmatch (nth 6 childrec) "NO*") (= (length pins_lst) 2)) (progn ; check for pin match in N.O. list of parent PINLIST data (setq fail nil) (foreach x pins_lst (if (not (member x (cdr (nth 0 parent_pinlist_data)))) (setq fail T)) ) (if (not fail) (progn ; found match for this child contact in parent PINLIST N.O. list (setq contact_type "1") (setq found_match T) ) ; ELSE (progn ; failed to find match in "N.O." list. Try Form-C list. (foreach rec (nth 4 parent_pinlist_data) (if (not contact_type) (if (OR (AND (= (nth 0 pins_lst) (nth 1 rec)) ; common pin (= (nth 1 pins_lst) (nth 2 rec))) ; N.O. pin (AND (= (nth 0 pins_lst) (nth 2 rec)) ; N.O. pin (= (nth 1 pins_lst) (nth 1 rec)))) ; common pin (progn ; found match on 1/2 of Form-C (setq contact_type "3A") (setq found_match T) ) ) ) ) ) ) ) ) (if (AND (not contact_type)(wcmatch (nth 6 childrec) "NC*") (= (length pins_lst) 2)) (progn ; check for pin match in N.C. list of parent PINLIST data (setq fail nil) (foreach x pins_lst (if (not (member x (cdr (nth 1 parent_pinlist_data)))) (setq fail T)) ) (if (not fail) (progn ; found match for this child contact in parent PINLIST N.O. list (setq contact_type "2") (setq found_match T) ) ; ELSE (progn ; failed to find match in "N.O." list. Try Form-C list. (foreach rec (nth 4 parent_pinlist_data) (if (not contact_type) (if (OR (AND (= (nth 0 pins_lst) (nth 1 rec)) ; common pin (= (nth 1 pins_lst) (nth 3 rec))) ; N.C. pin (AND (= (nth 0 pins_lst) (nth 3 rec)) ; N.C. pin (= (nth 1 pins_lst) (nth 1 rec)))) ; common pin (progn ; found match on 1/2 of Form-C (setq contact_type "3B") (setq found_match T) ) ) ) ) ) ) ) ) (if (AND (not contact_type) (nth 6 parent_pinlist_data)) (progn ; still no match. Check special "4*" PINLIST_TYPE entries (setq combos (car (nth 6 parent_pinlist_data))) (setq 4codes_lst (cadr (nth 6 parent_pinlist_data))) (setq ixn 0) (foreach rec combos (if (not contact_type) (if (OR (AND (= (car pins_lst) (cadr rec)) (= (cadr pins_lst) (caddr rec))) (AND (= (cadr pins_lst) (caddr rec)) (= (car pins_lst) (cadr rec)))) (progn ; found match on this "4*" PINLIST entry carried by parent (setq contact_type (substr (nth ixn 4codes_lst) 2)) ; strip off the "4" (setq found_match T) ) ) ) (setq ixn (1+ ixn)) ; increment the index counter ) ) ) ) ) (if (not found_match) (progn ; no parent PINLIST or no match found above. ; Just output based on child's CONTACT attrib value code ; "childrec" = (list DWGIX,TAGNAME,INST,LOC,HDL,REF,CONTACT,XREFFLAG) (cond ((wcmatch (nth 6 childrec) "NONC*")(setq contact_type "3")) ((wcmatch (nth 6 childrec) "NCNO*")(setq contact_type "3")) ((wcmatch (nth 6 childrec) "NO*")(setq contact_type "1")) ((wcmatch (nth 6 childrec) "NC*")(setq contact_type "2")) (T (setq contact_type "-")) ; unknown ?? ) ) ) (if contact_type (progn ; something found, output it. (setq output_child_data (cons (list contact_type (nth 6 childrec) ; CONTACT attrib (if present) pins_lst ; pin numbers termcode_lst xterm_lst ; hdls of the X?TERMxx attributes termdesc_lst ; TERMDESCxx attribute values wirenums_lst ; wire numbers (nth 5 childrec) ; Xref child_sheet ; SHEET attribute value (car childrec) ; DWGIX (nth 2 childrec) ; INST (nth 3 childrec) ; LOC (nth 4 childrec) ; handle (nth 9 childrec) ; Symbol block name ) output_child_data)) ) ) ) ) ) ; Output the parent's pin data (if parent_pins_lst (progn (setq output_parent_data (cons (list "p" ; flag "parent" (nth 6 parentrec) ; CONTACT attrib (if present) parent_pins_lst ; parent pin numbers parent_termcode_lst ; TERMxx code list (the "xx" part) parent_xterm_lst ; X?TERMxx hdl list parent_termdesc_lst ; TERMDESCxx attribute values parent_wirenums_lst ; wire numbers (nth 5 parentrec) ; Xref active_dwg_sheet ; SHEET attribute on parent's drawing active_dwg_dwgix ; DWGIX (nth 2 parentrec) ; INST (nth 3 parentrec) ; LOC (nth 4 parentrec) ; parent's handle (nth 9 parentrec) ; Symbol block name ) output_parent_data)) ) ) ; Add this parent in to the "returned" data list (setq rtrn (cons (list parentrec output_parent_data output_child_data ) rtrn)) ) rtrn ) ; -- (defun c:cat4_combo ( / ben ed hdl x tag inst loc data child_data specific_tabnam gen_tabnam cat4_combo_getcats xstr rtn mfg pinlist plst qlst rec cnt1 cnt2 cnt3 cnt0 cnt0_avail cnt1_avail cnt2_avail cnt3_avail cat assycode data_lst dcl_id dsplst ix str wildcard_lst pinlist_str exact_catwildcard_lst exceed_catwildcard_lst) ; -- internal functions -- (defun cat4_combo_getcats ( mfg wildcard_lst / rtn cat assycode str) ; Get all records from catalog lookup database ; "CR" table that match the relay's MFG attribute ; value. (setq qlst (wd_oledb_select GBL_wd_catmdb_fnam (strcat "SELECT * FROM [" gen_tabnam "]" " WHERE MANUFACTURER = '" mfg "'"))) (setq xstr "") (setq rtn nil) ; Build up wild-card string of all PINLIST "CAT" matches ; (i.e. match on number of NO/NC/Form-C required) (foreach x wildcard_lst (if (/= xstr "")(setq xstr (strcat xstr ","))) (setq xstr (strcat xstr (caddr x))) ) (foreach rec qlst (if (wcmatch (car rec) xstr) (progn ; found another catalog part number ; record that matches the combined ; PINLIST wild-card selection. Save ; this entry for display in the ; user pick-list dialog display. (setq rtn (cons rec rtn)) ) ) ) (if (not rtn) (princ "\nNo matching catalog numbers found\n")) rtn ) ; -- main program starts here -- (if (setq x (entsel "\nSelect parent relay coil:")) (progn (setq ben (car x)) (setq ed (entget ben)) (setq hdl (cdr (assoc 5 ed))) (if (boundp 'c:ace_get_tag_attrval) ; ACE2008 and above (setq tag (car (c:ace_get_tag_attrval ben nil))) ; ELSE ; ACE2007 and earlier (setq tag (c:wd_getattrval ben "TAG1")) ) (setq inst (c:wd_getattrval ben "INST")) (setq loc (c:wd_getattrval ben "LOC")) (setq data (xref_get_data tag inst loc hdl)) (setq child_data (caddr (car data))) (setq x (wd_cat3_fig_possible_tabnams (cdr (assoc 2 ed)))) (setq specific_tabnam (nth 0 x)) ; component specific name (setq gen_tabnam (nth 1 x)) ; general family name (setq cnt1 0 cnt2 0 cnt3 0) (setq exact_catwildcard_lst nil) (setq exceed_catwildcard_lst nil) (setq mfg "SIEMENS") ; default MANUFACTURER (setq x (c:wd_getattrval ben "MFG")) (if (AND x (/= x "")) (setq mfg x)) ; use MFG from picked component (foreach x child_data (cond ((= (car x) "1")(setq cnt1 (1+ cnt1))) ((= (car x) "2")(setq cnt2 (1+ cnt2))) ((= (car x) "3")(setq cnt3 (1+ cnt3))) ) (princ "\ntype=") (princ (car x)) (princ "; CONTACT=") (princ (cadr x)) (princ "; sheet=") (princ (nth 8 x)) (princ "; ref=") (princ (nth 7 x)) ) (setq pinlist nil) (if (OR (> cnt1 0)(> cnt2 0)(> cnt3 0)) (progn ; okay to continue ; Query the _PINLIST table in catalog lookup file. ; Look for entries that have the target number of ; contacts available. (setq pinlist (wd_oledb_select GBL_wd_catmdb_fnam (strcat "SELECT * FROM [_PINLIST]"))) (if (not pinlist) ; ACE2008 and after - "_PINLIST" tables on a ; per MFG basis (ex: "_PINLIST_SIEMENS") (setq pinlist (wd_oledb_select GBL_wd_catmdb_fnam (strcat "SELECT * FROM [_PINLIST_" mfg "]"))) ) ) ) (if pinlist (progn ; Some pinlist data returned for this MFG. ; Process it. Check each entry's wildcarded ; PINLIST part value to see if it matches up ; with entries returned from the ; catalog lookup mdb file's query. Collect ; all wild-carded matches for display in ; the user pick-list dialog. (foreach rec pinlist (setq pinlist_str (nth 5 rec)) (setq plst (wd_pins_decode_pinlist pinlist_str)) ; returns ; nth 0 = NO_lst ; nth 1 = NC_lst ; nth 2 = convertible_lst ; nth 3 = type4 ; nth 4 = Form-C lst ; nth 5 = type5 ; nth 6 = lst4pluslsts (if plst (progn (setq cnt1_avail (length (nth 0 plst))) (setq cnt2_avail (length (nth 1 plst))) (setq cnt0_avail (length (nth 2 plst))) (setq cnt3_avail (length (nth 4 plst))) ; Determine if this PINLIST value exactly ; matches requirements of picked relay coil ; with its existing child contact counts. (if (OR (AND (= cnt1 cnt1_avail) ; N.O match (= cnt2 cnt2_avail) ; N.C match (= cnt3 cnt3_avail)) ; Form-C ; or check for "convertible" match ; on sum of N.O. and N.C. (AND (= (+ cnt1 cnt2) cnt0_avail) (= cnt3 cnt3_avail))) (progn ; yes, appears to be an exact match (setq exact_catwildcard_lst (cons rec exact_catwildcard_lst)) ) ; ELSE (progn ; Check if this PINLIST value ; exceeds the requirements of the ; picked relay coil. (if (OR (AND (<= cnt1 cnt1_avail) (<= cnt2 cnt2_avail) (<= cnt3 cnt3_avail)) (AND (<= (+ cnt1 cnt2) cnt0_avail) (<= cnt3 cnt3_avail))) (progn ; Yes, appears to be exceed ; the necessary requirements. (setq exceed_catwildcard_lst (cons rec exceed_catwildcard_lst)) ) ) ) ) ) ) ) ) ) (setq data_lst nil) (if exact_catwildcard_lst (progn (setq data_lst (cat4_combo_getcats mfg exact_catwildcard_lst)) ) ; ELSE (progn (if exceed_catwildcard_lst (setq data_lst (cat4_combo_getcats mfg exceed_catwildcard_lst)) ) ) ) (if data_lst (progn (setq str (strcat GBL_wd_sup "cat4_combo.dcl")) (if (setq x (findfile str)) (setq str x) ; ELSE (if (not (setq x (findfile "cat4_combo.dcl"))) (alert "Cannot find dialog support file cat4_combo.dcl") ; ELSE (setq str x) ) ) (if x (progn (setq dcl_id (load_dialog x)) (if exact_catwildcard_lst (setq x "cat4_combo_list") ; ELSE (setq x "cat4_combo_list2") ) (if (new_dialog x dcl_id) (progn (setq x (strcat tag ": N.O.=" (itoa cnt1) "; N.C.=" (itoa cnt2) "; Form-C=" (itoa cnt3))) (set_tile "msg1" x) (set_tile "msg2" (strcat "MANUFACTURER: " mfg)) (setq dsplst nil) (foreach rec data_lst (setq dsplst (cons (strcat (car rec) ";" ; catalog (caddr rec) ";" ; main desc (nth 3 rec) ";" (nth 4 rec) ";" (nth 5 rec) ";" (nth 6 rec)) dsplst)) ) (setq ix nil) (setq dsplst (reverse dsplst)) (start_list "lst") (mapcar 'add_list dsplst) (end_list) (action_tile "lst" "(setq ix (atoi $value))") (action_tile "cancel" "(setq ix nil)") (start_dialog) (unload_dialog dcl_id) (if (/= ix nil) (progn ; user picked an entry. Copy the ; entry's MFG/CAT/ASSYCODE data ; out to the parent component's ; attributes! (setq rec (nth ix data_lst)) ; Update component's MFG, CAT, ASSYCODE (c:wd_modattrval ben "CAT" (car rec) nil) (c:wd_modattrval ben "MFG" (cadr rec) nil) (c:wd_modattrval ben "ASSYCODE" (nth 7 rec) nil) ) ) ) ) ) ) ) ) ) ) (princ) )