; ** 06-Dec-2008 NEHolt created for blog posting and AU2008 API presentation ; ------------ P R O J E C T _ C A T . L S P ------------- (defun c:project_cat ( / proj_cat_mdb_fnam sav_GBL_wd_prj assylist_combos_written x xx tabnams copied_catmdbhdl unique_cat_combos fields qlst recdat new_recdat asm_fldn asmbn asmlst asmlst_fldn blk cat mfg cat_fldn mfg_fldn combo_rec data existing_tab_name_lst fieldnam found gen ix mdb_tab_2_use qlst2 rec recdat2 scratch_fnam slen specific stay_in_loop tabnam) ; -- internal functions start here -- (defun cat_qp2 (strsofar what field op val / rtrn) ; "what" can be "AND" ; "field" = field name ; "val" = val ; "op" can be "=", "LIKE", "NOT LIKE", ">", etc. (setq rtrn strsofar) (if (= val "") (progn ) ; ELSE (progn (if (/= strsofar "") (setq rtrn (strcat strsofar " " what " ")) ) (if (AND (= op "=")(> (wd_1_strchr val "*") 0)) ; the "val" value contains an "*" character. Flip "op" from "=" to "LIKE". ; This to support having an actual * char in the query field value. ; Cannot figure out how to force the query to treat the * as a regular ; character and still use the "=" operator. (setq op "LIKE ") ) (setq rtrn (strcat rtrn (wd_mdb_validate_mdb_fldnam_4_query field) " " op (wd_mdb_qp val))) ) ) rtrn ) ; -- Main program starts here -- ; STEP 1: Figure out name for this new catalog file. Use the active project's name ; with a "_cat.mdb" suffix. Save to same folder as the project's ".wdp" file. (setq proj_cat_mdb_fnam nil) (setq assylist_combos_written nil) (if (AND GBL_wd_prj (/= GBL_wd_prj "") GBL_wd_catmdb_fnam) (progn (setq x (c:wd_split_fnam GBL_wd_prj)) (setq proj_cat_mdb_fnam (wd_4_all_slashes_backward (strcat (car x) (cadr x) "_cat.mdb"))) ; Make sure that the existing catalog file name and the proposed new one are not ; the same. (if (= (strcase proj_cat_mdb_fnam)(strcase GBL_wd_catmdb_fnam)) (progn ; problem, new and old are the same name. Active project is probably already ; pointing at a project-specific catalog file. Look for original default_cat.mdb (setq sav_GBL_wd_prj GBL_wd_prj) (setq GBL_wd_prj "______") ; this will fake out the following call to find "default_cat.mdb" (wd_cat3_figure_catmdb_fnam) ; sets GBL_wd_catmdb_fnam (setq GBL_wd_prj sav_GBL_wd_prj) ; restore real project name ) ) (if (= (strcase proj_cat_mdb_fnam)(strcase GBL_wd_catmdb_fnam)) (progn (alert (strcat "existing and new catalog file names are the same\n" proj_cat_mdb_fnam)) (setq proj_cat_mdb_fnam nil) ; flag to exit ) ; ELSE (progn ; STEP 2: Now copy the existing default catalog database file into this project-specific name (princ "\nBASE= ")(princ GBL_wd_catmdb_fnam) (princ "\nNEW = ")(princ proj_cat_mdb_fnam) (princ "\nCopying base file to new project-specific catalog file name...\r") (c:wd_copy_file GBL_wd_catmdb_fnam proj_cat_mdb_fnam) (princ "\n") ) ) ; STEP 3: Now open the copied file and clear out the tables, leaving them blank (setq tabnams nil) (if (setq copied_catmdbhdl (wd_dbase_getnexthandle 1)) (progn (setq x (wd_dbase_Opendatabase copied_catmdbhdl proj_cat_mdb_fnam 1)) ; Get a list of all of the tables found in the copied catalog database file (setq tabnams (wd_dbase_GetTableNames copied_catmdbhdl)) ; Retain all of the non-catalog lookup tables dealing with pin lists and such. But for the ; other catalog lookup tables, remove all records from each table leaving the tables empty. (foreach x tabnams (if (not (wcmatch x "_*")) (progn (princ "\nCreating empty table: ") (princ x) (princ "...") (princ "\r") ; Get list of field names, type, field width for this table (setq fields (car (wd_dbase_GetFieldSpecs copied_catmdbhdl x))) ; Now delete the existing table (wd_dbase_deletedatabasetable copied_catmdbhdl x) ; Now create a fresh, empty copy of the table (setq xx (wd_dbase_createdatabasetable copied_catmdbhdl x fields 1)) (princ "\n") ) ) ) ) ) ; STEP 4: Now open up the active project's scratch database in order to query various ; tables and collect all catalog assignments (setq unique_cat_combos nil) ; Get active proj mdb file name (if (setq scratch_fnam (c:wd_mdb_get_proj_scratch_dbnam nil)) (progn ; Found the active project's scratch database filename. OK to continue. ; Process all the relavent tables in the scratch database to get all schematic ; and panel part number assignments used in the project (foreach tabnam (list "COMP" "TERMS" "PNLCOMP" "PNLTERM") (setq qlst (wd_oledb_select scratch_fnam (strcat "SELECT MFG,CAT,ASSYCODE,WDBLKNAM FROM [" tabnam "]"))) (if qlst (progn ; process returned records. Look for non-blank MFG/CAT fields (foreach rec qlst (if (/= (cadr rec) "") ; non-blank CAT (progn (if (not (member rec unique_cat_combos)) (setq unique_cat_combos (cons rec unique_cat_combos)) ) ) ) ) ) ) ) (if unique_cat_combos (progn ; some catalog assignments were ; found in active project. OK to ; continue processing. ; STEP 5: Some catalog assignments found. Determine table name to query for each catalog ; assignment. Get record from main catalog lookup file. Push this into the same ; table in the new, blank catalog lookup file. ; First get a list of existing table names ; found in the default catalog and in ; any "alternate" catalog defined for ; the active project. (setq existing_tab_name_lst nil) ; Now begin to process the catalog combos (foreach combo_rec unique_cat_combos ; Use this catalog assignment's block ; name, find the possible catalog table ; names for this name. Compare with ; table names actually in the existing ; catalog database file (and possibly ; the alternate catalog file). (setq mfg (car combo_rec)) (setq cat (cadr combo_rec)) (setq asmbn (caddr combo_rec)) (setq x (wd_cat3_fig_possible_tabnams (nth 3 combo_rec))) (setq specific (nth 0 x)) ; component specific name (setq gen (nth 1 x)) ; general family name (setq mdb_tab_2_use nil) (setq blk (nth 3 combo_rec)) (cond ((/= GBL_wd_catmdbhdl nil) ; Catalog lookup MDB file already open. (setq x (wd_4_split_fname blk)) (if (AND (cadr x) (/= (cadr x) ""))(setq blk (cadr x))) (setq mdb_tab_2_use (car (wd_cat3_figure_mdb_tab_2_use2 GBL_wd_catmdbhdl specific gen blk GBL_wd_use_misc_cat))) ) (T (if GBL_wd_catmdb_fnam ; try to open mdb file (progn (setq mdb_tab_2_use nil) (if (setq GBL_wd_catmdbhdl (wd_dbase_getnexthandle 1)) (progn (setq x (wd_dbase_Opendatabase GBL_wd_catmdbhdl GBL_wd_catmdb_fnam 1)) (if x (progn (setq x (wd_4_split_fname blk)) (if (AND (cadr x) (/= (cadr x) ""))(setq blk (cadr x))) (setq mdb_tab_2_use (car (wd_cat3_figure_mdb_tab_2_use2 GBL_wd_catmdbhdl specific gen blk GBL_wd_use_misc_cat))) ) ) ) ) ) ) ) ) ; If have figured out appropriate table in catalog lookup database, then ; go ahead and process this combo (if mdb_tab_2_use (progn ; Set up to do query (setq stay_in_loop 1) (while stay_in_loop (setq stay_in_loop nil) ; default to exit loop (setq fields (wd_dbase_GetFieldSpecs GBL_wd_catmdbhdl mdb_tab_2_use)) (if fields (progn (setq fields (car fields)) ; strip off outer list (if (nth 0 fields) (setq cat_fldn (car (nth 0 fields)))) (if (nth 1 fields) (setq mfg_fldn (car (nth 1 fields)))) (if (nth 7 fields) (setq asm_fldn (car (nth 7 fields)))) (if (nth 8 fields) (setq asmlst_fldn (car (nth 8 fields)))) (setq asmlst nil) (if (AND cat_fldn mfg_fldn asm_fldn (/= cat_fldn "") (/= mfg_fldn "") (/= asm_fldn "")) (progn ; Build cat, mfg, and assycode query (setq x "") (setq x (cat_qp2 x "AND" mfg_fldn "=" mfg)) (setq x (cat_qp2 x "AND" cat_fldn "=" cat)) (setq x (cat_qp2 x "AND" asm_fldn "=" asmbn)) (setq qlst (wd_dbase_GetAllRecords GBL_wd_catmdbhdl mdb_tab_2_use "" x "")) ) ) ) ) (setq recdat nil) (if qlst (progn ; make sure exact match (setq slen (length qlst)) (setq ix 0) (setq found 0) (while (AND (/= found 1) (< ix slen)) (setq recdat (nth ix qlst)) ; recdat will be a list of dotted pairs that might look like this: ; (("CATALOG" . "DN-T10") ("MANUFACTURER" . "AUTOMATIONDIRECT")....) (setq new_recdat nil) ; Build up the record to push into the copied catalog database (foreach x recdat ; break up dotted pair (setq fieldnam (car x)) ; the "fieldname" part (setq data (cdr x)) ; the "data" part ; Strip out RECNUM field and any fields with blank data (if (AND (/= fieldnam "RECNUM")(/= data "")) (progn ; non-blank field, add it to the overall record (setq new_recdat (cons (list fieldnam data) new_recdat)) ) ) (setq new_recdat (reverse new_recdat)) ) ; Now push this main catalog record out to the appropriate table in the ; "blank" catalog lookup database file. (wd_dbase_AddRecord copied_catmdbhdl mdb_tab_2_use (list new_recdat)) (if (AND (/= (cdr (nth 7 recdat)) "") (not (member (list mdb_tab_2_use (cdr (nth 7 recdat))) assylist_combos_written))) (progn ; Non-blank ASSYCODE value. Need to get all matching ASSYLIST records ; and push them into the new catalog lookup database file. (setq x (cat_qp2 "" "" asmlst_fldn "=" (cdr (nth 7 recdat)))) (setq qlst2 (wd_dbase_GetAllRecords GBL_wd_catmdbhdl mdb_tab_2_use "" x "")) (foreach recdat2 qlst2 (setq new_recdat nil) (foreach x recdat2 ; break up dotted pair (setq fieldnam (car x)) ; the "fieldname" part (setq data (cdr x)) ; the "data" part ; Strip out RECNUM field and any fields with blank data (if (AND (/= fieldnam "RECNUM")(/= data "")) (progn ; non-blank field, add it to the overall record (setq new_recdat (cons (list fieldnam data) new_recdat)) ) ) (setq new_recdat (reverse new_recdat)) ) ; Now push this subassy catalog record out to the appropriate table in the ; "blank" catalog lookup database file. (wd_dbase_AddRecord copied_catmdbhdl mdb_tab_2_use (list new_recdat)) ) ; Remember that this ASSYLIST combo has been written to this table ; so that won't repeat later. (setq assylist_combos_written (cons (list mdb_tab_2_use (cdr (nth 7 recdat))) assylist_combos_written)) ) ) (setq ix (1+ ix)) ) (if (/= found 1) (setq recdat nil)) ; no exact match,blnk out false hit ) ) ) ) ) ) (princ "\nFINISHED. New, project-specific catalog lookup file created:\n") (princ proj_cat_mdb_fnam) (princ "\nClose project and re-open to trigger project to access this new catalog file.") ) ) ) ) ) ) (wd_mdb_closeall) ; make sure all database files are closed and released (setq GBL_wd_catmdbhdl nil) (setq copied_catmdbhdl nil) (princ) )