; 23-Jul-07 NEHolt fixed a few issues causing error messages ; 16-Jul-07 NEHolt created as demo ; ------------ ; PURPOSE: map AcadE from/to report data to special terminal report template drawing (setq GBL_form_blk_name "CABLE_FORM") ; block name of the terminal/cable table on active dwg ; -- (defun c:term_cable ( / x term_dwg_write_term_column term_dwg_write_row typ ed val ix xoff data newed ben attr_template ixx data xx y yoff tse_data up_row_bottom_xy term_1 term_2 top_cable_data bot_cable_data top_cable_data_lst bot_cable_data_lst top_cable_mdb_query_lst bot_cable_mdb_query_lst cable_cat_in cable_cat_out attr_template_lst bot_cable_tag_lst top_cable_tag_lst bot_row2row cable_data_e cable_data_i cable_in_comments cable_out_comments cat cbl_dwgix cbl_hdl cbl_in_1 cbl_out_1 cbl_in_2 cbl_out_2 cbltag col2col colno comment cond_in cond_out data_lists dcl_id dclfnam dest_in dest_out dsplst ixc ixcnt ixn line_data lst lst1 max_columns mdb_query_lst newlst pair_out_lst pin_in pin_out processing qlst row2row rowno rtn_lst scratch_fnam ss start_cnt str top_row2row tagstrip_inst_loc_lst picked_tagstrip_inst_loc) ; -- internal functions -- (defun term_dwg_write_term_column (colno data col2col attr_template_lst / attr_template ed newed x xoff ix typ val) ; Calc total X offset (setq xoff (* (1- colno) col2col)) (setq ix 0) (foreach val data (if (/= val "") (progn ; non-blank value to insert, okay to continue (setq attr_template (nth ix attr_template_lst)) (setq ed (entget (caddr attr_template))) ; Flip this from ATTDEF to TEXT (setq newed nil) (foreach x ed (setq typ (car x)) (cond ((member typ (list -1 2 3 70 74 280))) ; filter these out ((= typ 0)(setq newed (cons (cons 0 "TEXT") newed))) ((= typ 1)(setq newed (cons (cons 1 val) newed))) ; text value (T (setq newed (cons x newed))) ) ) (setq newed (reverse newed)) (if (entmake newed) (progn ; reposition (command "_.MOVE" (entlast) "" "0,0" (strcat "@" (rtos xoff) ",0")) ) ) ) ) (setq ix (1+ ix)) ) ) ; -- (defun term_dwg_write_row (rowno data_lists row2row col2col attr_template_lst / attr_template ed newed x yoff ix typ val ixx data template_lst xoff) ; Calc total Y offset (setq yoff (* rowno row2row)) (setq ixx 0) (foreach data data_lists (setq template_lst (nth ixx attr_template_lst)) (setq ixx (1+ ixx)) (setq ix 0) (foreach val data (if (AND val (/= val "")) (progn ; non-blank value to insert, okay to continue (setq xoff 0.0) (setq attr_template (nth ix template_lst)) (if (not attr_template) (progn (setq attr_template (last template_lst)) (setq xoff (* col2col (- ix (length template_lst)))) ) ) (if (caddr attr_template) (progn (setq ed (entget (caddr attr_template))) ; Flip this from ATTDEF to TEXT (setq newed nil) (foreach x ed (setq typ (car x)) (cond ((member typ (list -1 2 3 70 74 280))) ; filter these out ((= typ 0)(setq newed (cons (cons 0 "TEXT") newed))) ((= typ 1)(setq newed (cons (cons 1 val) newed))) (T (setq newed (cons x newed))) ) ) (setq newed (reverse newed)) (if (entmake newed) (progn ; reposition (command "_.MOVE" (entlast) "" "0,0" (strcat "@" (rtos xoff) "," (rtos yoff))) ) ) ) ) ) ) (setq ix (1+ ix)) ) ) ) ; -- (defun do_format_line_data ( x / ) (cond ((= (nth 11 x) "E") ; "external" or output side (top) of terminal (setq line_data (list (car line_data) (cadr line_data) (car (car (nth 34 x))) ; termno (nth 18 x) ; component tag (nth 19 x))) (setq cable_data_E (list (nth 12 x) ; cbl tag (nth 13 x) ; cbl core/color (nth 16 x) ; DWGIX (nth 17 x))) ; CBL HDL ) ((= (nth 11 x) "") ; not defined I or E (if (equal cable_data_I (list "" "" "" "")) (progn (setq line_data (list (nth 18 x) (nth 19 x) (car (car (nth 34 x))) (car line_data) (cadr line_data))) (setq cable_data_I (list (nth 12 x) ; cbl tag (nth 13 x) ; cbl core/color (nth 16 x) ; DWGIX (nth 17 x))) ; CBL HDL ) ; ELSE (progn (setq line_data (list (car line_data) (cadr line_data) (car (car (nth 34 x))) ; termno (nth 18 x) ; component tag (nth 19 x))) (setq cable_data_E (list (nth 12 x) ; cbl tag (nth 13 x) ; cbl core/color (nth 16 x) ; DWGIX (nth 17 x))) ; CBL HDL ) ) ) (T (setq line_data (list (nth 18 x) (nth 19 x) (car (car (nth 34 x))) (car line_data) (cadr line_data))) ; (nth 3 line_data) ; (nth 4 line_data))) (setq cable_data_I (list (nth 12 x) ; cbl tag (nth 13 x) ; cbl core/color (nth 16 x) ; DWGIX (nth 17 x))) ; CBL HDL ) ) ) ; -- (defun term_dwg_get_cable_cat_data ( scratch_fnam cbl_dwgix cbl_hdl / qlst rtn_lst ) (setq qlst (wd_oledb_select scratch_fnam (strcat "SELECT DESC1,MFG,CAT,ASSYCODE FROM [COMP] WHERE DWGIX = '" cbl_dwgix "' AND HDL = '" cbl_hdl "'"))) ) ; -- main function begins here -- (if (not (boundp 'wd_tse_gather_data_doit))(load "wdtse")) ; temporary - make sure in memory ; Active project's scratch databsae file name (setq scratch_fnam (c:wd_mdb_get_proj_scratch_dbnam nil)) ; Read in terminal data for active project (setq tse_data (wd_tse_gather_data_doit T)) ; format of each sublist of return = ; 0 1 2 3 4 5 6 7 8 9 10 11 ; TAGSTRIP INST LOC LINKTERM SCHEM_TERM_DWGIX SCHEM_TERM_HDL LEVEL WIRENO WLAY PIN XDIR DESTGRIDMAPPING(?) ; 12 13 14 15 16 17 ; CBLTAG CBLWCLR CABLE_INST CABLE_LOC CABLE_DWGIX CABLE_HDL ; 18 19 20 21 22 23 24 25 26 ; COMPTAG COMPPIN COMP_INST COMP_LOC COMP_LREF COMP_DWGIX COMP_HDL XTERMDWGIX XTERMHDL ; 27 28 29 30 31 32 ; RECORD_CNT STRIPSEQ PNLCATEGORY PANEL_REF PANEL_DWGIX PANEL_HDL ; 33.0 33.1 ; ((list MFG CAT ASSYCODE)(list MFG01 CAT01 ASSYCODE01 CNT01 WDBLKNAM01 UM01) ... ) ; 34.0 34.1 34.2 34.3 34.4 34.5 34.6 34.7 34.8 34.9 34.10 34.11 34.12 34.13 34.14 34.15 34.16 ; ((list (TERMNO T_TERMFLAG DESC1 DESC2 DESC3 RATING1 RATING2 RATING3 RATING4 RATING5 RATING6 RATING7 RATING8 RATING9 RATING10 RATING11 RATING12 ; 34.17 34.18 34.19 34.20 34.21 34.22 ; LEVELDESCRIPTION TERM_PINL TERM_PINR SH,LREF MAXWIRES INJUMP) ...); jumper xrecords ; ((list (jumperid j_mfg j_cat j_asmb j _cnt j_item j_wdblknam in_flg term_dwgix term_hdl term_level) ...) ; actually passed this way ; Go through the list and collect INST/LOC/TERMSTRIPs represented by the data (setq tagstrip_inst_loc_lst nil) (foreach x tse_data (setq lst1 (list (car x) (cadr x) (caddr x))) ; TAGSTRIP, INST, LOC (if (not (member lst1 tagstrip_inst_loc_lst)) (setq tagstrip_inst_loc_lst (cons lst1 tagstrip_inst_loc_lst)) ) ) ; Look for key attributes on the report template (setq ben nil) (setq ss (ssget "_X" (list (cons -4 "")))) (if (/= ss nil) (progn (setq ben (ssname ss 0)) (setq ss nil) ; Get maximum number of terminal columns available on the format (setq x (car (c:ace_getattr_data ben "MAX_COLUMNS"))) (if (OR (not x) (= x "") (<= (atoi x) 0)) (progn (if (not max_columns)(setq max_columns 45)) ) ; ELSE (progn (setq max_columns (atoi x)) ) ) ) ) (if (AND ben (setq dclfnam (findfile "term_cable.dcl"))) (progn (setq dcl_id (load_dialog dclfnam)) (if (new_dialog "terminalstrip_pick" dcl_id) (progn (setq dsplst nil) (foreach x tagstrip_inst_loc_lst (setq dsplst (cons (strcat (cadr x) "\t" (caddr x) "\t" (car x)) dsplst)) ) (setq dsplst (reverse dsplst)) (start_list "lst") (mapcar 'add_list dsplst) (end_list) (setq start_cnt 1) (set_tile "start_cnt" (itoa start_cnt)) (if max_columns (set_tile "max_cnt" (itoa max_columns))) (setq ix 0) (set_tile "lst" "0") ; highlight first entry by default (action_tile "max_cnt" "(setq max_columns (atoi $value))") (action_tile "incr" "(setq start_cnt (+ start_cnt max_columns))(set_tile \"start_cnt\" (itoa start_cnt))") (action_tile "start_cnt" "(setq start_cnt (atoi $value))") (action_tile "lst" "(setq ix (atoi $value))") (action_tile "cancel" "(setq ix nil)") (start_dialog) (unload_dialog dcl_id) ) ; ELSE (progn (princ "\nDCL file nat found.\nSelect from ") (princ tagstrip_inst_loc_lst) (setq ix (getint "index=")) ) ) ) ) (if ix (progn ; terminal strip selected, okay to continue (setq picked_tagstrip_inst_loc (nth ix tagstrip_inst_loc_lst)) (setq data nil) (foreach x tse_data (if (AND (= (car picked_tagstrip_inst_loc) (car x)) (= (cadr picked_tagstrip_inst_loc) (cadr x)) (= (caddr picked_tagstrip_inst_loc) (caddr x))) (progn (setq data (cons x data)) ) ) ) ; Group the connections by terminal ; Sort data by TERMSEQ value (nth 28). If blank then sort on ; terminal numbers (car (car (nth 34...))) (setq data (c:wd_selsort data '(lambda (X Y) (if (/= (nth 28 X)(nth 28 Y)) (progn (> (atoi (nth 28 X)) (atoi (nth 28 Y))) ) ; ELSE (if (OR (= (nth 28 X) "") (not (nth 28 X))) (progn ; sort on terminal number column (nth 28...) (if (= (atoi (car (car (nth 34 X))))(atoi (car (car (nth 34 Y))))) (> (car (car (nth 34 X)))(car (car (nth 34 Y)))) ; use alpha sort ; ELSE ; use integer sort (> (atoi (car (car (nth 34 X))))(atoi (car (car (nth 34 Y))))) ) ) ) ) ) ) ) ) ) (if ben (progn ; Block instance found (command "_.UNDO" "_E") (command "_.UNDO" "_GROUP") (setvar "CMDECHO" 0) ; Now look for key attribute locations on this template ; block insert. Change the attribute names below to match up with your ; legacy block insert / attributes. Also change block name defined near ; the top of this program. (setq dest_out (c:ace_getattr_data ben "DEST_OUT")) ; upper ("out") row, bottom text (if dest_out (setq up_row_bottom_xy (cdr (assoc 10 (entget (caddr dest_out))))) ) (setq dest_in (c:ace_getattr_data ben "DEST_IN")) ; lower ("in") row, bottom text (setq pin_out (c:ace_getattr_data ben "PIN_OUT")) (setq pin_in (c:ace_getattr_data ben "PIN_IN")) (setq term_1 (c:ace_getattr_data ben "TERM_1")) (setq term_2 (c:ace_getattr_data ben "TERM_2")) (if (AND term_1 term_2) (progn ; calculate left to right column to column distance (setq col2col (distance (cdr (assoc 10 (entget (caddr term_2)))) (cdr (assoc 10 (entget (caddr term_1)))))) ) ) ; Upper horiz rows - cable number columns (setq cbl_out_1 (c:ace_getattr_data ben "CBL_OUT_1")) (setq cbl_out_2 (c:ace_getattr_data ben "CBL_OUT_2")) (if (AND cbl_out_1 cbl_out_2) (progn ; calculate upper ("out") horiz row to row dist (setq top_row2row (distance (cdr (assoc 10 (entget (caddr cbl_out_2)))) (cdr (assoc 10 (entget (caddr cbl_out_1)))))) ) ) ; Lower horiz rows - cable number columns (setq cbl_in_1 (c:ace_getattr_data ben "CBL_IN_1")) (setq cbl_in_2 (c:ace_getattr_data ben "CBL_IN_2")) (if (AND cbl_in_1 cbl_in_2) (progn ; calculate lower ("in") horiz row to row dist (setq bot_row2row (distance (cdr (assoc 10 (entget (caddr cbl_in_2)))) (cdr (assoc 10 (entget (caddr cbl_in_1)))))) ) ) (setq cable_cat_in (c:ace_getattr_data ben "CABLE_CAT_IN")) (setq cond_in (c:ace_getattr_data ben "COND_IN")) (setq cable_cat_out (c:ace_getattr_data ben "CABLE_CAT_OUT")) (setq cond_out (c:ace_getattr_data ben "COND_OUT")) (setq cable_in_comments (c:ace_getattr_data ben "CABLE_IN_COMMENTS")) (setq cable_out_comments (c:ace_getattr_data ben "CABLE_OUT_COMMENTS")) (setq ss nil) ; release the selection set ; Format terminal number and connection data for the middle part of template (setq ixn 1) (setq pair_out_lst nil) (setq processing (list (nth 4 (car data)) (nth 5 (car data)))) ; preset to DWGIX/HDL of first terminal connection (setq line_data (list "" "" "" "" "")) (setq cable_data_I (list "" "" "" "")) (setq cable_data_E (list "" "" "" "")) (foreach x data (cond ((equal processing (list (nth 4 x)(nth 5 x))) ; still working on same one (do_format_line_data x) ) (T ; hit next entry (setq pair_out_lst (cons (list line_data cable_data_I cable_data_E) pair_out_lst)) (setq processing (list (nth 4 x)(nth 5 x))) (setq line_data (list "" "" "" "" "")) (setq cable_data_I (list "" "" "" "")) (setq cable_data_E (list "" "" "" "")) (do_format_line_data x) ) ) ) (if (/= line_data (list "" "" "" "" "")) (setq pair_out_lst (cons (list line_data cable_data_I cable_data_E) pair_out_lst)) ) (setq ixcnt 1) (setq ixn 1) (setq newlst nil) (foreach x pair_out_lst (setq line_data (car x)) (if (AND (>= ixcnt start_cnt)(< ixcnt (+ start_cnt max_columns))) (progn (term_dwg_write_term_column ixn line_data col2col (list dest_in pin_in term_1 dest_out pin_out)) (setq ixn (1+ ixn)) (setq newlst (cons x newlst)) ) ) (setq ixcnt (1+ ixcnt)) ) ; New, stripped down list (if hit max count limit or have started >first terminal (setq pair_out_lst (reverse newlst)) ; Now write out the terminal TAGSTRIP, INST, LOC to the main title attribute on the template (setq str (car picked_tagstrip_inst_loc)) ; TAGSTRIP (if (/= (caddr picked_tagstrip_inst_loc) "") (progn (setq str (strcat (caddr picked_tagstrip_inst_loc) "-" str)) ; LOC ) ) (if (/= (cadr picked_tagstrip_inst_loc) "") ; INST (progn (setq str (strcat "=" (cadr picked_tagstrip_inst_loc) "+" str)) ; INST ) ) ; Put terminal TAGSTRIP value on the form (c:wd_modattrval ben "TERM_TAGSTRIP" str nil) ; Now format and write out the top cable part of the template (setq top_cable_tag_lst nil) (setq top_cable_data_lst nil) (setq top_cable_mdb_query_lst nil) (setq ixn 0) ; terminal position pointer, measured from left-hand end (foreach x pair_out_lst (setq ixn (1+ ixn)) (setq cable_data_E (caddr x)) ; (list cbltag cblcore cbldwgix cblhdl) (setq cbltag (car cable_data_E)) (if (/= cbltag "") (progn ; some cable connection to the "E" side of this terminal ; in position "ixn" (if (not (setq xx (member cbltag top_cable_tag_lst))) (progn ; new cable reference, not hit before on this side of ; terminal strip. Add it to the list. ; Look for DESC1 and CAT/MFG/ASSYCODE values for this cable marker symbol (setq qlst (term_dwg_get_cable_cat_data scratch_fnam (caddr cable_data_E) (nth 3 cable_data_E))) (setq top_cable_mdb_query_lst (cons (car qlst) top_cable_mdb_query_lst)) (setq top_cable_tag_lst (cons cbltag top_cable_tag_lst)) ; Insert terminal number into the "ixn" position (setq lst nil) (setq lst (wd_1_nth_subst ixn (cadr cable_data_E) lst)) (setq top_cable_data_lst (cons (list (caddr x) lst) top_cable_data_lst)) ) ; ELSE (progn ; another conductor reference for previous cable (setq ixc (- (length top_cable_tag_lst)(length xx))) (setq x (nth ixc top_cable_data_lst)) (setq lst (cadr x)) (setq lst (wd_1_nth_subst ixn (cadr cable_data_E) lst)) (setq top_cable_data_lst (wd_1_nth_subst ixc (list (car x) lst) top_cable_data_lst)) ) ) ) ) ) ; Write the top cable entries out to the template (setq ixn 0) (setq top_cable_tag_lst (reverse top_cable_tag_lst)) (setq top_cable_data_lst (reverse top_cable_data_lst)) (setq top_cable_mdb_query_lst (reverse top_cable_mdb_query_lst)) (foreach cbltag top_cable_tag_lst (setq top_cable_data (nth ixn top_cable_data_lst)) (setq mdb_query_lst (nth ixn top_cable_mdb_query_lst)) (setq lst (cadr top_cable_data)) ; Check if MFG/CAT is in the query list (setq cat "") (if (/= (cadr mdb_query_lst) "")(setq cat (cadr mdb_query_lst))) ; MFG (if (AND (caddr mdb_query_lst) ; ** 23-Jul-07 NEHolt (/= (caddr mdb_query_lst) "")) (progn (if (/= cat "")(setq cat (strcat cat " "))) (setq cat (strcat cat (caddr mdb_query_lst))) ) ) (if (not cat)(setq cat "")) ; ** 23-Jul-07 NEHolt (setq comment "") (if (/= (car mdb_query_lst) "")(setq comment (car mdb_query_lst))) (term_dwg_write_row ixn ; row index number, 0=first row and then work "up" from there (list (list cbltag cat) ; data list for left-hand cable info (cadr top_cable_data) ; data list for core values (list comment)) ; data list for right-hand comments info top_row2row ; vertical row-to-row spacing col2col ; horizontal spacing of terminal columns (list (list cbl_out_1 cable_cat_out) ; attribute template list for left-hand cable info (list cond_out) ; attribute template list for core values (list cable_out_comments))) ; attribute template list for right-hand comments info (setq ixn (1+ ixn)) ) ; Now format and write out the bottom cable part of the template (setq bot_cable_tag_lst nil) (setq bot_cable_data_lst nil) (setq bot_cable_mdb_query_lst nil) (setq ixn 0) ; terminal position pointer, measured from left-hand end (foreach x pair_out_lst (setq ixn (1+ ixn)) (setq cable_data_I (cadr x)) ; (list cbltag cblcore cbldwgix cblhdl) (setq cbltag (car cable_data_I)) (if (/= cbltag "") (progn ; some cable connection to the "I" side of this terminal ; in position "ixn" (if (not (setq xx (member cbltag bot_cable_tag_lst))) (progn ; new cable reference, not hit before on this side of ; terminal strip. Add it to the list. ; Look for DESC1 and CAT/MFG/ASSYCODE values for this cable marker symbol (setq qlst (term_dwg_get_cable_cat_data scratch_fnam (caddr cable_data_I) (nth 3 cable_data_I))) (setq bot_cable_mdb_query_lst (cons (car qlst) top_cable_mdb_query_lst)) (setq bot_cable_tag_lst (cons cbltag bot_cable_tag_lst)) ; Insert terminal number into the "ixn" position (setq lst nil) (setq lst (wd_1_nth_subst ixn (cadr cable_data_I) lst)) (setq bot_cable_data_lst (cons (list (caddr x) lst) bot_cable_data_lst)) ) ; ELSE (progn ; another conductor reference for previous cable (setq ixc (- (length bot_cable_tag_lst)(length xx))) (setq x (nth ixc bot_cable_data_lst)) (setq lst (cadr x)) (setq lst (wd_1_nth_subst ixn (cadr cable_data_I) lst)) (setq bot_cable_data_lst (wd_1_nth_subst ixc (list (car x) lst) bot_cable_data_lst)) ) ) ) ) ) ; Now write the bottom cable entries out to the template (setq ixn 0) (setq bot_cable_tag_lst (reverse bot_cable_tag_lst)) (setq bot_cable_data_lst (reverse bot_cable_data_lst)) (foreach cbltag bot_cable_tag_lst (setq bot_cable_data (nth ixn bot_cable_data_lst)) (setq mdb_query_lst (nth ixn bot_cable_mdb_query_lst)) (setq lst (cadr bot_cable_data)) ; Check if MFG/CAT is in the query list (setq cat "") (if (/= (cadr mdb_query_lst) "")(setq cat (cadr mdb_query_lst))) ; MFG (if (AND (caddr mdb_query_lst) ; ** 23-Jul-07 NEHolt (/= (caddr mdb_query_lst) "")) (progn (if (/= cat "")(setq cat (strcat cat " "))) (setq cat (strcat cat (caddr mdb_query_lst))) ) ) (if (not cat)(setq cat "")) (setq comment "") (if (/= (car mdb_query_lst) "")(setq comment (car mdb_query_lst))) (term_dwg_write_row ixn ; row index number, 0=first row and then work down from there (list (list cbltag cat) ; data list for left-hand cable info (cadr bot_cable_data) ; data list for core values (list comment)) ; data list for right-hand comments info (- 0.0 bot_row2row) ; vertical row-to-row spacing (make negative number) col2col ; horizontal spacing of terminal columns (list (list cbl_in_1 cable_cat_in) ; attribute template list for left-hand cable info (list cond_in) ; attribute template list for core values (list cable_in_comments))) ; attribute template list for right-hand comments info (setq ixn (1+ ixn)) ) (command "_.UNDO" "_E") ) ) (princ) )