This is correct. Like i said this small snippet of code is part of a much larger file. I thought i extracted the part of the code that counts all of the block usages but there must be another part that is counting from the xrefs. Ill post the larger code. Just beware it is a lot of code. And this isnt even all of it, there are other lisp files that this code interacts with that have an influence on it as well.
;;;--------------------------------------------------------------------;
;;; Function: CP-KS Copyright © CP 2002 ;
;;; Written by ANON ;
;;;--------------------------------------------------------------------;
;;; Description: This function handles all Key Schedules tasks. ;
;;;--------------------------------------------------------------------;
(defun CP-KS (G-MODE / G-SS G_LST-SS G_LST-SYM
G_LST-SUM G_LST-SEM G_LST-FABCNT G_FILE-ID G_PATH
G-TB-DATA G-TB-NM G-TB-IPT G-TB-SCALE G-TB-VER
G-TB-PTS G_CDWG G_CSER G_CSHT G_SPEC-MAT
G_SPEC-PNT G_SPEC-HDW G_SPEC-ELC G_SPEC-ALM G_SPEC-STL
G_SPEC-REV G_CLI-NAME G_CLI-CODE G_PRG-NAME G_PRG-CODE
G_PRJ-NUM G_ELM-NAME G_ELM-CODE G_INDX G_DICT
G_ATTR-MISS G_ELM-QTY G_LST-PARTS G_SURVEYSC G_SURVEYIPT
G_TB-SCF G-TB-KS-MAXHT G_IPT-L G-TB-KS-MAXHT-REAL
G-TB-IPT-REAL G_SQUEEZE-FACTOR G_MISSING-INFO
)
;; Call the GETKEYNOTEFILES added to pull files from Vault. Calls command in AutoCADConnect.dll
(command "GETKEYNOTEFILES")
(CPF-ERR-ON)
(CPF-VSAVE (list "clayer" "osmode" "cmdecho" "attreq" "attdia" "textstyle"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "attreq" 1)
(setvar "attdia" 0)
(prompt "\n *** Processing Kenoting Schedules... \n")
(if (and (= (getvar "dwgtitled") 1)
(setq G_LST-SS (CPKS-GET-SHEETS))
(setq G_PATH (CPF-PROJECT-PATH))
(setq G_FILE-ID (CPF-FILE-ID NIL))
)
(progn
;; collect information ;
;; Expanded scan to include additional versions of keynote blocks (DF 03-24-20)
(if (setq G-SS (ssget "_x"
(list
'(0 . "INSERT")
'(-4 . "<or")
'(2 . "pntmast*,pnttitl*")
'(2 . "matmast*,mattitl*")
'(2 . "hdwmast*,hdwtitl*")
'(2 . "elecmast*,electitl*")
'(2 . "mtlmast*,mtltitl*")
'(2 . "fabmast*,fabtitl*")
'(2 . "revmast*,revtitl*")
'(2 . "CP_kspnt-t*,CP_kspnt-m*,CP_kspnt-mx*")
'(2 . "CP_ksmat-t*,CP_ksmat-m*,CP_ksmat-mx*")
'(2 . "CP_kshdw-t*,CP_kshdw-m*,CP_kshdw-mx*")
'(2 . "CP_kselc-t*,CP_kselc-m*,CP_kselc-mx*")
'(2 . "CP_ksmet-t*,CP_ksmet-m*,CP_ksmet-mx*")
'(2 . "CP_ksfab-t*,CP_ksfab-m*,CP_ksfab-mx*")
'(2 . "CP_ksftl-t*,CP_ksftl-m*,CP_ksmiss*")
'(2 . "CP_ksrev-t*,CP_ksrev-m*,CP_ksrev-mx*")
'(2 . "CP_ksrev-t2*")
'(2 . "CP_ksrt*")
'(-4 . "or>")
)
)
)
(progn
(if (member (car G_FILE-ID) '("FAB" "DTL"))
(CPKS-SURVEY)
)
(vl-cmdf ".erase" G-SS "")
(vl-cmdf
"-purge"
"_b"
"pntmast*,pnttitl*,matmast*,mattitl*,hdwmast*,hdwtitl*,elecmast*,electitl*,mtlmast*,mtltitl*,fabmast*,fabtitl*,revmast*,revtitl*,CP_kspnt-t*,CP_kspnt-m*,CP_kspnt-mx*,CP_ksmat-t*,CP_ksmat-m*,CP_ksmat-mx*,CP_kshdw-t*,CP_kshdw-m*,CP_kshdw-mx*,CP_kselc-t*,CP_kselc-m*,CP_kselc-mx*,CP_ksmet-t*,CP_ksmet-m*,CP_ksmet-mx*,CP_ksfab-t*,CP_ksfab-m*,CP_ksfab-mx*,CP_ksftl-t*,CP_ksftl-m*,CP_ksmiss*,CP_ksrev-t*,CP_ksrev-m*,CP_ksrev-mx*,CP_ksrev-t2*,CP_ksrt*"
"_n"
)
(if
(not (ssget "x"
(list '(0 . "INSERT") (cons 410 (getvar "ctab")) '(2 . "CP_kslock-ec*"))
)
)
(progn (setq G-SS (ssget "_x"
(list '(0 . "INSERT")
'(-4 . "<or")
'(2 . "CP_ksstn-t*,CP_ksstn-m*,CP_ksstn-b*")
'(-4 . "or>")
)
)
)
(vl-cmdf ".erase" G-SS "")
(vl-cmdf "-purge" "_b" "CP_ksstn-t*,CP_ksstn-m*,CP_ksstn-b*" "_n")
)
)
)
)
(if (member (setq G_CDWG (nth 0 G_FILE-ID)) '("SHT" "DTL" "FAB"))
(progn (if (nth 2 G_FILE-ID)
(setq G_CSER (vl-string-left-trim "0" (nth 2 G_FILE-ID)))
)
(if (nth 3 G_FILE-ID)
(setq G_CSHT (vl-string-left-trim "0" (nth 3 G_FILE-ID)))
)
(setq G_DICT (CPF-DICT "CP" NIL))
(if (not (setq G_CLI-NAME (cdr (assoc "DB_CLIENT_NAME" G_DICT))))
(if (not (setq G_CLI-NAME (nth 0 G_PATH)))
(setq G_CLI-NAME "Unknown")
)
)
(if (not (setq G_CLI-CODE (cdr (assoc "DB_CLIENT_CODE" G_DICT))))
(setq G_CLI-CODE "")
(setq G_CLI-CODE (strcat G_CLI-CODE " - "))
)
(if (not (setq G_PRG-NAME (cdr (assoc "DB_PROGRAM_NAME" G_DICT))))
(if (not (setq G_PRG-NAME (nth 1 G_PATH)))
(setq G_PRG-NAME "Unknown")
)
)
(if (not (setq G_PRG-CODE (cdr (assoc "DB_PROGRAM_CODE" G_DICT))))
(setq G_PRG-CODE "")
(setq G_PRG-CODE (strcat G_PRG-CODE " - "))
)
(if (not (setq G_PRJ-NUM (cdr (assoc "DB_PROJECT_NO" G_DICT))))
(setq G_PRJ-NUM (cdr (assoc "DB_PROJECT_CODE" G_DICT)))
)
(if (not (setq G_ELM-NAME (cdr (assoc "DB_ELEMENT_NAME" G_DICT))))
(setq G_ELM-NAME "****")
)
(setq G_ELM-CODE (cdr (assoc "DB_ELEMENT_CODE" G_DICT)))
(setq G_ELM-QTY (cdr (assoc "DB_QTY" G_DICT)))
)
(setq G_CDWG NIL)
)
(setq G_INDX 10
G_LST-SEM (CPKS-GET-SEM)
G_LST-SYM (CPKS-GET-SYMBOLS)
G_LST-SUM (CPKS-GET-SUMMARY)
)
;; create summary file ("Project_number.sum"), if applicable;
(CPKS-DO-SUMMARY)
;; insert keynotes revisions and stenciling shedules;
(CPKS-DO-INSERTS)
(if G_MISSING-INFO
(progn (if (setq G-SS (ssget "_x"
(list
'(0 . "INSERT")
'(-4 . "<or")
'(2 . "pntmast*,pnttitl*")
'(2 . "matmast*,mattitl*")
'(2 . "hdwmast*,hdwtitl*")
'(2 . "elecmast*,electitl*")
'(2 . "mtlmast*,mtltitl*")
'(2 . "fabmast*,fabtitl*")
'(2 . "revmast*,revtitl*")
'(2 . "CP_kspnt-t*,CP_kspnt-m*,CP_kspnt-mx*")
'(2 . "CP_ksmat-t*,CP_ksmat-m*,CP_ksmat-mx*")
'(2 . "CP_kshdw-t*,CP_kshdw-m*,CP_kshdw-mx*")
'(2 . "CP_kselc-t*,CP_kselc-m*,CP_kselc-mx*")
'(2 . "CP_ksmet-t*,CP_ksmet-m*,CP_ksmet-mx*")
'(2 . "CP_ksfab-t*,CP_ksfab-m*,CP_ksfab-mx*")
'(2 . "CP_ksftl-t*,CP_ksftl-m*,CP_ksmiss*")
'(2 . "CP_ksrev-t*,CP_ksrev-m*,CP_ksrev-mx*")
'(2 . "CP_ksrev-t2*")
'(2 . "CP_ksrt*")
'(-4 . "or>")
)
)
)
(vl-cmdf ".erase" G-SS "")
)
(CPKS-DO-INSERTS)
)
)
)
(cond ((= (getvar "dwgtitled") 0)
(setq G-LST-MSG (append G-LST-MSG
(list " **** CANNOT USE \"KS\" IN UNNAMED DRAWING! ****")
)
)
)
((not G_LST-SS)
(setq
G-LST-MSG (append G-LST-MSG
(list " **** UNABLE TO FIND ANY SHEETS IN CURRENT FOLDER! ****")
)
)
)
((not G_FILE-ID)
(setq G-LST-MSG (append G-LST-MSG
(list " ***** UNABLE TO DETERMINE THE TYPE OF DRAWING! ****")
)
)
)
((not G_PATH)
(setq G-LST-MSG (append G-LST-MSG
(list " **** UNABLE TO FIND SPECIFICATION LIST FILES! ****")
)
)
)
(t
(setq G-LST-MSG
(append G-LST-MSG (list " **** UNKNOWN ERROR - UNABLE TO CONTINUE! ****"))
)
)
)
)
(CPF-ERR-OFF)
(CPF-VBACK NIL)
(foreach G-I G-LST-MSG (prompt "\n") (CPF-BLINK G-I 6))
(princ "\n *** Keynoting Schedules Completed.\n")
(princ)
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-GET-SHEETS ;
;;; Description: This function returns a sorted list of all sheet ;
;;; series (G-MODE = T) or a sorted list of all sheets ;
;;; in current directory in asscending order. ;
;;; I.e. ;
;;; ("1" "2" "3" ...) - all sheet series ;
;;; ("1A" "1B" "1C" "2A" "2B" "3A" ...) - all sheets ;
;;;--------------------------------------------------------------------;
(defun CPKS-GET-SHEETS (/ G-LST-SER G-LST-SHT G-ID G-SHT G-DWG)
(foreach G-DWG (vl-directory-files (getvar "dwgprefix") "*.dwg" 1)
(cond
((member (car (setq G-ID (CPF-FILE-ID G-DWG))) '("SHT"))
(if (and (not (member (setq G-SHT (vl-string-left-trim "0" (caddr G-ID))) G-LST-SER))
(/= G-SHT "")
)
(setq G-LST-SER (append (list G-SHT) G-LST-SER))
)
(if (and (not (member (setq G-SHT (vl-string-left-trim "0" (cadddr G-ID))) G-LST-SHT))
(/= G-SHT "")
(< 47 (ascii (substr G-SHT 1 1)) 58)
)
(setq G-LST-SHT (append (list G-SHT) G-LST-SHT))
)
)
)
)
(setq G-LST-SER (vl-sort G-LST-SER (function (lambda (I1 I2) (< (atoi I1) (atoi I2)))))
G-LST-SHT (vl-sort G-LST-SHT
(function (lambda (I1 I2) (< (CPKS-SHT2NUM I1) (CPKS-SHT2NUM I2))))
)
)
(append (list (list "SERIES" G-LST-SER)) (list (list "SHEETS" G-LST-SHT)))
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-SHT2NUM ;
;;; Description: This function breaks down sheet number into single ;
;;; characters, converts these to ascii code and bind ;
;;; them together to create unique integer for sorting ;
;;; purpose. I.e. "10B" -> 494866 ;
;;;--------------------------------------------------------------------;
(defun CPKS-SHT2NUM (G-NUM / G-STR G-SUF G-PREF G-PREF-LG)
(foreach G-I (vl-string->list G-NUM)
(cond ((< 47 G-I 58)
(if G-PREF
(setq G-PREF (strcat G-PREF (chr G-I)))
(setq G-PREF (chr G-I))
)
)
(t
(setq G-I (- G-I 64))
(if G-SUF
(setq G-SUF (+ G-SUF G-I))
(setq G-SUF G-I)
)
)
)
)
(setq G-PREF-LG (strlen G-PREF))
(while (< (strlen G-PREF) (+ 2 G-PREF-LG)) (setq G-PREF (strcat G-PREF "0")))
(setq G-STR (+ (atoi G-PREF)
(if G-SUF
G-SUF
0
)
)
)
G-STR
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-GET-SYMBOLS ;
;;; Description: This function returns a sorted list of all keynote ;
;;; symbols in all spaces of current drawing including ;
;;; xrefs and binded blocks. ;
;;;--------------------------------------------------------------------;
(defun CPKS-GET-SYMBOLS (/ G-SS G-SYM G-TAG G-STRLEN
G-STRVAL G-OBJ G-ATTR G-I G-LST-SYM
G-ARR-ATTR G-OBJ-BLKS G-XREFDB G-XREFDB-MS G-NAME
G-LST-BADFAB G-BADFAB G-PART G-SYM-PART
)
;; Process Symbols in current space ;
(if (setq G-SS
(ssget
"x"
(list
'(-4 . "<or")
'(-4 . "<and")
'(0 . "INSERT")
'(2
.
"*PNT,*MAT,*ALUM,*STEEL,*ELEC,*FAB,*HDWE,*FABTEXT,*CP_KNMAT,*CP_KNPNT,*CP_KNHDW,*CP_KNELC,*CP_KNALM,*CP_KNSTL,*CP_KNFAB,*CP_KNFAB2,*CP_KNFAB3,*CP_KNPAR,*CP_KNPAR2,*CP_KNPAR3,*CP_KNREV,*CP_FTAG,*CP_FABTAG,*CP_FABTAG-S,*CP_FABTAG-XS,*CP_FABTAG-L,*CP_FABTAG-XL,*CP_PARTAG,*CP_PARTAG-S,*CP_PARTAG-XS,*CP_PARTAG-L,*CP_PARTAG-XL"
)
'(-4 . "and>")
'(0 . "MULTILEADER")
'(-4 . "or>")
)
)
)
(while (> (sslength G-SS) 0)
(setq G-OBJ (vlax-ename->vla-object (ssname G-SS 0)))
(if (or
(and (= (vlax-get-property G-OBJ "ObjectName") "AcDbBlockReference")
(= (vlax-get-property G-OBJ "HasAttributes") :vlax-true)
(setq G-ARR-ATTR (vlax-safearray->list (vlax-variant-value (vla-getattributes G-OBJ))))
)
(and (= "AcDbMLeader" (vla-get-objectname G-OBJ))
(/= "" (setq ml_block_name (vla-get-contentblockName G-OBJ)))
(null (setq G-ARR-ATTR nil))
(vlax-map-collection (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) ml_block_name)
'(lambda (object) (if (= (vla-get-objectname object) "AcDbAttributeDefinition") (setq G-ARR-ATTR (append G-ARR-ATTR (list object)))))
)
)
)
(progn
(foreach G-ATTR G-ARR-ATTR
(if (= (vlax-get-property G-OBJ "ObjectName") "AcDbBlockReference")
(setq G-TAG (strcase (vlax-get-property G-ATTR "TagString"))
G-STRLEN (strlen (vlax-get-property G-ATTR "TextString"))
G-STRVAL (vlax-get-property G-ATTR "TextString")
G-SYM NIL
)
(setq G-TAG (strcase (vlax-get-property G-ATTR "TagString"))
G-STRLEN (strlen (vla-getblockattributevalue G-OBJ (vla-get-objectid G-ATTR)))
G-STRVAL (vla-getblockattributevalue G-OBJ (vla-get-objectid G-ATTR))
G-SYM NIL
)
)
(cond
((member G-TAG (list "FAB" "FABNUM")) (setq G-SYM (strcase G-STRVAL)))
((= G-TAG "FABNO")
(setq G-SYM (strcase G-STRVAL)
G-SYM-PART G-SYM
)
)
((= G-TAG "PART") (setq G-PART (strcase G-STRVAL)))
((member G-TAG (list "F" "KNF"))
(setq G-SYM (strcat "F-"
(cond ((= G-STRLEN 3) (substr G-STRVAL 1))
((= G-STRLEN 2) (strcat "0" (substr G-STRVAL 1)))
((= G-STRLEN 1) (strcat "00" (substr G-STRVAL 1)))
(t (substr G-STRVAL (- G-STRLEN 2)))
)
)
G-SYM-PART G-SYM
)
(if (and (not (member G-STRLEN '(5 3))) (not (member G-STRVAL G-LST-BADFAB)))
(setq G-LST-BADFAB (append G-LST-BADFAB (list G-STRVAL)))
)
)
((member
G-TAG
(list "M" "P" "H" "E" "A" "S" "R" "PNT" "MAT" "ALUM" "STEEL" "ELEC" "HDWE")
)
(setq G-SYM (strcat (substr G-TAG 1 1) G-STRVAL))
)
((member G-TAG (list "KNP" "KNM" "KNH" "KNE" "KNA" "KNS"))
(setq G-SYM (strcat (substr G-TAG 3 1) G-STRVAL))
)
)
(if (and G-SYM (not (member G-SYM G-LST-SYM)))
(setq G-LST-SYM (append (list G-SYM) G-LST-SYM))
)
)
(if (and G-PART G-SYM-PART (not (assoc G-SYM-PART G_LST-PARTS)))
(setq G_LST-PARTS (append G_LST-PARTS (list (cons G-SYM-PART G-PART))))
)
(setq G-SYM-PART NIL
G-PART NIL
)
)
)
(ssdel (ssname G-SS 0) G-SS)
)
)
;; Process Symbols in Xrefs ;
(setq G-OBJ-BLKS (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for G-I G-OBJ-BLKS
(if (and (= (vlax-get-property G-I "IsXRef") :vlax-true)
(> (vlax-get-property G-I "Count") 1)
(setq G-XREFDB (vlax-get-property G-I "XRefDatabase"))
(setq G-XREFDB-MS (vlax-get-property G-XREFDB "ModelSpace"))
)
(progn
(vlax-for G-OBJ G-XREFDB-MS
(if
(and
(= (vlax-get-property G-OBJ "ObjectName") "AcDbBlockReference")
(= (vlax-get-property G-OBJ "HasAttributes") :vlax-true)
(setq G-NAME (vlax-get-property G-OBJ "Name"))
(or
(member (strcase (substr G-NAME
(+ 2
(cond ((vl-string-position (ascii "|") G-NAME 1 t))
(t -1)
)
)
)
)
'("PNT" "MAT" "ALUM" "STEEL"
"ELEC" "FAB" "HDWE" "FABTEXT"
"CP_KNMAT" "CP_KNPNT" "CP_KNHDW" "CP_KNELC"
"CP_KNALM" "CP_KNSTL" "CP_KNFAB" "CP_KNFAB2"
"CP_KNFAB3" "CP_KNPAR" "CP_KNPAR2" "CP_KNPAR3"
"CP_FTAG" "CP_FABTAG" "CP_FABTAG-S" "CP_FABTAG-XS"
"CP_FABTAG-L" "CP_FABTAG-XL" "CP_PARTAG" "CP_PARTAG-S"
"CP_PARTAG-XS" "CP_PARTAG-L" "CP_PARTAG-XL"
)
)
(wcmatch
(strcase (vlax-get-property G-OBJ "Name"))
"*PNT,*MAT,*ALUM,*STEEL,*ELEC,*FAB,*HDWE,*FABTEXT,*CP_KNMAT,*CP_KNPNT,*CP_KNHDW,*CP_KNELC,*CP_KNALM,*CP_KNSTL,*CP_KNFAB2,*CP_KNFAB3,*CP_KNPAR2,*CP_KNPAR3,*CP_KNPAR,*CP_KNFAB,*CP_FTAG,*CP_FABTAG,*CP_FABTAG-S,*CP_FABTAG-XS,*CP_FABTAG-L,*CP_FABTAG-XL,*CP_PARTAG,*CP_PARTAG-S,*CP_PARTAG-XS,*CP_PARTAG-L,*CP_PARTAG-XL"
)
)
(setq G-ARR-ATTR
(vlax-safearray->list (vlax-variant-value (vla-getattributes G-OBJ)))
)
)
(progn
(foreach G-ATTR G-ARR-ATTR
(setq G-TAG (strcase (vlax-get-property G-ATTR "TagString"))
G-STRLEN (strlen (vlax-get-property G-ATTR "TextString"))
G-STRVAL (vlax-get-property G-ATTR "TextString")
G-SYM NIL
)
(cond
((member G-TAG (list "FAB" "FABNUM")) (setq G-SYM (strcase G-STRVAL)))
((= G-TAG "FABNO")
(setq G-SYM (strcase G-STRVAL)
G-SYM-PART G-SYM
)
)
((= G-TAG "PART") (setq G-PART (strcase G-STRVAL)))
((member G-TAG (list "F" "KNF"))
(setq G-SYM
(strcat
"F-"
(cond
((= G-STRLEN 3) (substr G-STRVAL 1))
((= G-STRLEN 2) (strcat "0" (substr G-STRVAL 1)))
((= G-STRLEN 1) (strcat "00" (substr G-STRVAL 1)))
(t
(substr (vlax-get-property G-ATTR "TextString") (- G-STRLEN 2))
)
)
)
G-SYM-PART G-SYM
)
(if
(and (not (member G-STRLEN '(5 3))) (not (member G-STRVAL G-LST-BADFAB)))
(setq G-LST-BADFAB (append G-LST-BADFAB (list G-STRVAL)))
)
)
((member
G-TAG
(list "M" "P" "H" "E" "A" "S" "PNT" "MAT" "ALUM" "STEEL" "ELEC" "HDWE")
)
(setq G-SYM (strcat (substr G-TAG 1 1) G-STRVAL))
)
((member G-TAG (list "KNP" "KNM" "KNH" "KNE" "KNA" "KNS"))
(setq G-SYM (strcat (substr G-TAG 3 1) G-STRVAL))
)
)
(if (and G-SYM (not (member G-SYM G-LST-SYM)))
(setq G-LST-SYM (append (list G-SYM) G-LST-SYM))
)
)
(if (and G-PART G-SYM-PART (not (assoc G-SYM-PART G_LST-PARTS)))
(setq G_LST-PARTS (append G_LST-PARTS (list (cons G-SYM-PART G-PART))))
)
(setq G-SYM-PART NIL
G-PART NIL
)
)
)
)
)
)
)
;; Process Symbols in Binded (as Inserts) Xrefs;
(if (and (setq
G-SS (ssget "x" (list '(0 . "INSERT") '(2 . "DTL*,FAB*") (cons '410 (getvar "CTAB"))))
)
(> (sslength G-SS) 0)
)
(while (> (sslength G-SS) 0)
(if
(and
(/=
(logand (cdr (assoc 70 (tblsearch "block" (cdr (assoc 2 (entget (ssname G-SS 0)))))))
4
)
4
)
(setq G-NAME (cdr (assoc 2 (entget (ssname G-SS 0)))))
(setq G-OBJ-BLK (vla-item G-OBJ-BLKS G-NAME))
(setq G-CNT (vlax-get-property G-OBJ-BLK "Count")
G-ITEM 0
)
)
(while (< G-ITEM G-CNT)
(setq G-OBJ (vla-item G-OBJ-BLK G-ITEM)
G-ITEM (1+ G-ITEM)
)
(if
(and
(= (vlax-get-property G-OBJ "ObjectName") "AcDbBlockReference")
(= (vlax-get-property G-OBJ "HasAttributes") :vlax-true)
(setq G-ARR-ATTR
(vlax-safearray->list (vlax-variant-value (vla-getattributes G-OBJ)))
)
(wcmatch
(strcase (vlax-get-property G-OBJ "Name"))
"*PNT,*MAT,*ALUM,*STEEL,*ELEC,*FAB,*HDWE,*FABTEXT,*CP_KNMAT,*CP_KNPNT,*CP_KNHDW,*CP_KNELC,*CP_KNALM,*CP_KNSTL,*CP_KNFAB2,*CP_KNFAB3,*CP_KNPAR2,*CP_KNPAR3,*CP_KNPAR,*CP_KNFAB,*CP_FTAG,*CP_FABTAG,*CP_FABTAG-S,*CP_FABTAG-XS,*CP_FABTAG-L,*CP_FABTAG-XL,*CP_PARTAG,*CP_PARTAG-S,*CP_PARTAG-XS,*CP_PARTAG-L,*CP_PARTAG-XL"
)
)
(progn
(foreach G-ATTR G-ARR-ATTR
(setq G-TAG (strcase (vlax-get-property G-ATTR "TagString"))
G-STRLEN (strlen (vlax-get-property G-ATTR "TextString"))
G-STRVAL (vlax-get-property G-ATTR "TextString")
G-SYM NIL
)
(cond
((member G-TAG (list "FAB" "FABNUM")) (setq G-SYM (strcase G-STRVAL)))
((= G-TAG "FABNO")
(setq G-SYM (strcase G-STRVAL)
G-SYM-PART G-SYM
)
)
((= G-TAG "PART") (setq G-PART (strcase G-STRVAL)))
((member G-TAG (list "F" "KNF"))
(setq G-SYM
(strcat
"F-"
(cond
((= G-STRLEN 3) (substr G-STRVAL 1))
((= G-STRLEN 2) (strcat "0" (substr G-STRVAL 1)))
((= G-STRLEN 1) (strcat "00" (substr G-STRVAL 1)))
(t
(substr (vlax-get-property G-ATTR "TextString") (- G-STRLEN 2))
)
)
)
G-SYM-PART G-SYM
)
(if
(and (not (member G-STRLEN '(5 3))) (not (member G-STRVAL G-LST-BADFAB)))
(setq G-LST-BADFAB (append G-LST-BADFAB (list G-STRVAL)))
)
)
((member
G-TAG
(list "M" "P" "H" "E" "A" "S" "PNT" "MAT" "ALUM" "STEEL" "ELEC" "HDWE")
)
(setq G-SYM (strcat (substr G-TAG 1 1) G-STRVAL))
)
((member G-TAG (list "KNP" "KNM" "KNH" "KNE" "KNA" "KNS"))
(setq G-SYM (strcat (substr G-TAG 3 1) G-STRVAL))
)
)
(if (and G-SYM (not (member G-SYM G-LST-SYM)))
(setq G-LST-SYM (append (list G-SYM) G-LST-SYM))
)
)
(if (and G-PART G-SYM-PART (not (assoc G-SYM-PART G_LST-PARTS)))
(setq G_LST-PARTS (append G_LST-PARTS (list (cons G-SYM-PART G-PART))))
)
(setq G-SYM-PART NIL
G-PART NIL
)
)
)
)
)
(if (and G-PART G-SYM-PART (not (assoc G-SYM-PART G_LST-PARTS)))
(setq G_LST-PARTS (append (list (cons G-SYM-PART G-PART)) G_LST-PARTS))
)
(setq G-SYM-PART NIL
G-PART NIL
)
(ssdel (ssname G-SS 0) G-SS)
)
)
(if G-LST-BADFAB
(foreach G-BADFAB G-LST-BADFAB
(prompt "\n")
(CPF-BLINK (strcat "**** Fabrication Tag " G-BADFAB " has incorrect number! ****") 24)
)
)
(if G-OBJ-BLKS
(vlax-release-object G-OBJ-BLKS)
)
(if G-XREFDB
(vlax-release-object G-XREFDB)
)
(if G-XREFDB-MS
(vlax-release-object G-XREFDB-MS)
)
(setq X G_LST-PARTS)
G-LST-SYM
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-GET-SUMMARY ;
;;; Description: This function returns all a list containing all ;
;;; information from summary file (.sum) if present. ;
;;;--------------------------------------------------------------------;
(defun CPKS-GET-SUMMARY (/ G-LST-SUM G-FILE G-LST G-FILE-ID G-LST-READ)
(if (and G_CDWG
G_CSER
G_CSHT
G_PRJ-NUM
G_PRG-NAME
(caddr G_PATH)
(setq G-FILE (findfile (strcat (caddr G_PATH) "\\" G_PRJ-NUM ".sum")))
(setq G-FILE-ID (open G-FILE "r"))
)
(progn
(while (setq G-I (read-line G-FILE-ID)) (setq G-LST-READ (append G-LST-READ (list G-I))))
(close G-FILE-ID)
(setq G-LST-SUM (list (cons "CLIENT" (list (car G-LST-READ))))
G-LST-SUM (append G-LST-SUM (list (cons "PROGRAM" (list (cadr G-LST-READ)))))
G-LST-SUM (append G-LST-SUM (list (cons "PROJECT" (list (caddr G-LST-READ)))))
)
(repeat 3 (setq G-LST-READ (cdr G-LST-READ)))
(while G-LST-READ
(setq G-LST-STR (CPF-STR2LST (car G-LST-READ) "|" NIL))
(cond ((member "ELEMENT NAME>" G-LST-STR)
(setq
G-LST-SUM (append
G-LST-SUM
(list (cons "ELEMENT NAME" (list (CPF-LST2LST G-LST-STR G_INDX))))
)
)
)
((member "UNITS>" G-LST-STR)
(setq
G-LST-SUM (append G-LST-SUM
(list (cons "UNITS" (list (CPF-LST2LST G-LST-STR G_INDX))))
)
)
)
((member "SHEET SERIES" G-LST-STR)
(setq G-LST-READ (cdr G-LST-READ)
G-LST-STR (CPF-STR2LST (car G-LST-READ) "|" NIL)
G-LST-SUM (append
G-LST-SUM
(list (cons "SHEET SERIES" (list (CPF-LST2LST G-LST-STR G_INDX))))
)
)
)
((member "SHEETS" G-LST-STR)
(setq G-LST-READ (cdr G-LST-READ)
G-LST-STR (CPF-STR2LST (car G-LST-READ) "|" NIL)
G-LST-SUM (append G-LST-SUM
(list (cons "SHEETS" (list (CPF-LST2LST G-LST-STR G_INDX))))
)
)
)
((= (car G-LST-STR) "Fabrication")
(setq
G-LST-SUM (append (list (list (nth 1 G-LST-STR) (CPF-LST2LST G-LST-STR G_INDX)))
G-LST-SUM
)
)
)
((member (car G-LST-STR)
'("Paint" "Material" "Hardware" "Electrical" "Aluminum" "Steel")
)
(setq G-LST-SUM
(append (list (list (strcat (substr (car G-LST-STR) 1 1) (cadr G-LST-STR))
(CPF-LST2LST G-LST-STR G_INDX)
)
)
G-LST-SUM
)
)
)
)
(setq G-LST-READ (cdr G-LST-READ))
)
)
)
G-LST-SUM
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-GET-FABCNT ;
;;; Description: This function returns a list of fab counts from ;
;;; *.fab file. It works with the new standard (pipe ;
;;; delimited fab spec. file with counts stored in it) ;
;;; as well as with legacy files (counts stored in multi-;
;;; ple *.cnt files located in "Fabcounts" subfolder. ;
;;;--------------------------------------------------------------------;
(defun CPKS-GET-FABCNT (/ G-CNT-DIR G-LST-CNTS G-LST-SER G-CNT-SER
G-FILE-NM G-FILE-ID G-SER G-I G-FAB
G-CNT G-ENTRY G-FAB-ENTRY G-OLD-ASSO G-NEW-ASSO
G-LST-FABCNT G-SER
)
(if G_SPEC-FAB
(if G*SPEC-PIPE
;; retrieve fab counts stored in .fab file (new standard) ;
(progn (foreach G-I G_SPEC-FAB
(setq G-FAB (car G-I))
(if (/= (setq G-CNT (nth 2 G-I)) "")
(progn (setq G-LST-CNT NIL)
(foreach G-SER (CPF-STR2LST G-CNT "," NIL)
(setq G-LST-CNT (append G-LST-CNT (list (CPF-STR2LST G-SER "-" NIL))))
)
(setq G-ENTRY (append (list G-FAB) G-LST-CNT))
)
(setq G-ENTRY (list G-FAB))
)
(setq G-LST-FABCNT (append G-LST-FABCNT (list G-ENTRY)))
)
(setq G*SPEC-PIPE NIL)
)
;; retrieve fab counts stored in separete .cnt files (old standard) ;
(if (caddr G_PATH)
(progn
(setq G-CNT-DIR (strcat (caddr G_PATH) "\\Fabcounts")
G-LST-CNTS (vl-directory-files G-CNT-DIR "*.cnt" 1)
)
(mapcar (function (lambda (X)
(if (= (strlen X) 1)
(setq G-LST-SER (append G-LST-SER (list (strcat "0" X))))
(setq G-LST-SER (append G-LST-SER (list X)))
)
)
)
(cadr (assoc "SERIES" G_LST-SS))
)
(while G-LST-CNTS
(setq G-CNT-SER (substr (car G-LST-CNTS)
1
(vl-string-position (ascii ".") (car G-LST-CNTS))
)
)
(if (member G-CNT-SER G-LST-SER)
(progn
(if (setq G-FILE-NM (strcat (caddr G_PATH) "\\Fabcounts\\" (car G-LST-CNTS)))
(progn (setq G-FILE-ID (open G-FILE-NM "r")
G-SER (vl-string-left-trim "0" G-CNT-SER)
)
(while (setq G-I (read-line G-FILE-ID))
(if (/= (strcase (vl-string-trim " " G-I)) "NONE")
(progn (setq G-FAB (vl-string-trim
" "
(substr G-I 1 (vl-string-position (ascii " ") G-I))
)
G-CNT (vl-string-trim
" "
(substr G-I (+ 2 (vl-string-position (ascii " ") G-I)))
)
)
(setq G-ENTRY (list G-SER G-CNT))
(if (not (assoc G-FAB G-LST-FABCNT))
(setq G-FAB-ENTRY (append (list G-FAB) (list G-ENTRY))
G-LST-FABCNT (append (list G-FAB-ENTRY) G-LST-FABCNT)
)
(setq G-OLD-ASSO (assoc G-FAB G-LST-FABCNT)
G-NEW-ASSO (append G-OLD-ASSO (list G-ENTRY))
G-LST-FABCNT (subst G-NEW-ASSO
(assoc G-FAB G-LST-FABCNT)
G-LST-FABCNT
)
)
)
)
)
)
(close G-FILE-ID)
)
)
)
)
(setq G-LST-CNTS (cdr G-LST-CNTS))
)
)
)
)
)
G-LST-FABCNT
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-LST2STR ;
;;; Description: This function returns conversion of a list of strings;
;;; into delimited string. ;
;;; I.e. ("1" "2" "3") -> "1|2|3" ;
;;;--------------------------------------------------------------------;
(defun CPKS-LST2STR (G-LST G-DELIM / G-STR G-I)
(if (and G-LST G-DELIM (setq G-STR (car G-LST)))
(foreach G-I (cdr G-LST) (setq G-STR (strcat G-STR G-DELIM G-I)))
)
(if G-STR
G-STR
""
)
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-XPIPES ;
;;; Description: This function generates string of pipe characters. ;
;;; Number of pipes is defined by G-NUM argument. ;
;;;--------------------------------------------------------------------;
(defun CPKS-XPIPES (G-NUM / G-STR)
(setq G-STR "|")
(repeat (1- G-NUM) (setq G-STR (strcat G-STR "|")))
G-STR
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-SYM-VALIDATE ;
;;; Description: This function returns T if provided symbol (G-STR) ;
;;; is a legitimate CP keynote symbol, NIL otherwise. ;
;;;--------------------------------------------------------------------;
(defun CPKS-SYM-VALIDATE (G-STR)
(if (and (member (strcase (substr G-STR 1 1)) '("P" "M" "H" "E" "A" "S"))
(< 47 (ascii (substr G-STR 2 1)) 58)
(< 47 (ascii (substr G-STR 3 1)) 58)
(< (strlen (substr G-STR 2)) 5)
)
(setq G-STR t)
(if (and (= (strcase (substr G-STR 1 2)) "F-")
(< 47 (ascii (substr G-STR 3 1)) 58)
(< 47 (ascii (substr G-STR 4 1)) 58)
(< 47 (ascii (substr G-STR 5 1)) 58)
(= (strlen G-STR) 5)
)
(setq G-STR t)
(setq G-STR NIL)
)
)
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-DO-SUMMARY ;
;;; Description: This function creates PROJECT_NUMBER.SUM summary file;
;;;--------------------------------------------------------------------;
(defun CPKS-DO-SUMMARY (/ G-LST-SER G-LST-SHT G-COL-MASTER G-COL-SER
G-COL-SHT G-LST-CELM G-LST-CUNIT G-LST-CSER G-LST-CSHT
G_LST-SUMMARY G-LST G-I G-POS
G-VAL G-CODE G-NUM G-UNITS G-LST-UNIT
G-LST-FAB-SYM G-LST-FAB-SUM G-FAB
G-LST-CNT G-SER G-LST-SER G-ASSO G-CNT
G-TOTAL G-LST-SYM G-LST-SYM-SUM G-NAME
G-COL-NULL G-COL-INDX G-SYM G-SHT G-MARK
G-DATA G-LST-X G-ITEM-STR G-STR G-S
G-TOTAL-STR
)
(if (and G_CDWG G_CSER G_CSHT G_PRJ-NUM G_PRG-NAME)
(progn
(setq G-LST-SER (cadr (assoc "SERIES" G_LST-SS))
G-LST-SHT (cadr (assoc "SHEETS" G_LST-SS))
G-COL-MASTER 9
G-COL-SER (length G-LST-SER)
G-COL-SHT (length G-LST-SHT)
G-LST-CELM (cadr (assoc "ELEMENT NAME" G_LST-SUM))
G-LST-CUNIT (cadr (assoc "UNITS" G_LST-SUM))
G-LST-CSER (cadr (assoc "SHEET SERIES" G_LST-SUM))
G-LST-CSHT (cadr (assoc "SHEETS" G_LST-SUM))
G_LST-SUMMARY NIL
G-LST NIL
)
(cond (G_LST-SEM
(cond ((setq G-LST-SEM (cadr (assoc G_PRJ-NUM G_LST-SEM)))
(foreach G-S G-LST-SEM
(if (not (member G-S G-LST-SER))
(setq G-LST-SEM (vl-remove G-S G-LST-SEM))
)
)
(if (not (member G_CSER G-LST-SEM))
(setq G-LST-SEM (vl-sort (append G-LST-SEM (list G_CSER)) '<))
)
(setq G_LST-SEM
(subst (list G_PRJ-NUM G-LST-SEM) (assoc G_PRJ-NUM G_LST-SEM) G_LST-SEM)
)
)
(t
(setq G-LST-SEM (list G_CSER)
G_LST-SEM (append G_LST-SEM (list (list G_PRJ-NUM G-LST-SEM)))
)
)
)
)
(t
(setq G-LST-SEM (list G_CSER)
G_LST-SEM (list (list G_PRJ-NUM G-LST-SEM))
)
)
)
(setq G-LST-SEM (vl-sort G-LST-SEM (function (lambda (I1 I2) (< (atoi I1) (atoi I2))))))
(foreach G-S G_LST-SEM
(setq G-LST2WRITE (append G-LST2WRITE
(list (strcat (car G-S) "|" (CPKS-LST2STR (cadr G-S) ",")))
)
)
)
(if G-LST2WRITE
(progn (setq G-FILE-ID (open (strcat (caddr G_PATH) "\\" (cadr G_PATH) ".sem") "w"))
(foreach G-S G-LST2WRITE (write-line G-S G-FILE-ID))
(close G-FILE-ID)
)
)
(setq G-LST-SER G-LST-SEM
G-LST2WRITE NIL
)
(foreach G-S G-LST-SHT
(if (= (strlen G-S) 1)
(setq G-SSER G-S)
(progn (setq G-SSER "")
(mapcar (function (lambda (X)
(cond ((< 47 X 58)
(if (not G-SSSTOP)
(setq G-SSER (strcat (chr X) G-SSER))
)
)
(t (setq G-SSSTOP t))
)
)
)
(vl-string->list G-S)
)
)
)
(setq G-SSSTOP NIL)
(if (not (member G-SSER G-LST-SER))
(setq G-LST-SHT (vl-remove G-S G-LST-SHT))
)
)
;; create Header entries ;
(setq G_LST-SUMMARY
(append (list (list (strcat "Client: "
G_CLI-CODE
G_CLI-NAME
(CPKS-XPIPES (+ (1- G-COL-MASTER) G-COL-SER))
)
)
)
(list (list (strcat "Program: "
G_PRG-CODE
G_PRG-NAME
(CPKS-XPIPES (+ (1- G-COL-MASTER) G-COL-SER))
)
)
)
(list (list (strcat "Project No: "
G_PRJ-NUM
(CPKS-XPIPES (+ (1- G-COL-MASTER) G-COL-SER))
)
)
)
)
)
;; create ELEMENT NAME entry ;
(foreach G-I G-LST-SER
(if (equal G-I G_CSER)
(setq G-LST (append G-LST (list G_ELM-NAME)))
(if (and G-LST-CELM G-LST-CSER (setq G-POS (vl-position G-I G-LST-CSER)))
(setq G-LST (append G-LST (list (nth G-POS G-LST-CELM))))
(setq G-LST (append G-LST (list "****")))
)
)
)
(setq G_LST-SUMMARY (append G_LST-SUMMARY
(list (list (strcat (CPKS-XPIPES (1- G-COL-MASTER))
"ELEMENT NAME>|"
(CPKS-LST2STR G-LST "|")
)
)
)
)
G-LST NIL
)
;; create UNITS entry ;
(if (and G_ELM-CODE (/= G_ELM-CODE ""))
(progn (setq G-UNITS NIL)
(foreach G-I (CPF-STR2LST G_ELM-CODE ";" NIL)
(if (and (setq G-CODE (CPF-STR2LST G-I "|" NIL))
(setq G-NUM (atoi (last G-CODE)))
(> G-NUM 0)
(= (length G-CODE) 4)
)
(if (not G-UNITS)
(setq G-UNITS G-NUM)
(setq G-UNITS (+ G-UNITS G-NUM))
)
)
)
(if G-UNITS
(setq G-UNITS (itoa G-UNITS))
(setq G-UNITS "1")
)
)
(if (and G_ELM-QTY (/= G_ELM-QTY ""))
(setq G-UNITS G_ELM-QTY)
(setq G-UNITS "1")
)
)
(setq G-LST NIL)
(foreach G-I G-LST-SER
(if (equal G-I G_CSER)
(setq G-LST (append G-LST (list G-UNITS)))
(if (and G-LST-CUNIT G-LST-CSER (setq G-POS (vl-position G-I G-LST-CSER)))
(setq G-LST (append G-LST (list (nth G-POS G-LST-CUNIT))))
(setq G-LST (append G-LST (list "1")))
)
)
)
(setq G_LST-SUMMARY (append G_LST-SUMMARY
(list (list (strcat (CPKS-XPIPES (1- G-COL-MASTER))
"UNITS>|"
(CPKS-LST2STR G-LST "|")
)
)
)
)
G-LST-UNIT G-LST
G-LST NIL
)
;; create FABRICATIONS LIST: HEADER entry ;
(setq G_LST-SUMMARY
(append
G_LST-SUMMARY
(list (list (strcat "FABRICATIONS LIST:"
(CPKS-XPIPES G-COL-MASTER)
"SHEET SERIES|"
(CPKS-XPIPES (- G-COL-SER 2))
)
)
)
(list
(list
(strcat
"ITEM|SYMBOL|TOTAL QTY|PART #||DWG NO.|VENDOR|DUE DATE|Description|"
(CPKS-LST2STR G-LST-SER "|")
)
)
)
)
G-LST NIL
)
;; create Fabrication entries ;
(mapcar (function (lambda (X)
(if (= (substr X 1 1) "F")
(setq G-LST-FAB-SYM
(vl-sort
(append G-LST-FAB-SYM (list X))
(function
(lambda (I1 I2) (< (atoi (substr I1 3)) (atoi (substr I2 3))))
)
)
)
)
)
)
G_LST-SYM
)
(mapcar (function (lambda (X)
(if (and (= (substr (car X) 1 1) "F") (CPKS-SYM-VALIDATE (car X)))
(setq G-LST-FAB-SUM (append (list X) G-LST-FAB-SUM))
)
)
)
G_LST-SUM
)
(if G-LST-FAB-SYM
(mapcar (function (lambda (X)
(if (not (assoc X G-LST-FAB-SUM))
(setq G-LST-FAB-SUM
(vl-sort
(append G-LST-FAB-SUM (list (list X)))
(function
(lambda (I1 I2)
(< (atoi (substr (car I1) 3)) (atoi (substr (car I2) 3)))
)
)
)
)
)
)
)
G-LST-FAB-SYM
)
)
(if (and G-LST-FAB-SUM
(setq G_SPEC-FAB (CPF-SPEC-FILE "FAB" NIL))
(setq G_LST-FABCNT (CPKS-GET-FABCNT))
)
(foreach G-I G-LST-FAB-SUM
(if (and (setq G-FAB (car G-I)) (setq G-CNT (cdr (assoc G-FAB G_LST-FABCNT))))
(progn
(setq G-LST-CNT NIL)
(foreach G-SER G-LST-SER
(if (setq G-ASSO (assoc G-SER G-CNT))
(setq G-LST-CNT (append G-LST-CNT (cdr G-ASSO)))
(setq G-LST-CNT (append G-LST-CNT (list "")))
)
)
(if (member NIL (mapcar (function (lambda (X) (= X ""))) G-LST-CNT))
(progn
(setq G-CNT 0
G-TOTAL 0
)
(mapcar
(function
(lambda (X)
(if (> (atoi X) 0)
(setq G-TOTAL (+ G-TOTAL (* (atoi (nth G-CNT G-LST-UNIT)) (atoi X))))
)
(setq G-CNT (1+ G-CNT))
)
)
G-LST-CNT
)
(setq G-TOTAL-STR (itoa G-TOTAL))
)
(if (= (caar G-CNT) "EXIST.")
(setq G-TOTAL-STR "EXIST.")
(setq G-TOTAL-STR "")
)
)
(setq
G_LST-SUMMARY (append G_LST-SUMMARY
(list (list (strcat "Fabrication|"
G-FAB
"|"
G-TOTAL-STR
"|"
(nth 1 (assoc G-FAB G_SPEC-FAB))
"||"
(vl-string-subst "FAB" "F" G-FAB)
"|"
(nth 3 (assoc G-FAB G_SPEC-FAB))
"||"
(last (assoc G-FAB G_SPEC-FAB))
"|"
(CPKS-LST2STR G-LST-CNT "|")
)
)
)
)
)
)
)
)
(if (and G-LST-FAB-SUM (not G_SPEC-FAB))
(progn
(if G_PRG-NAME
(CPF-BLINK (strcat " **** Missing" (strcase G_PRG-NAME) ".FAB Spec. File! ****")
6
)
(CPF-BLINK (strcat " **** Missing *.FAB Spec. File! ****") 6)
)
(if G_LST-SUM
(setq G_LST-SUMMARY NIL)
)
)
)
)
;; create MATERIALS LIST: HEADER entry ;
(if G_LST-SUMMARY
(progn
(setq G_LST-SUMMARY
(append
G_LST-SUMMARY
(list (list " "))
(list (list (strcat "MATERIALS LIST:"
(CPKS-XPIPES G-COL-MASTER)
"SHEETS|"
(CPKS-XPIPES (- G-COL-SHT 2))
)
)
)
(list
(list
(strcat "ITEM|SYMBOL|QTY|UNITS|SIZE|CP#|MFR.|MFR#|Description|"
(CPKS-LST2STR G-LST-SHT "|")
)
)
)
)
G-LST NIL
)
;; create Paint, Material, Hardware, Electrical, Aluminum and Steel entries ;
(foreach G-I (list "PNT" "MAT" "HDW" "ELC" "ALM" "STL")
(setq G-LST-SYM NIL
G-LST-SYM-SUM NIL
G-SPEC-FILE NIL
)
(if G_LST-SUMMARY
(progn
(mapcar (function (lambda (X)
(if (= (substr X 1 1) (substr G-I 1 1))
(setq G-LST-SYM
(vl-sort
(append G-LST-SYM (list X))
(function (lambda (I1 I2)
(< (atoi (substr I1 2)) (atoi (substr I2 2)))
)
)
)
)
)
)
)
G_LST-SYM
)
(mapcar (function (lambda (X)
(if (and (= (substr (car X) 1 1) (substr G-I 1 1))
(CPKS-SYM-VALIDATE (car X))
)
(setq G-LST-SYM-SUM (append (list X) G-LST-SYM-SUM))
)
)
)
G_LST-SUM
)
(if G-LST-SYM
(mapcar
(function (lambda (X)
(if (not (assoc X G-LST-SYM-SUM))
(setq
G-LST-SYM-SUM (vl-sort (append G-LST-SYM-SUM (list (list X)))
(function (lambda (I1 I2)
(< (atoi (substr (car I1) 2))
(atoi (substr (car I2) 2))
)
)
)
)
)
)
)
)
G-LST-SYM
)
)
(if (and G-LST-SYM-SUM (setq G-SPEC-FILE (CPF-SPEC-FILE G-I NIL)))
(progn
(cond ((= G-I "PNT")
(setq G-NAME "Paint"
G-COL-NULL "||||"
G-COL-INDX (list 3 2 1)
G_SPEC-PNT G-SPEC-FILE
)
)
((= G-I "MAT")
(setq G-NAME "Material"
G-COL-NULL "|||||"
G-COL-INDX (list 2 3)
G_SPEC-MAT G-SPEC-FILE
)
)
((= G-I "HDW")
(setq G-NAME "Hardware"
G-COL-NULL "||||"
G-COL-INDX (list 1 2 2)
G_SPEC-HDW G-SPEC-FILE
)
)
((= G-I "ELC")
(setq G-NAME "Electrical"
G-COL-NULL "||||"
G-COL-INDX (list 1 2 3)
G_SPEC-ELC G-SPEC-FILE
)
)
((= G-I "ALM")
(setq G-NAME "Aluminum"
G-COL-NULL "||||||"
G-COL-INDX (list 10)
G_SPEC-ALM G-SPEC-FILE
)
)
((= G-I "STL")
(setq G-NAME "Steel"
G-COL-NULL "||||||"
G-COL-INDX (list 10)
G_SPEC-STL G-SPEC-FILE
)
)
)
(foreach G-ITEM G-LST-SYM-SUM
(setq G-LST-X NIL
G-SYM (car G-ITEM)
G-MARK (substr G-SYM 2)
G-ASSO (cadr G-ITEM)
G-DATA NIL
)
(if (setq G-DATA (assoc G-SYM G-SPEC-FILE))
(progn (foreach G-SHT G-LST-SHT
(if (equal G_CSHT G-SHT)
(if (member G-SYM G-LST-SYM)
(setq G-LST-X (append G-LST-X (list "X")))
(setq G-LST-X (append G-LST-X (list "")))
)
(if (and G-ASSO
(setq G-POS (vl-position G-SHT G-LST-CSHT))
(setq G-VAL (nth G-POS G-ASSO))
)
(setq G-LST-X (append G-LST-X (list G-VAL)))
(setq G-LST-X (append G-LST-X (list "")))
)
)
)
(if (member t (mapcar (function (lambda (X) (/= "" X))) G-LST-X))
(progn (setq G-ITEM-STR (strcat G-NAME "|" G-MARK G-COL-NULL))
(foreach G-CNT G-COL-INDX
(if (not (setq G-STR (nth G-CNT G-DATA)))
(setq G-STR "")
)
(setq G-ITEM-STR (strcat G-ITEM-STR G-STR "|"))
)
(setq G-ITEM-STR (strcat G-ITEM-STR
(last G-DATA)
"|"
(CPKS-LST2STR G-LST-X "|")
)
G_LST-SUMMARY (append G_LST-SUMMARY (list (list G-ITEM-STR)))
)
)
)
)
)
)
)
(if (and G-LST-SYM-SUM (not G-SPEC-FILE))
(progn (if G_PRG-NAME
(CPF-BLINK (strcat " **** Missing"
(strcase G_PRG-NAME)
"."
G-I
" Spec. File! ****"
)
6
)
(CPF-BLINK (strcat " **** Missing *." G-I " Spec. File! ****") 6)
)
(if G_LST-SUM
(setq G_LST-SUMMARY NIL)
)
)
)
)
)
)
)
)
)
(if (and G_LST-SUMMARY
G_PRJ-NUM
(caddr G_PATH)
(setq G-FILE-ID (open (strcat (caddr G_PATH) "\\" G_PRJ-NUM ".sum") "w"))
)
(progn (foreach G-I G_LST-SUMMARY (write-line (car G-I) G-FILE-ID)) (close G-FILE-ID))
(cond
((not G_LST-SUMMARY)
(CPF-BLINK "**** Summary file not created - No Contents! ****" 6)
)
((not G_PRJ-NUM)
(CPF-BLINK "**** Summary file not created - Unknown Project Number! ****" 6)
)
((not (caddr G_PATH))
(CPF-BLINK "**** Summary file not created - Directory mismatch! ****" 6)
)
(t (CPF-BLINK "**** Summary file not created - Unable to open for write! ****" 6))
)
)
)
)
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-DO-SQUEEZE ;
;;; Description: Calculate y-factor for keynote block inserts. ;
;;;--------------------------------------------------------------------;
;;;(defun CPKS-DO-SQUEEZE (GA-PTY-UP GA-PTY-DN GA-SCL / G-LG-TOTAL G-LST G-FACTOR g-yes-fab g-yes-rev)
;;; (if
;;; (and
;;; (setq G-SS (ssget "x" (list '(0 . "INSERT") '(2 . "CP_ksstn-t") (cons 410 (getvar "ctab")))))
;;; (> (sslength G-SS) 0)
;;; )
;;; (setq GA-PTY-DN (nth 1 (cdr (assoc 10 (entget (ssname G-SS 0)))))
;;; G-RANGE-PTY (- GA-PTY-UP GA-PTY-DN)
;;; )
;;; )
;;; (if G_MISSING-INFO
;;; (setq G-LG-TOTAL (* GA-SCL 2.4))
;;; (setq G-LG-TOTAL 0)
;;; )
;;; (foreach G-I (list "PNT" "MAT" "HDW" "ELC" "ALM" "STL" "FAB" "REV")
;;; (setq G=LST-SYM G_LST-SYM)
;;; (setq G-LST NIL)
;;; (mapcar
;;; (function (lambda (X)
;;; (if (equal (substr X 1 1) (substr G-I 1 1))
;;; (progn
;;; (if (equal (substr G-I 1 1) "F")
;;; (setq
;;; G-LST (vl-sort
;;; (append G-LST (list X))
;;; (function (lambda (I1 I2) (< (atoi (substr I1 3)) (atoi (substr I2 3)))))
;;; )
;;; )
;;; (setq
;;; G-LST (vl-sort
;;; (append G-LST (list X))
;;; (function (lambda (I1 I2) (< (atoi (substr I1 2)) (atoi (substr I2 2)))))
;;; )
;;; )
;;; )
;;; (cond ((=
;;; )
;;; (if (= (substr g-i 1 1) "F") (setq g-yes-fab t))
;;; (if (= (substr g-i 1 1) "R") (setq g-yes-rev t))
;;; )
;;; )
;;; G_LST-SYM
;;; )
;;; (if G-LST
;;; (progn (setq G-LG-TOTAL (+ G-LG-TOTAL (* GA-SCL G-KSBLK-HT-HEADER) (* (length G-LST) GA-SCL G-KSBLK-HT-TILE)
;;; (if G-YES-FAB
;;; (* GA-SCL G-KSBLK-HT-HEADER-FAB)
;;; 0.0
;;; ) (if G-YES-REV
;;; (* GA-SCL G-KSBLK-HT-HEADER-REV)
;;; 0.0
;;; )
;;; )
;;;
;;;
;;; (cond ((= G-I "FAB") (setq G-LG (* GA-SCL G-KSBLK-HT-HEADER-FAB)))
;;; (t (setq G-LG (* GA-SCL G-KSBLK-HT-HEADER)))
;;; )
;;; (setq G-LG-TOTAL (+ G-LG-TOTAL G-LG (* (length G-LST) GA-SCL G-KSBLK-HT-TILE)))
;;; )
;;; )
;;; (cond ((> G-LG-TOTAL (* 1.05 G-RANGE-PTY)) (setq G-FACTOR (* 0.92 (/ G-RANGE-PTY G-LG-TOTAL))))
;;; (t (setq G-FACTOR 1.0))
;;; )
;;; )
;;; G-FACTOR
;;;)
(defun CPKS-DO-SQUEEZE (GA-PTY-UP GA-PTY-DN GA-SCL / G-LG-TOTAL
G-FACTOR G-YES-FAB G-YES-REV G-YES-PNT G-YES-MAT
G-YES-HRD G-YES-ELC G-YES-MET
)
;; adjust lower y-value of KS footprint...
(if (and (setq G-SS
(ssget "x" (list '(0 . "INSERT") '(2 . "CP_ksstn-t*") (cons 410 (getvar "ctab"))))
)
(> (sslength G-SS) 0)
)
(setq GA-PTY-DN (nth 1 (cdr (assoc 10 (entget (ssname G-SS 0))))))
)
;; calculate available KS footprint height...
(setq G-RANGE-PTY (- GA-PTY-UP GA-PTY-DN))
;;
(if G_MISSING-INFO
;;; (setq G-LG-TOTAL (* GA-SCL 2.4))
(setq G-LG-TOTAL 2.4)
(setq G-LG-TOTAL 0)
)
(mapcar (function (lambda (X)
(cond ((= (substr X 1 1) "F")
(setq G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-TILE))
(if (not G-YES-FAB)
(setq G-YES-FAB t
G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-HEADER-FAB)
)
)
)
((= (substr X 1 1) "R")
(setq G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-TILE))
(if (not G-YES-REV)
(setq G-YES-REV t
G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-HEADER-REV)
)
)
)
((= (substr X 1 1) "P")
(setq G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-TILE))
(if (not G-YES-PNT)
(setq G-YES-PNT t
G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-HEADER)
)
)
)
((= (substr X 1 1) "M")
(setq G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-TILE))
(if (not G-YES-MAT)
(setq G-YES-MAT t
G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-HEADER)
)
)
)
((= (substr X 1 1) "H")
(setq G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-TILE))
(if (not G-YES-HRD)
(setq G-YES-HRD t
G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-HEADER)
)
)
)
((= (substr X 1 1) "E")
(setq G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-TILE))
(if (not G-YES-ELC)
(setq G-YES-ELC t
G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-HEADER)
)
)
)
((member (substr X 1 1) (list "A" "S"))
(setq G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-TILE))
(if (not G-YES-MET)
(setq G-YES-MET t
G-LG-TOTAL (+ G-LG-TOTAL G-KSBLK-HT-HEADER)
)
)
)
)
)
)
G_LST-SYM
)
(cond ((and G-RANGE-PTY (> (* G-LG-TOTAL GA-SCL) G-RANGE-PTY))
(setq G-FACTOR (* 0.95 (/ G-RANGE-PTY (* G-LG-TOTAL GA-SCL))))
)
(t (setq G-FACTOR 1.0))
)
G-FACTOR
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-DO-INSERTS ;
;;; Description: This function handles insertion of keynote blocks in ;
;;; title block. ;
;;;--------------------------------------------------------------------;
(defun CPKS-DO-INSERTS (/ G-SS G-DWG-SCALE G-INS-SCALE
G-TB-DATA G-TB-NM G-TB-IPT G-LST-IPTS
G-TB-VER G-TB-PTS G-STEN G-REV
G-IPT G-LST G-TITLE-ON G-ATTR-DSC
G-ATTR-MFN G-ATTR-QTY G-SPEC-FILE G-HT-TILE
G-HT-HEADER G-BLK-HEADER G-BLK-TILE G-SPEC-FILE
G-TITLE-MET G-ASSO G-SYM G-I
G-FAB-TOTAL G-FEQTY G-FUQTY G-ENTRY
G-FABT G-LST-QTY G-LST-UNIT G-FAB-CNT
G-LST-FABS G-BLK-MASTERI G-STEN-DONE G-METRIC
G-KSBLK-HT-HEADER G-KSBLK-HT-HEADER-FAB
G-KSBLK-HT-TILE G-REVBLK-HT-HEADER G-REVBLK-HT-TITLE
G-KSBLK-HT-HEADER-REV
G-TB-NEW
)
(setq G-KSBLK-HT-HEADER 0.45
G-KSBLK-HT-HEADER-FAB 0.65
G-KSBLK-HT-HEADER-REV 1.0
G-KSBLK-HT-TILE 0.3125
G-REVBLK-HT-HEADER 1.0
G-REVBLK-HT-TILE 0.3125
G-TB-NEW nil
)
(CPF-TEXTSTYLE "KEYNOTE" t)
(vl-cmdf "._UCS" "World")
;Expanded selection to find V2 Titleblock (DF 03-24-20)
;;; (setq G-SS (ssget "x"
;;; (list '(0 . "INSERT")
;;; '(2 . "24x36,24X36,24x36_V2,24X36_V2,A1,a1,A4,a4,11X17,11x17,11X17_V2,11x17_v2,85X11,85x11,85X11_V2,85x11_v2,setup,SETUP,setup_v2,SETUP_V2")
;;; (cons 410 (getvar "ctab"))
;;; )
;;; ))
(if (setq G-SS (ssget "x"
(list '(0 . "INSERT")
'(2 . "24x36,24X36,A1,a1,A4,a4,11X17,11x17,85X11,85x11,setup,SETUP")
(cons 410 (getvar "ctab"))
)
)
)
(setq G-TB-NEW nil)
(if (setq G-SS (ssget "x"
(list '(0 . "INSERT")
'(2 . "24x36_V2,24X36_V2,11X17_V2,11x17_v2,85X11_V2,85x11_v2,setup_v2,SETUP_V2")
(cons 410 (getvar "ctab"))
)
))
(setq G-TB-NEW t)
)
)
(setq G_DICT (CPF-DICT "CP" NIL))
(if (and G-SS (> (sslength G-SS) 0))
(progn
(setq G-TB-DATA (entget (ssname G-SS 0)))
(setq G-TB-NM (strcase (cdr (assoc 2 G-TB-DATA))))
;;; (if (= G-TB-NM "24X36_V2")
;;; (setq G-TB-NM "24X36")
;;; )
(setq G-TB-IPT (cdr (assoc 10 G-TB-DATA))
G-DWG-SCALE (cdr (assoc 41 G-TB-DATA))
G-TB-VER (CPF-TBLK-VER)
G-TB-PTS (CPF-TBLK-POINTS)
)
)
(if (not (setq G-DWG-SCALE (atof (cdr (assoc "DWG_SCALE" G_DICT)))))
(setq G-DWG-SCALE 1.0)
)
)
(setq G_TB-SCF 1.0)
(cond ((member G-TB-NM (list "24X36" "24X36_V2" "SETUP" "SETUP_V2"))
(setq G-INS-SCALE 1.0
G-STEN t
G-REV t
G-FABT NIL
)
(if (= G-TB-VER "E")
(setq G_TB-SCF 1.0289)
)
(if (= G-TB-VER "F")
(setq G_TB-SCF 1.0289)
)
(if (= G-TB-VER "G")
(setq G_TB-SCF 1.0)
)
)
((= G-TB-NM "A1")
(setq G-INS-SCALE 1.0
G-STEN t
G-REV t
G-FABT NIL
)
)
((member G-TB-NM '("85X11" "85X11_V2" "A4"))
(setq G-INS-SCALE 0.8)
(cond ((member (car G_FILE-ID) '("SHT" "SET"))
(setq G-STEN t
G-REV t
G-FABT NIL
)
)
(t
(setq G-STEN NIL
G-REV NIL
)
(cond ((member (car G_FILE-ID) '("FAB")) (setq G-FABT t))
(t (setq G-FABT NIL))
)
)
)
)
((member G-TB-NM '("11X17"))
(setq G-INS-SCALE 0.75)
(cond ((member (car G_FILE-ID) '("SHT" "SET"))
(setq G-STEN t
G-REV t
G-FABT NIL
)
)
(t
(setq G-STEN t
G-REV t
)
(cond ((member (car G_FILE-ID) '("FAB")) (setq G-FABT t))
(t (setq G-FABT NIL))
)
)
)
)
((member G-TB-NM '("11X17_V2"))
(setq G-INS-SCALE (/ 2.50 3.625))
(cond ((member (car G_FILE-ID) '("SHT" "SET"))
(setq G-STEN t
G-REV t
G-FABT NIL
)
)
(t
(setq G-STEN t
G-REV t
)
(cond ((member (car G_FILE-ID) '("FAB")) (setq G-FABT t))
(t (setq G-FABT NIL))
)
)
)
)
(t
(setq G-INS-SCALE 1.0
G-STEN NIL
G-REV NIL
)
(cond ((member (car G_FILE-ID) '("FAB")) (setq G-FABT t))
(t (setq G-FABT NIL))
)
)
)
(if (setq G-LST-IPTS (cdr (assoc G-TB-NM G-TB-PTS)))
(if (not (setq G-LST-IPTS (cdr (assoc G-TB-VER G-LST-IPTS))))
(setq G-LST-IPTS (cdr (last (assoc G-TB-NM G-TB-PTS))))
)
)
(if (member (substr G*ENV 2 1) (list "m" "j" "c" "M"))
(cond ((member (substr G*ENV 2 1) '("m" "j")) (setq G-INS-SCALE (* 25.0 G-INS-SCALE)))
((= (substr G*ENV 2 1) "c") (setq G-INS-SCALE (* 2.5 G-INS-SCALE)))
((= (substr G*ENV 2 1) "M") (setq G-INS-SCALE (* 0.025 G-INS-SCALE)))
)
)
(if G_SURVEYSC
(setq G-INS-SCALE (/ G_SURVEYSC G-DWG-SCALE))
)
;;; generate insertion start point for keynoting schedules block...
(if G_SURVEYIPT
(setq G-IPT G_SURVEYIPT)
(if (or (and (not G-MODE) (member G-TB-NM '("85X11" "85X11_V2" "A4")))
(and (not G-MODE) (member (car G_FILE-ID) '("DTL" "FAB" "MSC")) (not G-TB-NM))
)
(setq G-IPT (getpoint "\nSelect upper left corner for Keynoting Schedules block: "))
)
)
(if (and (not G-IPT) G-LST-IPTS G-TB-IPT)
(setq G-IPT (list (+ (* G-DWG-SCALE (caar G-LST-IPTS)) (car G-TB-IPT))
(+ (* G-DWG-SCALE (cadar G-LST-IPTS)) (cadr G-TB-IPT))
0.0
)
G-IPT-L (list (+ (* G-DWG-SCALE (caadr G-LST-IPTS)) (car G-TB-IPT))
(+ (* G-DWG-SCALE (cadadr G-LST-IPTS)) (cadr G-TB-IPT))
0.0
)
)
)
(if (not G-IPT)
(setq G-IPT (list 0.0 0.0))
)
(setq G-IPT-START G-IPT)
;;; process element codes...
(if G-STEN
(if
(not (ssget "x" (list '(0 . "INSERT") (cons 410 (getvar "ctab")) '(2 . "CP_kslock-ec*"))))
(CPF-EC G-MODE)
)
)
;;; end of process element codes.
(CPF-LAYER "TITLE" "E" "MC")
(if (member (car G_FILE-ID) '("SHT" "SET"))
(setq G_SQUEEZE-FACTOR (CPKS-DO-SQUEEZE (nth 1 G-IPT) (nth 1 G-IPT-L) G-DWG-SCALE))
(setq G_SQUEEZE-FACTOR 1.0)
)
(if G-REV
(CPKS-DO-REV-INSERTS)
)
;;; process symbols...
(if (and G-IPT G_LST-SYM)
(foreach G-I (list "PNT" "MAT" "HDW" "ELC" "ALM" "STL" "FAB")
(setq G-LST NIL)
(mapcar (function (lambda (X)
(if (equal (substr X 1 1) (substr G-I 1 1))
(if (equal (substr G-I 1 1) "F")
(setq G-LST
(vl-sort (append G-LST (list X))
(function
(lambda (I1 I2) (< (atoi (substr I1 3)) (atoi (substr I2 3))))
)
)
)
(setq G-LST
(vl-sort (append G-LST (list X))
(function
(lambda (I1 I2) (< (atoi (substr I1 2)) (atoi (substr I2 2))))
)
)
)
)
)
)
)
G_LST-SYM
)
(if G-LST
;Expanded function to determine which keynote block version to be used (DF 03-24-20)
(progn
(setq G-TITLE-ON NIL
G-ATTR-DSC NIL
G-ATTR-QTY NIL
G-ATTR-MFN NIL
G-SPEC-FILE NIL
)
(cond ((equal G-I "PNT")
(cond
((= G-TB-NEW nil)
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER
G-WD-DSC 2.25
G-WD-MFN 1.0
G-BLK-HEADER "CP_kspnt-m"
G-BLK-HEADERX "CP_kspnt-mx"
G-BLK-TILE "CP_kspnt-t"
G-SPEC-FILE G_SPEC-PNT
)
)
((= G-TB-NEW t)
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER
G-WD-DSC 2.0
G-WD-MFN 1.0
G-BLK-HEADER "CP_kspnt-m_v2"
G-BLK-HEADERX "CP_kspnt-mx_v2"
G-BLK-TILE "CP_kspnt-t_v2"
G-SPEC-FILE G_SPEC-PNT
)
)
)
)
((equal G-I "MAT")
(cond
((= G-TB-NEW nil)
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER
G-WD-DSC 2.25
G-WD-MFN 1.0
G-BLK-HEADER "CP_ksmat-m"
G-BLK-HEADERX "CP_ksmat-mx"
G-BLK-TILE "CP_ksmat-t"
G-SPEC-FILE G_SPEC-MAT
)
)
((= G-TB-NEW t)
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER
G-WD-DSC 2.125
G-WD-MFN 1.0
G-BLK-HEADER "CP_ksmat-m_v2"
G-BLK-HEADERX "CP_ksmat-mx_v2"
G-BLK-TILE "CP_ksmat-t_v2"
G-SPEC-FILE G_SPEC-MAT
)
)
)
)
((equal G-I "HDW")
(cond
((= G-TB-NEW nil)
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER
G-WD-DSC 2.25
G-WD-MFN 1.0
G-BLK-HEADER "CP_kshdw-m"
G-BLK-HEADERX "CP_kshdw-mx"
G-BLK-TILE "CP_kshdw-t"
G-SPEC-FILE G_SPEC-HDW
)
)
((= G-TB-NEW t)
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER
G-WD-DSC 2.125
G-WD-MFN 1.0
G-BLK-HEADER "CP_kshdw-m_v2"
G-BLK-HEADERX "CP_kshdw-mx_v2"
G-BLK-TILE "CP_kshdw-t_v2"
G-SPEC-FILE G_SPEC-HDW
)
)
)
)
((equal G-I "ELC")
(cond
((= G-TB-NEW nil)
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER
G-WD-DSC 2.25
G-WD-MFN 1.0
G-BLK-HEADER "CP_kselc-m"
G-BLK-HEADERX "CP_kselc-mx"
G-BLK-TILE "CP_kselc-t"
G-SPEC-FILE G_SPEC-ELC
)
)
((= G-TB-NEW t)
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER
G-WD-DSC 2.125
G-WD-MFN 1.0
G-BLK-HEADER "CP_kselc-m_v2"
G-BLK-HEADERX "CP_kselc-mx_v2"
G-BLK-TILE "CP_kselc-t_v2"
G-SPEC-FILE G_SPEC-ELC
)
)
)
)
((equal G-I "ALM")
(cond
((= G-TB-NEW nil)
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER
G-WD-DSC 3.25
G-BLK-HEADER "CP_ksmet-m"
G-BLK-HEADERX "CP_ksmet-mx"
G-BLK-TILE "CP_ksmet-t"
G-SPEC-FILE G_SPEC-ALM
G-TITLE-MET t
)
)
((= G-TB-NEW t)
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER
G-WD-DSC 3.125
G-BLK-HEADER "CP_ksmet-m_v2"
G-BLK-HEADERX "CP_ksmet-mx_v2"
G-BLK-TILE "CP_ksmet-t_v2"
G-SPEC-FILE G_SPEC-ALM
G-TITLE-MET t
)
)
)
)
((equal G-I "STL")
(cond
((= G-TB-NEW nil)
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER
G-WD-DSC 3.25
G-BLK-HEADER "CP_ksmet-m"
G-BLK-HEADERX "CP_ksmet-mx"
G-BLK-TILE "CP_ksmet-t"
G-SPEC-FILE G_SPEC-STL
)
(if G-TITLE-MET
(setq G-TITLE-ON t)
)
)
((= G-TB-NEW t)
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER
G-WD-DSC 3.125
G-BLK-HEADER "CP_ksmet-m_v2"
G-BLK-HEADERX "CP_ksmet-mx_v2"
G-BLK-TILE "CP_ksmet-t_v2"
G-SPEC-FILE G_SPEC-STL
)
(if G-TITLE-MET
(setq G-TITLE-ON t)
)
)
)
)
((equal G-I "FAB")
(cond
((= G-TB-NEW nil)
(cond (G-FABT
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER 0.775
G-WD-DSC 2.875
G-WD-MFN 0.5
G-BLK-HEADER "CP_ksftl-m"
G-BLK-HEADERX "CP_ksftl-m"
G-BLK-TILE "CP_ksftl-t"
G-SPEC-FILE G_SPEC-FAB
G-FAB-TOTAL t
)
(if (equal (car G_FILE-ID) "FAB")
(setq G-LST (list (strcat "F-" (nth 1 G_FILE-ID))))
(setq G-LST NIL)
)
)
(t
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER-FAB
G-WD-DSC 2.25
G-WD-MFN 0.5
G-BLK-HEADER "CP_ksfab-m"
G-BLK-HEADERX "CP_ksfab-mx"
G-BLK-TILE "CP_ksfab-t"
G-SPEC-FILE G_SPEC-FAB
)
)
)
)
((= G-TB-NEW t)
(cond (G-FABT
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER 0.775
G-WD-DSC 2.75
G-WD-MFN 0.5
G-BLK-HEADER "CP_ksftl-m_v2"
G-BLK-HEADERX "CP_ksftl-m_v2"
G-BLK-TILE "CP_ksftl-t_v2"
G-SPEC-FILE G_SPEC-FAB
G-FAB-TOTAL t
)
(if (equal (car G_FILE-ID) "FAB")
(setq G-LST (list (strcat "F-" (nth 1 G_FILE-ID))))
(setq G-LST NIL)
)
)
(t
(setq G-HT-TILE G-KSBLK-HT-TILE
G-HT-HEADER G-KSBLK-HT-HEADER-FAB
G-WD-DSC 2.125
G-WD-MFN 0.5
G-BLK-HEADER "CP_ksfab-m_v2"
G-BLK-HEADERX "CP_ksfab-mx_v2"
G-BLK-TILE "CP_ksfab-t_v2"
G-SPEC-FILE G_SPEC-FAB
)
)
)
)
)
)
)
(if (not (tblsearch "BLOCK" G-BLK-HEADER))
(if (not (findfile (strcat G-BLK-HEADER ".dwg")))
(progn
(terpri)
(CPF-BLINK (strcat "**** UNABLE TO FIND " G-BLK-HEADER ".dwg BLOCK! ****") 3)
(setq G-BLK-HEADER NIL)
)
(setq G-BLK-HEADER (strcat G-BLK-HEADER ".dwg"))
)
)
(if (not (tblsearch "BLOCK" G-BLK-HEADERX))
(if (not (findfile (strcat G-BLK-HEADERX ".dwg")))
(progn
(terpri)
(CPF-BLINK (strcat "**** UNABLE TO FIND " G-BLK-HEADERX ".dwg BLOCK! ****") 3)
(setq G-BLK-HEADERX NIL)
)
(setq G-BLK-HEADERX (strcat G-BLK-HEADERX ".dwg"))
)
)
(if (not (tblsearch "BLOCK" G-BLK-TILE))
(if (not (findfile (strcat G-BLK-TILE ".dwg")))
(progn (terpri)
(CPF-BLINK (strcat "**** UNABLE TO FIND " G-BLK-TILE ".dwg BLOCK! ****") 3)
(setq G-BLK-TILE NIL)
)
(setq G-BLK-TILE (strcat G-BLK-TILE ".dwg"))
)
)
(if (not G-SPEC-FILE)
(setq G-SPEC-FILE (CPF-SPEC-FILE G-I (last G-LST)))
)
(if (and G-BLK-HEADER G-BLK-HEADERX G-BLK-TILE G-SPEC-FILE)
(progn
(foreach G-SYM G-LST
(if (setq G-ASSO (assoc G-SYM G-SPEC-FILE))
(progn
(setq G-ATTR-DSC (last G-ASSO))
(cond
((equal G-I "PNT")
(setq G-ATTR-SYM (substr G-SYM 2)
G-ATTR-MFN (nth 3 G-ASSO)
)
)
((member G-I '("MAT" "ELC"))
(setq G-ATTR-SYM (substr G-SYM 2)
G-ATTR-MFG (nth 2 G-ASSO)
G-ATTR-MFN (nth 3 G-ASSO)
)
(if (> (strlen G-ATTR-MFG) 0)
(setq G-ATTR-DSC (strcat G-ATTR-MFG " " G-ATTR-DSC))
)
)
((member G-I '("ALM" "STL"))
(setq G-ATTR-SYM (strcat (substr G-SYM 1 1) " " (substr G-SYM 2)))
)
((equal G-I "HDW")
(setq G-ATTR-SYM (substr G-SYM 2)
G-ATTR-MFG (nth 3 G-ASSO)
G-ATTR-MFN (nth 1 G-ASSO)
)
(if (> (strlen G-ATTR-MFG) 0)
(setq G-ATTR-DSC (strcat G-ATTR-MFG " " G-ATTR-DSC))
)
)
((equal G-I "FAB")
(setq G-ATTR-SYM G-SYM
G-ATTR-MFN (nth 3 G-ASSO)
G-ATTR-QTY NIL
G-LST-QTY NIL
G-FAB-CNT NIL
)
(cond
(G-FAB-TOTAL
(cond ((/= (setq G-FAB-CNT (nth 2 G-ASSO)) "")
(setq G-LST-UNIT (CPF-GET-SUMS G-SYM G_INDX))
(foreach G-SER (CPF-STR2LST G-FAB-CNT "," NIL)
(setq
G-LST-QTY (vl-sort
(append G-LST-QTY
(list (CPF-STR2LST G-SER "-" NIL))
)
(function (lambda (I1 I2)
(< (atoi (car I1)) (atoi (car I2)))
)
)
)
)
)
(foreach G-X G-LST-QTY
(setq G-ENTRY NIL)
(setq G-SER (car G-X))
(setq G-FEQTY (cadr G-X))
(setq G-FUQTY (cadr (assoc G-SER G-LST-UNIT)))
(if G-FEQTY
(if G-FUQTY
(setq G-ENTRY (list (list G-SER
G-FEQTY
G-FUQTY
(* (atoi G-FEQTY) (atoi G-FUQTY))
)
)
)
(setq G-ENTRY (list (list G-SER G-FEQTY "" "")))
)
)
(if G-ENTRY
(setq G-LST-FABS (append G-LST-FABS G-ENTRY))
)
)
)
(t (CPF-BLINK (strcat " **** MISSING QUANTITIES! ****") 3))
)
)
(t
(cond
((= (setq G-FAB-CNT (nth 2 G-ASSO)) "") (setq G-ATTR-QTY NIL))
(t
(if (= (nth 2 G-ASSO) "EXIST.")
(setq G-ATTR-QTY "EXIST.")
(progn (foreach G-SER (CPF-STR2LST G-FAB-CNT "," NIL)
(setq G-LST-QTY (append G-LST-QTY
(list (CPF-STR2LST G-SER "-" NIL))
)
)
)
(foreach G-SER G-LST-QTY
(if (equal G_CSER (car G-SER))
(setq G-ATTR-QTY (cadr G-SER))
)
)
)
)
)
)
(cond
((and (not G-ATTR-QTY) G_CSER)
(prompt "\n")
(setq G-ATTR-QTY ""
G_ATTR-MISS t
)
(if (not G_MISSING-INFO)
(CPF-BLINK (strcat " **** " G-SYM " - MISSING QUANTITY! ****")
3
)
)
)
((not G-ATTR-QTY) (setq G-ATTR-QTY ""))
)
)
)
(cond ((assoc G-SYM G_LST-PARTS)
(setq G-ATTR-SYM (cdr (assoc G-SYM G_LST-PARTS)))
)
(t (setq G-ATTR-SYM G-SYM))
)
)
)
(if (or (and G-ATTR-DSC
(> (CPF-TXT-LENGTH G-ATTR-DSC "KEYNOTE" 0.095 0.75) G-WD-DSC)
)
(and G-ATTR-MFN
(> (CPF-TXT-LENGTH G-ATTR-MFN "KEYNOTE" 0.095 0.75) G-WD-MFN)
)
)
(setq G-BLK-MASTERI G-BLK-HEADERX)
(setq G-BLK-MASTERI G-BLK-HEADER)
)
)
(progn
(cond ((member G-I '("HDW" "PNT")) (setq G-ATTR-SYM (substr G-SYM 2)))
((member G-I '("MAT" "ELC")) (setq G-ATTR-SYM (substr G-SYM 2)))
((member G-I '("ALM" "STL"))
(setq G-ATTR-SYM (strcat (substr G-SYM 1 1) " " (substr G-SYM 2)))
)
((equal G-I "HDW") (setq G-ATTR-SYM (substr G-SYM 2)))
((equal G-I "FAB")
(cond ((assoc G-SYM G_LST-PARTS)
(setq G-ATTR-SYM (cdr (assoc G-SYM G_LST-PARTS)))
)
(t (setq G-ATTR-SYM G-SYM))
)
)
)
(setq G-BLK-MASTERI G-BLK-HEADER
G-ATTR-DSC ""
G-ATTR-MFN ""
G-ATTR-QTY ""
G_ATTR-MISS t
)
(prompt "\n")
(if (not G_MISSING-INFO)
(CPF-BLINK (strcat "**** " G-SYM " - NOT SPECIFIED! ****") 3)
)
)
)
(if (not G-TITLE-ON)
(cond (G-FAB-TOTAL
(vl-cmdf "._-insert"
G-BLK-TILE
G-IPT
"x"
(* G-DWG-SCALE G-INS-SCALE G_TB-SCF)
(* G-DWG-SCALE G-INS-SCALE G_SQUEEZE-FACTOR)
(* G-DWG-SCALE G-INS-SCALE)
"0.0"
G-ATTR-SYM
G-ATTR-MFN
G-ATTR-DSC
)
(setq G-IPT (list (car G-IPT)
(- (cadr G-IPT)
(* G-DWG-SCALE G-INS-SCALE G-HT-HEADER G_SQUEEZE-FACTOR)
)
0.0
)
G-TITLE-ON t
)
)
(t
(vl-cmdf "._-insert"
G-BLK-TILE
G-IPT
"x"
(* G-DWG-SCALE G-INS-SCALE G_TB-SCF)
(* G-DWG-SCALE G-INS-SCALE G_SQUEEZE-FACTOR)
(* G-DWG-SCALE G-INS-SCALE)
"0.0"
)
(setq G-IPT (list (car G-IPT)
(- (cadr G-IPT)
(* G-DWG-SCALE G-INS-SCALE G-HT-HEADER G_SQUEEZE-FACTOR)
)
0.0
)
G-TITLE-ON t
)
)
)
)
(cond ((member G-I '("PNT" "MAT" "HDW" "ELC"))
(vl-cmdf "._-insert"
G-BLK-MASTERI
G-IPT
"x"
(* G-DWG-SCALE G-INS-SCALE G_TB-SCF)
(* G-DWG-SCALE G-INS-SCALE G_SQUEEZE-FACTOR)
(* G-DWG-SCALE G-INS-SCALE)
"0.0"
G-ATTR-SYM
G-ATTR-MFN
G-ATTR-DSC
)
)
((member G-I '("ALM" "STL"))
(vl-cmdf "._-insert"
G-BLK-MASTERI
G-IPT
"x"
(* G-DWG-SCALE G-INS-SCALE G_TB-SCF)
(* G-DWG-SCALE G-INS-SCALE G_SQUEEZE-FACTOR)
(* G-DWG-SCALE G-INS-SCALE)
"0.0"
G-ATTR-SYM
G-ATTR-DSC
)
)
((= G-I "FAB")
(cond (G-FAB-TOTAL
(foreach G-S G-LST-FABS
(vl-cmdf "._-insert"
G-BLK-MASTERI
G-IPT
"x"
(* G-DWG-SCALE G-INS-SCALE G_TB-SCF)
(* G-DWG-SCALE G-INS-SCALE G_SQUEEZE-FACTOR)
(* G-DWG-SCALE G-INS-SCALE)
"0.0"
(nth 0 G-S)
(nth 1 G-S)
(nth 2 G-S)
(nth 3 G-S)
)
(setq G-IPT
(list (car G-IPT)
(- (cadr G-IPT)
(* G-DWG-SCALE G-INS-SCALE G-HT-TILE G_SQUEEZE-FACTOR)
)
0.0
)
)
)
)
(t
(vl-cmdf "._-insert"
G-BLK-MASTERI
G-IPT
"x"
(* G-DWG-SCALE G-INS-SCALE G_TB-SCF)
(* G-DWG-SCALE G-INS-SCALE G_SQUEEZE-FACTOR)
(* G-DWG-SCALE G-INS-SCALE)
"0.0"
G-ATTR-SYM
G-ATTR-QTY
G-ATTR-MFN
G-ATTR-DSC
)
)
)
)
)
(setq G-IPT (list (car G-IPT)
(- (cadr G-IPT)
(* G-DWG-SCALE G-INS-SCALE G-HT-TILE G_SQUEEZE-FACTOR)
)
0.0
)
)
)
)
(if (not G-SPEC-FILE)
(progn (prompt "\n")
(CPF-BLINK (strcat " **** MISSING ." G-I " FILE! ****") 3)
)
)
)
)
)
)
)
(if (and G-IPT G_ATTR-MISS (setq G-BLK-MASTERI (findfile "CP_ksmiss.dwg")))
(progn (if (tblsearch "BLOCK" "CP_ksmiss")
(setq G-BLK-MASTERI "CP_ksmiss")
)
(vl-cmdf "._-insert"
G-BLK-MASTERI
G-IPT
(* G-DWG-SCALE G-INS-SCALE)
(* G-DWG-SCALE G-INS-SCALE (- 1 (/ (- 1 G_SQUEEZE-FACTOR) 2)))
"0.0"
)
(setq G_MISSING-INFO t)
)
)
(CPKS-MOVE-IF)
(vl-cmdf "._UCS" "Prev")
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-GET-SEM ;
;;; Description: This function returns a list of PROGRAM.SEM file ;
;;; containing information about which sheet series ;
;;; belongs to each project number. ;
;;;--------------------------------------------------------------------;
(defun CPKS-GET-SEM (/ G-FILE-NM G-FILE-ID G-LST G-I G-LST-SEM)
(if (and (caddr G_PATH) (cadr G_PATH))
(cond
((setq G-FILE-NM (findfile (strcat (caddr G_PATH) "\\" (cadr G_PATH) ".sem")))
(setq G-FILE-ID (open G-FILE-NM "r"))
(while (setq G-I (read-line G-FILE-ID))
(setq G-LST (CPF-STR2LST G-I "|" NIL))
(cond ((cadr G-LST)
(setq
G-LST-SEM (append G-LST-SEM
(list (list (car G-LST) (CPF-STR2LST (cadr G-LST) "," NIL)))
)
)
)
(t (setq G-LST-SEM (append G-LST-SEM (list (list (car G-LST))))))
)
)
(close G-FILE-ID)
)
)
)
G-LST-SEM
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-DO-REV-INSERTS ;
;;; Description: This function handles insertion of Revision schedules;
;;; in title block. ;
;;;--------------------------------------------------------------------;
(defun CPKS-DO-REV-INSERTS (/ G-ATTR-DATE G-ATTR-BY)
(setq G-LST NIL)
(mapcar (function (lambda (X)
(if (equal (substr X 1 1) "R")
(setq G-LST (vl-sort (append G-LST (list X)) '<))
)
)
)
G_LST-SYM
)
(if G-LST
(progn
(setq G-TITLE-ON NIL
G-ATTR-DSC NIL
G-ATTR-DATE NIL
G-ATTR-BY NIL
G-SPEC-FILE NIL
G-HT-TILE G-REVBLK-HT-TILE
G-HT-HEADER G-REVBLK-HT-HEADER
G-WD-DSC 2.375
G-WD-BY 0.5
G-SPEC-FILE G_SPEC-REV
)
(if (= G-TB-VER "G")
(setq G-BLK-HEADER "CP_ksrev-m_v2"
G-BLK-HEADERX "CP_ksrev-mx_v2"
G-BLK-TILE "CP_ksrev-t2_v2")
(setq G-BLK-HEADER "CP_ksrev-m"
G-BLK-HEADERX "CP_ksrev-mx"
G-BLK-TILE "CP_ksrev-t2")
)
(if (and (setq
G-SS (ssget "x"
(list '(0 . "INSERT") '(2 . "CP_ksstn-t*") (cons 410 (getvar "ctab")))
)
)
(> (sslength G-SS) 0)
)
(setq G-IPT-L (cdr (assoc 10 (entget (ssname G-SS 0)))))
)
(if (not (tblsearch "BLOCK" G-BLK-HEADER))
(if (not (findfile (strcat G-BLK-HEADER ".dwg")))
(progn (terpri)
(CPF-BLINK (strcat "**** UNABLE TO FIND " G-BLK-HEADER ".dwg BLOCK! ****") 3)
(setq G-BLK-HEADER NIL)
)
(setq G-BLK-HEADER (strcat G-BLK-HEADER ".dwg"))
)
)
(if (not (tblsearch "BLOCK" G-BLK-HEADERX))
(if (not (findfile (strcat G-BLK-HEADERX ".dwg")))
(progn (terpri)
(CPF-BLINK (strcat "**** UNABLE TO FIND " G-BLK-HEADERX ".dwg BLOCK! ****") 3)
(setq G-BLK-HEADERX NIL)
)
(setq G-BLK-HEADERX (strcat G-BLK-HEADERX ".dwg"))
)
)
(if (not (tblsearch "BLOCK" G-BLK-TILE))
(if (not (findfile (strcat G-BLK-TILE ".dwg")))
(progn (terpri)
(CPF-BLINK (strcat "**** UNABLE TO FIND " G-BLK-TILE ".dwg BLOCK! ****") 3)
(setq G-BLK-TILE NIL)
)
(setq G-BLK-TILE (strcat G-BLK-TILE ".dwg"))
)
)
(if (not G-SPEC-FILE)
(setq G-SPEC-FILE (CPF-SPEC-FILE "REV" NIL))
)
(if (and G-BLK-HEADER G-BLK-HEADERX G-BLK-TILE G-SPEC-FILE)
(foreach G-SYM G-LST
(if (setq G-ASSO (assoc (substr G-SYM 2) G-SPEC-FILE))
(progn
(setq G-ATTR-DSC (last G-ASSO)
G-ATTR-SYM (substr G-SYM 2)
G-ATTR-DATE (nth 2 G-ASSO)
G-ATTR-BY (nth 3 G-ASSO)
)
(if
(or
(and
G-ATTR-DSC
(> (caadr
(textbox
(list (cons 1 G-ATTR-DSC) '(40 . 0.095) '(41 . 0.75) '(7 . "KEYNOTE"))
)
)
G-WD-DSC
)
)
(and
G-ATTR-BY
(> (caadr
(textbox
(list (cons 1 G-ATTR-BY) '(40 . 0.095) '(41 . 0.75) '(7 . "KEYNOTE"))
)
)
G-WD-BY
)
)
)
(setq G-BLK-HEADER G-BLK-HEADERX)
(setq G-BLK-HEADER G-BLK-HEADER)
)
)
(progn (setq G-ATTR-SYM (substr G-SYM 2)
G-ATTR-DSC ""
G-ATTR-BY ""
G-ATTR-DATE ""
G_ATTR-MISS t
)
(prompt "\n")
(if (not G_MISSING-INFO)
(CPF-BLINK (strcat "**** " G-SYM " - NOT SPECIFIED! ****") 3)
)
)
)
(if (not G-TITLE-ON)
(progn (vl-cmdf "._-insert"
G-BLK-TILE
G-IPT-L
"x"
(* G-DWG-SCALE G-INS-SCALE G_TB-SCF)
(* G-DWG-SCALE G-INS-SCALE)
(* G-DWG-SCALE G-INS-SCALE)
"0.0"
)
(setq G-IPT-L (list (car G-IPT-L)
(+ (cadr G-IPT-L) (* G-DWG-SCALE G-INS-SCALE G-HT-HEADER))
0.0
)
G-TITLE-ON t
)
)
)
(vl-cmdf "._-insert"
G-BLK-HEADER
G-IPT-L
"x"
(* G-DWG-SCALE G-INS-SCALE G_TB-SCF)
(* G-DWG-SCALE G-INS-SCALE G_SQUEEZE-FACTOR)
(* G-DWG-SCALE G-INS-SCALE)
"0.0"
G-ATTR-SYM
G-ATTR-DSC
G-ATTR-BY
G-ATTR-DATE
)
(setq G-IPT-L
(list
(car G-IPT-L)
(+ (cadr G-IPT-L) (* G-DWG-SCALE G-INS-SCALE G-HT-TILE G_SQUEEZE-FACTOR))
0.0
)
)
)
(if (not G-SPEC-FILE)
(progn (prompt "\n") (CPF-BLINK (strcat " **** MISSING .REV FILE! ****") 3))
)
)
;;; (if G_IPT-L
;;; (if (< (nth 1 G-IPT-L) (nth 1 G_IPT-L))
;;; (setq G_IPT-L G-IPT-L)
;;; )
;;; (setq G_IPT-L G-IPT-L)
;;; )
)
(if (and (setq
G-SS (ssget "x"
(list '(0 . "INSERT") '(2 . "CP_ksstn-t*") (cons 410 (getvar "ctab")))
)
)
(> (sslength G-SS) 0)
)
(setq G-IPT-L (cdr (assoc 10 (entget (ssname G-SS 0)))))
)
)
;;; (if G_IPT-L
;;; (setq G-IPT-L G_IPT-L)
;;; )
(princ)
)
(defun CPKS-DO-REV-SORT (G-VAL)
(if G-VAL
(atof (strcat (itoa (length (vl-string->list G-VAL)))
"."
(itoa (- (last (vl-string->list G-VAL)) 65))
)
)
0
)
)
;;;--------------------------------------------------------------------;
;;; Subfunction: CPKS-MOVE-IF ;
;;; Description: This function moves Stenciling and Revision Schedules;
;;; if Parent Sheet has 85x11 title block. ;
;;;--------------------------------------------------------------------;
(defun CPKS-MOVE-IF (/ G-SS G-SS-TMP G-EN G-ED G-BN G-IP G-REV-IPT G-STE-IPT G-IPT0)
(if (and (equal G-TB-NM "85X11")
(equal (car G_FILE-ID) "SHT")
(setq G-SS (ssget "_x"
(list
'(0 . "INSERT")
'(-4 . "<or")
'(2 . "CP_ksrev-t*,CP_ksrev-m*,CP_ksrev-mx*")
'(2 . "CP_ksste-t*,CP_ksste-m*,CP_ksste-b*")
'(-4 . "or>")
)
)
)
(> (sslength G-SS) 0)
)
(progn (setq G-CNT 0)
(while (> (sslength G-SS) G-CNT)
(setq G-EN (ssname G-SS G-CNT)
G-ED (entget G-EN)
G-BN (cdr (assoc 2 G-ED))
G-IP (cdr (assoc 10 G-ED))
G-CNT (1+ G-CNT)
)
(cond ((member G-BN '("CP_ksrev-m" "CP_ksrev-mx"))
(if (> (cadr G-IP) (cadr G-REV-IPT))
(setq G-REV-IPT (list (car G-IP) (+ (cadr G-IP) (* 0.25 G-DWG-SCALE)) 0.0))
)
)
((= G-BN "CP_ksste-t") (setq G-STE-IPT G-IP))
)
)
(if G-REV-IPT
(setq G-IPT0 G-REV-IPT)
(if G-STE-IPT
(setq G-IPT0 G-STE-IPT)
)
)
(if (and G-IPT0 G-IPT)
(vl-cmdf "._move" G-SS "" G-IPT0 G-IPT)
)
)
)
)
(defun CPKS-SURVEY (/ G-E G-ED G-SSLG G-SSCNT)
(setq G-SSCNT 0
G-SSLG (sslength G-SS)
)
(while (> G-SSLG G-SSCNT)
(setq G-E (ssname G-SS G-SSCNT)
G-ED (entget G-E)
G-EIPT (list (nth 1 (assoc 10 G-ED)) (nth 2 (assoc 10 G-ED)))
G-SSCNT (1+ G-SSCNT)
)
(if (not G_SURVEYSC)
(setq G_SURVEYSC (cdr (assoc 41 G-ED)))
)
(if (not G_SURVEYIPT)
(setq G_SURVEYIPT G-EIPT)
(if (> (cadr G-EIPT) (cadr G_SURVEYIPT))
(setq G_SURVEYIPT G-EIPT)
)
)
)
)
