; Copyright (C) 2003 by Autodesk, Inc. ; ; Permission to use, copy, modify, and distribute this software ; for any purpose and without fee is hereby granted, provided that ; the above copyright notice appears in all copies and that both ; the copyright notice and the limited warranty and restricted rights ; notice below appear in all supporting documentation. ; ; AUTODESK, INC. PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS. ; AUTODESK, INC. SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF ; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC. ; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE ; UNINTERRUPTED OR ERROR FREE. ; ; Use, duplication, or disclosure by the U.S. Government is subject to ; restrictions set forth in FAR 52.227-19 (Commercial Computer ; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii) ; (Rights in Technical Data and Computer Software), as applicable. ; ; 25-Mar-06 NEHolt; added INST filtering; CABLE filtering; Wire type filtering examples ; 10-May-04 LeeH; globalized replace of 'strcase' with 'ace_strcase' ; ** 28-Apr-04 LeeH; added support for localized 'wdw' file access messages. ; 01-Oct-03 Mauro Sist globalized ; ** 29-Sep-02 NEHolt adjusted for calling from either VIA-WD Add-on or Stand Alone. Stand ; Alone requires that only one overall routine is defined, must be called "_wd_post_main". ; Any subroutines defined in this file MUST be defined internal to this main routine. ; ** 01-Nov-01 NEHolt the layer name to gauge lookup was being thwarted ; if drawing's layer names were lower case. Fixed. ; ** 29-Jun-01 NEHolt N8 Solutions, Inc / VIA Development. Created ; as sample post-process util ; --------- W I R E F R M 2 . L S P ----------------------------- ; Post-process Wire from/to report. ; ; This routine is called from AutoCAD Electrical's "User post" button on the ; Wire From/To report dialog display. Report data is passed to this ; routine in AutoLISP variable called "wd_rdata". This utility can ; then operate on this report data, reformat it into a new list of ; report data "rtrn" and then pass it back to AutoCAD Electrical's report dialog ; through a call to (c:wd_rtrn_2wd rtrn) shown at the end of this file. ; ; -- Structure of the "wd_rdata" list of lists passed from AutoCAD Electrical: ; ; (list (list ) (list ) ... ) ; where each line data sublist consists of a list of the following: ; 0 = wire number ; 1 = LOC for "from" device ; 2 = TAG ID for "from" device ; 3 = terminal PIN number for "from" device connection ; 4 = LOC for "to" device ; 5 = TAG ID for "to" device ; 6 = terminal PIN number for "to" device connection ; 7 = WIRELAY for wire touching "from" device ; 8 = WIRELAY for wire touching "to" device ; 9 = line ref of "from" device ; 10= line ref of "to" device ; 11= SHEET number for "from" device ; 12= SHEET number for "to" device ; 13= cable marker - TAG ID (if cable marker present in wire) ; 14= cable marker - conductor color/number value ; 15= cable marker - LOC code ; 16= cable marker - MFG part number assignment ; 17= cable marker - CAT part number assignment ; 18= cable marker - ASSYCODE part number assignment ; 19= cable marker - DESC1 description value assignment ; 20= cable marker - DESC2 ; 21= cable marker - DESC3 ; 22= cable marker - 1=parent marker, 2=child marker ; 23= TAG:PIN - combined "from" device text consisting of TAG ID and PIN number ; 24= TAG:PIN - combined "to" device text consisting of TAG ID and PIN number ; 25= SEC assignment for drawing with "from" device ; 26= SUBSEC assignment for drawing with "from" device ; 27= SEC assignment for drawing with "to" device ; 28= SUBSEC assignment for drawing with "to" device ; 29= INST of "from" device ; 30= INST of "to" device ; 31= formatted IEC for "from" device ; 32= "to" device ; 33= TERMDESC value of "from" device wire connection point ; 34= TERMDESC value of "to" device wire connection point ; 35= wire connection sequence code for "from" device wire connection ; 36= wire connection sequence code for "to" device wire connection ; 37= PNLWDLEV1 ; 38= PNLWDLEV2 ; 39= HDL of "from" dev ; 40= HDL of "to" dev ; 41= DWGIX of "from" device's dwg ; 42= DWGIX of "to" ; 43= DWGNAM %D value of "from" dev dwg ; 44= DWGNAM %D value of "to" dev dwg ; 45= cable marker - handle ; 46= cable marker - INST ; 47= cable marker - DWGIX ; 48= HDL of "from" device wire LINE entity ; 49= HDL of "to" device wire LINE entity ; 50= "from" wire connection direction and termcode (ex: 4-01) ; 51= "to" wire connection direction and termcode ; 52= panel wire connection point X-coor ("from" device) ; 53= panel wire connection point Y-coor ; 54= panel wire connection point Z-coor ; 55= panel wire connection point connection direction (1, 2, 4, or 8) ; 56= panel wire connection point X-coor ("to" device) ; 57= panel wire connection point Y-coor ; 58= panel wire connection point Z-coor ; 59= panel wire connection point connection direction (1, 2, 4, or 8) ; 60= estimated wire length (defun _wd_post_main ( / rtrn dclnam dcl_id user_1 user_2 user_3 cancel xx wlay1 lay_map_lst data wd_make_dcl wd_nth_subst inst inst_lst ix inst1 inst2 lst n newlst picked picked_inst_lst slen val wlay2 x picked_wtype_lst user_4 wtype_lst param_lst) ; -- internal subroutines ; -- (defun wd_nth_subst ( n val lst / newlst ix slen x ) ; Substitute the nth member of a list "lst" with new value "val" ; If "n" is past end of existing list then blank positions "nil" padded (if (not lst) (setq slen 0) (setq slen (length lst)) ) (cond ((minusp n) ) ; rtrn orig list if pos is neg number ((zerop n) (setq lst (cons val (cdr lst)))) ; n=0, replace 1st item ((= n slen) (setq lst (append lst (list val)))) ; new last item ((< n slen) ; Insert item somewhere else in list (setq ix 0) (setq newlst '()) (foreach x lst (if (/= ix n) (setq newlst (cons x newlst)) ; reuse existing (setq newlst (cons val newlst)) ; substitute new ) (setq ix (1+ ix)) ) (setq lst (reverse newlst)) (setq newlst nil) ) ((> n slen) ; lengthen list, add "nil" pads as req'd (setq lst (reverse lst)) (while (< slen n) (setq lst (cons nil lst)) ; add pads (setq slen (1+ slen)) ) (setq lst (reverse (cons val lst))) ; tack new item on end ) ) lst ) ; -- main routine -- (setq rtrn nil) ; AutoCAD Electrical passes the report displayed data as a list of lists of lists in variable ; called wd_rdata. The first element of this list is the list of lists ; report data. The 2nd element is future (at this time). (if (AND wd_rdata (car wd_rdata) (listp (car wd_rdata))) (setq wd_rdata (car wd_rdata))) ; just go with first list of lists (report data) ; Create and reference a ".dcl" file, on-the-fly ; (setq user_1 "1") ; default to 1st user entry toggled on (setq user_1 "0") ; default toggle OFF (setq user_2 "0") (setq user_3 "0") (setq user_4 "0") ; ** 25-Mar-06 NEHolt (setq user_5 "0") ; ** 21-Oct-08 NEHolt ; Look for dcl file of same name, open if found. (setq cancel nil) ; see if running as pre-process or auto report. won't work for those below that require selection from dialog (if GBL_wd_postprocess (progn (if (listp GBL_wd_postprocess) (progn (if (> (length GBL_wd_postprocess) 1) (setq param_lst (cadr GBL_wd_postprocess)) ; optional for any selections within this function (setq param_lst nil) ) (setq GBL_wd_postprocess (car GBL_wd_postprocess)) ; should be which one to run ) ) (if (= (type GBL_wd_postprocess) 'INT) (setq GBL_wd_postprocess (itoa GBL_wd_postprocess))) (cond ((= GBL_wd_postprocess "1") (setq user_1 "1")) ((= GBL_wd_postprocess "2") (setq user_2 "1")) ((= GBL_wd_postprocess "3") (setq user_3 "1")) ((= GBL_wd_postprocess "4") (setq user_4 "1")) ((= GBL_wd_postprocess "5") (setq user_5 "1")) ; ** 21-Oct-08 NEHolt (T (setq cancel 1)) ; not a valid value ) ) ) ; Look for dcl file of same name, open if found. (if (AND (not GBL_wd_postprocess) ; otherwise bypass dialog (setq dclnam (c:ace_find_file "wirefrm2.dcl" 16))) ; 16=display error dialog if file not found (progn (setq dcl_id (load_dialog dclnam)) (if (new_dialog "main_select" dcl_id) (progn (set_tile "user1" user_1) ; set toggles per defaults above (set_tile "user2" user_2) (set_tile "user3" user_3) (set_tile "user4" user_4) ; ** 25-Mar-06 NEHolt (set_tile "user5" user_5) ; ** 21-Oct-08 NEHolt (action_tile "user1" "(setq user_1 $value)") (action_tile "user2" "(setq user_2 $value)") (action_tile "user3" "(setq user_3 $value)") (action_tile "user4" "(setq user_4 $value)") ; ** 25-Mar-06 NEHolt (action_tile "user5" "(setq user_5 $value)") ; ** 21-Oct-08 NEHolt (action_tile "cancel" "(setq cancel 1)") (start_dialog) (unload_dialog dcl_id) ) ) ) ) (if (AND wd_rdata (not cancel)) (progn ; user didn't cancel out of dialog, okay to continue (if (= user_1 "1") ; Do substitution of color/gauge labels for layer names (progn ; Read current Wire layer mapping file (".wdw" file) (setq x (c:wd_find_wdw)) ; ** 28-Apr-04.sn LeeH ;; (if (/= x nil)(princ (strcat "\n" ;; ;|wirefrm2_dcl_010|;"Reading wdw: " ;; x))) (if (/= x nil)(princ (strcat "\n" (c:wd_msg "WLAY029" nil "Reading wdw") ": " x))) ; ** 28-Apr-04.en (setq lay_map_lst (c:wd_read_wdw x)) (if (not lay_map_lst) ; ** 28-Apr-04.sn LeeH ;; (progn ; ".wdw" mapping file not found ;; (princ (strcat "\n \".WDW\" " ;; ;|wirefrm2_dcl_011|;"mapping file not found") ;; ) ) (princ (strcat "\n \".WDW\"" (c:wd_msg "WLAY030" nil "mapping file not found"))) ; ** 28-Apr-04.en ; ELSE (progn ; found it, continue processing the report data ; WIREFRM2 report data has wire layer fields as 8th and 9th elements of each ; sublist in the report data (0th element = first element in sublist) ; Now process each sublist in the report data list (i.e. each line of report data) (foreach xx wd_rdata ; ** 01-Nov-01 NEHolt ; Force layer names to upper case for the match check below (setq wlay1 (ace_strcase (nth 7 xx))) ; existing report wire layer name "WLAY1" (setq wlay2 (ace_strcase (nth 8 xx))) ; existing report wire layer name "WLAY2" ; ** ; Now look through mapping list and try to find a match on the layer name (foreach data lay_map_lst (if (= wlay1 (ace_strcase (nth 0 data))) ; ** 02-Dec-01 NEHolt ; Match found, grab new substitute text string to use (setq wlay1 (nth 1 data))) ; Check the other layer entry (if (= wlay2 (ace_strcase (nth 0 data))) ; ** 02-Dec-01 NEHolt ; Match found (setq wlay2 (nth 1 data))) ) ; Now check to see if match found for either entry. If so, substitute new ; value into the sublist (if (/= wlay1 (nth 7 xx)) (progn ; Yes, WLAY1 value needs to be updated (setq xx (wd_nth_subst 7 wlay1 xx)) ) ) (if (/= wlay2 (nth 8 xx)) (progn ; Yes, WLAY2 value needs to be updated (setq xx (wd_nth_subst 8 wlay2 xx)) ) ) ; Now added the sublist back into the new version of the list (setq rtrn (cons xx rtrn)) ) ; The new list will be reversed from original. Flip back. (setq rtrn (reverse rtrn)) (setq wd_rdata rtrn) ; fresh copy for possible further processing ) ) ) ) (if (= user_2 "1") ; filter by INST value(s) (progn ; ** 24-Mar-06 NEHolt ; Go through data and create a list of INST values (setq inst_lst nil) (foreach xx wd_rdata (setq inst1 (nth 29 xx)) (if (= inst1 "")(setq inst1 "(??)")) (if (not (member inst1 inst_lst)) ; This INST1 not in list, add it now (setq inst_lst (cons inst1 inst_lst))) (setq inst2 (nth 30 xx)) (if (= inst2 "")(setq inst2 "(??)")) (if (not (member inst2 inst_lst)) ; This INST2 not in list, add it now (setq inst_lst (cons inst2 inst_lst))) ) (if (AND inst_lst (> (length inst_lst) 1) (OR dclnam (setq dclnam (c:ace_find_file "wirefrm2.dcl" 16)))) (progn ; two or more INST values, display in a multi-select pick list dialog (setq dcl_id (load_dialog dclnam)) (if (not (new_dialog "inst_select" dcl_id)) ; Could not find definition for this INST list dialog (alert (strcat (c:wd_msg "GEN075" (list "inst_select") "%1 not found") "\n(" dclnam ")")) ; ELSE (progn ; display INST list in pick-list dialog (setq cancel nil) ; Sort the list alphabetically (setq inst_lst (acad_strlsort inst_lst)) ; Now display in pick list dialog (start_list "instlst") (mapcar 'add_list inst_lst) (end_list) ; Define action for pick list dialog (action_tile "instlst" "(setq picked $value)") ; Define action for "Cancel" button (action_tile "cancel" "(setq cancel 1)") (start_dialog) (unload_dialog dcl_id) ; Return from dialog as it is dismissed (if (AND (not cancel) picked) (progn ; user picked one or more INST codes. Index numbers returned ; in string "picked", space delimited. Break this down and ; assemble a list of the picked INST values. (setq lst (c:wd_delim_str_to_lst picked " ")) (setq picked_inst_lst nil) (foreach xx lst (setq inst (nth (atoi xx) inst_lst)) ; retrieve actual INST text value (if (= inst "(??)") (setq inst "")) ; flip the blank flag to actual blank (setq picked_inst_lst (cons inst picked_inst_lst)) ) ; Now have list of valid INST values in "picked_inst_lst". Go ; through the From/To data and filter out all entries that do NOT ; have an INST1 or INST2 that shows up in the picked INST list. (setq rtrn nil) (foreach xx wd_rdata (if (OR (member (nth 29 xx) picked_inst_lst) (member (nth 30 xx) picked_inst_lst)) (progn ; OK, this from/to entry includes one of the target INST values (setq rtrn (cons xx rtrn)) ; save it in the output list ) ) ) (setq rtrn (reverse rtrn)) ; put back into original order (setq wd_rdata rtrn) ; fresh copy for possible further processing ) ) ) ) ) ) ) ) (if (= user_3 "1") ; filter out any from/to connections that include a "Cable" reference (progn (setq rtrn nil) (foreach xx wd_rdata (if (= (nth 13 xx) "") ; blank cable tag, assume no cable (setq rtrn (cons xx rtrn)) ; save it in the output list ) ) (setq rtrn (reverse rtrn)) ; put back into original order (setq wd_rdata rtrn) ; fresh copy for possible further processing ) ) ; ** 25-Mar-06 NEHolt (if (= user_4 "1") ; filter by WIRELAYER value(s) (progn ; Go through data and create a list of WIRE LAYER values (setq wtype_lst nil) (foreach xx wd_rdata (setq wlay1 (nth 7 xx)) (if (not (member wlay1 wtype_lst)) ; This WIRELAY not in list, add it now (setq wtype_lst (cons wlay1 wtype_lst))) (setq wlay2 (nth 8 xx)) (if (not (member wlay2 wtype_lst)) ; This WIRELAY not in list, add it now (setq wtype_lst (cons wlay2 wtype_lst))) ) (if (AND wtype_lst (> (length wtype_lst) 1) (OR param_lst dclnam (setq dclnam (c:ace_find_file "wirefrm2.dcl" 16)))) (progn ; two or more WIRELAY values, display in a multi-select pick list dialog (setq picked_wtype_lst nil) (if param_lst (setq picked_wtype_lst param_lst) ; passed list of wire types in the .set file ; else (progn (setq dcl_id (load_dialog dclnam)) (if (not (new_dialog "wiretype_select" dcl_id)) ; Could not find definition for this WIRE TYPE list dialog (alert (strcat (c:wd_msg "GEN075" (list "wiretype_select") "%1 not found") "\n(" dclnam ")")) ; ELSE (progn ; display INST list in pick-list dialog (setq cancel nil) ; Sort the list alphabetically (setq wtype_lst (acad_strlsort wtype_lst)) ; Now display in pick list dialog (start_list "wtypelst") (mapcar 'add_list wtype_lst) (end_list) ; Define action for pick list dialog (action_tile "wtypelst" "(setq picked $value)") ; Define action for "Cancel" button (action_tile "cancel" "(setq cancel 1)") (start_dialog) (unload_dialog dcl_id) ; Return from dialog as it is dismissed (if (AND (not cancel) picked) (progn ; user picked one or more WIRELAY codes. Index numbers returned ; in string "picked", space delimited. Break this down and ; assemble a list of the picked WIRELAY values. (setq lst (c:wd_delim_str_to_lst picked " ")) (setq picked_wtype_lst nil) (foreach xx lst (setq wlay1 (nth (atoi xx) wtype_lst)) ; retrieve actual layer name text value (setq picked_wtype_lst (cons wlay1 picked_wtype_lst)) ) ) ) ) ) ) ) (if (AND picked_wtype_lst (listp picked_wtype_lst)) (progn ; Now have list of valid layer name values in "picked_wtype_lst". Go ; through the From/To data and filter out all entries that do NOT ; have a wire layer that shows up in the picked list. (setq rtrn nil) (foreach xx wd_rdata (if (OR (member (nth 7 xx) picked_wtype_lst) (member (nth 8 xx) picked_wtype_lst)) (progn ; OK, this from/to entry includes one of the target layer name values (setq rtrn (cons xx rtrn)) ; save it in the output list ) ) ) (setq rtrn (reverse rtrn)) ; put back into original order (setq wd_rdata rtrn) ; fresh copy for possible further processing ) ) ) ) ) ) (if (= user_5 "1") ; pull in component DESC1-3 values (progn ; "nil"=get current proj mdb file name (if (setq scratch_fnam (c:wd_mdb_get_proj_scratch_dbnam nil)) (progn ; have active project's scratch database filename. ; Now do a query on the COMP table to get a list of all ; component desc data (setq complst (wd_oledb_select scratch_fnam (strcat "SELECT HDL,DWGIX,DESC1,DESC2,DESC3 FROM [COMP]" " WHERE DWGIX <> ''"))) (setq rtrn nil) (foreach xx wd_rdata ; process CMP1. Get its handle and DWGIX value (setq hdl (nth 39 xx)) (setq dwgix (nth 41 xx)) ; Now search for this component in the query data ; from the scratch database (setq hit nil) (foreach x complst (if (AND (= hdl (car x))(= dwgix (cadr x))) (setq hit x) ) ) (if hit (progn ; found match. Push three desc values into ; fields normally reserved for "from" ; component's panel XYZ coordinates ; PNLX1, PNLY1, and PNLZ1 (setq xx (wd_nth_subst 52 (nth 2 hit) xx)) ; DESC1 (setq xx (wd_nth_subst 53 (nth 3 hit) xx)) ; DESC2 (setq xx (wd_nth_subst 54 (nth 4 hit) xx)) ; DESC3 (princ hit) ) ) ; process CMP2. Get its handle and DWGIX value (setq hdl (nth 40 xx)) (setq dwgix (nth 42 xx)) ; Now search for this component in the query data ; from the scratch database (setq hit nil) (foreach x complst (if (AND (= hdl (car x))(= dwgix (cadr x))) (setq hit x) ) ) (if hit (progn ; found match. Push three desc values into ; fields normally reserved for "to" ; component's panel XYZ coordinates ; PNLX2, PNLY2, and PNLZ2 (setq xx (wd_nth_subst 56 (nth 2 hit) xx)) ; DESC1 (setq xx (wd_nth_subst 57 (nth 3 hit) xx)) ; DESC2 (setq xx (wd_nth_subst 58 (nth 4 hit) xx)) ; DESC3 ) ) (setq rtrn (cons xx rtrn)) ) (setq rtrn (reverse rtrn)) (setq wd_rdata rtrn) ) ) ) ) ) ; ** 25-Mar-06 NEHolt.en ) (c:wd_rtrn_2wd rtrn) ; return post-processed list back to AutoCAD Electrical's report dialog ) ; -- the following AUTO-STARTS when this file is "loaded" from within AutoCAD Electrical (i.e. ; user hits the "User post" button on a report display dialog) (_wd_post_main) ; run the above program (princ)