Not original but it decribs the situation!
When I run the attached lisp file I get this message
Command:
Command:
Command: recd
pspace
Already in paper space.
Command: zoom
Specify corner of window, enter a scale factor (nX or nXP), or
[All/Center/Dynamic/Extents/Previous/Scale/Window/Object] <real time>: extents
Command: bad argument type: lselsetp nil
Command:
Command: *Cancel*
Now remember I my lisp skiils are next to nil hence needing help to understand this message.
; Lisp routine to insert a record drawing stamp into an existing A0 or A1 title block,
; clean out any revision note tags and clouding, change to paperspace and zoom to extents
(defun c:recd ()
;obtain original drawing settings
(setq
c_blp (getvar "BLIPMODE")
c_col (getvar "CECOLOR")
c_lay (getvar "CLAYER")
c_cmd (getvar "CMDECHO")
c_til (getvar "TILEMODE")
c_osm (getvar "OSMODE")
c_dimzin (getvar "DIMZIN")
c_qaf (getvar "QAFLAGS")
c_textstyle (getvar "TEXTSTYLE")
c_attdia (getvar "ATTDIA")
c_ctab (getvar "CTAB")
)
(LAYLIST)
;find all paperspace layouts
(setq layoutlist (dictsearch (namedobjdict) "ACAD_LAYOUT"))
(setq index 1)
(setq layouts nil)
(while (<= index (length layoutlist))
(setq elist (nth (1- index) layoutlist))
(if (= (car elist) 3) (setq lays (append lays (list(cdr elist)))))
(setq index (+ index 1)
)
)
(setq lays (cdr (reverse lays)))
(setq counter 1)
(while (<= counter (length lays))
;set drawing to zoom extents in paperspace
(setvar "TILEMODE" 0)
(setvar "CTAB" (nth (1- counter) lays))
(command "pspace")
(command "zoom" "extents")
;set required drawing variables
(setvar "BLIPMODE" 0); Set blipmode off
(setvar "CECOLOR" "bylayer"); Set current entity colour to bylayer
(setvar "CMDECHO" 0); Set command line echo to off
(setvar "DIMZIN" 0)
(setvar "QAFLAGS" 2)
(setvar "OSMODE" 0)
; Find if layer "A0RECORD" already exists in drawing. If yes set to current. If no create and set to current.
(if (tblsearch "layer" "A0RECORD") (command "-layer" "thaw" "A0RECORD" "on" "A0RECORD" "s" "A0RECORD" "") (command "-layer" "m" "A0RECORD" "c" "2" "" ""))
; Create text style "rec_dwg_stamp"
(command "-style" "rec_dwg_stamp" "ISOCP" "5" "1" "0" "No" "No")
;find all drawing sheet block insertions
(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 "*_HUNTERS") (cons 410 (nth (1- counter) lays)))))
;set drawing sheet offsets
(setq A0 (list 1115 180 0)
A1 (list 785 200 0)
A2 (list 538 180 0)
A3 (list 364 180 0)
)
;determine drawing sheet size and set offset insertion co-ordinates for record drawing stamp
(if (/= (sslength ss) 1) quit)
(cond ((= (cdr (assoc 2 (entget (ssname ss 0)))) "A0_sht") (setq r_off A0))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "A0_SHT") (setq r_off A0))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "A0_Sht") (setq r_off A0))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "a0_Sht") (setq r_off A0))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "a0_sht") (setq r_off A0))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "a0_SHT") (setq r_off A0))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "WORC_A0_SHT") (setq r_off A0))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "A0_Hunters") (setq r_off A0))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "A1_sht") (setq r_off A1))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "A1_SHT") (setq r_off A1))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "A1_Sht") (setq r_off A1))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "a1_SHT") (setq r_off A1))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "a1_sht") (setq r_off A1))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "a1_Sht") (setq r_off A1))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "WORC_A1_SHT") (setq r_off A1))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "A1_Hunters") (setq r_off A1))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "A2_sht") (setq r_off A2))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "A3_sht") (setq r_off A3))
((= (cdr (assoc 2 (entget (ssname ss 0)))) "A3_Hunters") (setq r_off A3))
((= (sslength ss) 1) (print "Not a Hunters Standard Titleblock"))
)
;retrieve insertion co-ordinates of titleblock to variable tb_ins
(setq tb_ins (cdr (assoc 10 (entget (ssname ss 0)))))
;create new co-ordinates for record stamp insertion
(setq r_off1 (list (+ (car r_off) (car tb_ins) -65) (+ (cadr r_off) (cadr tb_ins) -15) (+ (caddr r_off) (caddr tb_ins) 0))
r_off2 (list (+ (car r_off) (car tb_ins) 45) (+ (cadr r_off) (cadr tb_ins) 20) (+ (caddr r_off) (caddr tb_ins) 0))
r_off1a (strcat (rtos (car r_off1)) "," (rtos (cadr r_off1)) "," (rtos (caddr r_off1)))
r_off2a (strcat (rtos (car r_off2)) "," (rtos (cadr r_off2)))
)
; insert mtext record drawing stamp
(command "-mtext" r_off1a "j" "tl" r_off2a "THE INFORMATION CONTAINED
WITHIN THIS AS BUILT DRAWING
HAS BEEN CONFIRMED BY THE
MAIN CONTRACTOR 'MOWLEM' AS
BEING AN ACCURATE RECORD
" "RECORD" "DRAWING" "")
;create a list of all revision clouds contained on paperspace if they exist
(setq pl_list (ssget "X" (list (cons 0 "LWPOLYLINE") (cons 410 (nth (1- counter) lays)))))
(setq count 1)
(setq cloud_list nil)
(if (/= pl_list nil) (while (<= count (sslength pl_list))
(setq elist (ssname pl_list (1- count)))
(if (> (length (entget elist)) 60) (setq cloud_list (append cloud_list (list(cdr (assoc -1 (entget elist)))))))
(setq count (+ count 1))
)
)
(setq count 1)
(if (/= (length cloud_list) 0)
(while (<= count (length cloud_list))
(entdel (nth (1- count) cloud_list)) ;erase revision clouds contained in cloud_list
(setq count (+ count 1))
)
(print "No revision clouds found!")
)
;find all revision tag block insertions
(setq rev_list (ssget "X" (list (cons 0 "INSERT") (cons 2 "revision_tag") (cons 410 (nth (1- counter) lays)))))
(if (= rev_list nil) (setq rev_list (ssget "X" (list (cons 0 "INSERT") (cons 2 "revision_tag") (cons 410 (nth (1- counter) lays))))))
;erase revision tags
(setq count 1)
(if (/= (length rev_list) 0)
(while (<= count (sslength rev_list))
(setq elist (ssname rev_list (1- count)))
(entdel (cdr (assoc -1 (entget elist))))
(setq count (+ count 1))
) (print "No revision tags found!")
)
; Find if layer "A0TEXT-NOTE" already exists in drawing. If yes set to current. If no create and set to current.
(if (tblsearch "layer" "A0TEXT-NOTE") (command "-layer" "thaw" "A0TEXT-NOTE" "on" "A0TEXT-NOTE" "s" "A0TEXT-NOTE" "") (command "-layer" "m" "A0TEXT-NOTE" "c" "2" "" ""))
;find last revision note block insertion and attribute data
(setq rev_note (entget (ssname (ssget "X" (list (cons 0 "INSERT") (cons 2 "rev_note") (cons 410 (nth (1- counter) lays)))) 0)))
(if (= rev_note nil) (setq rev_note (entget (ssname (ssget "X" (list (cons 0 "INSERT") (cons 2 "REV_NOTE"))) 0))))
(setq att_list (entget (entnext (cdr (assoc -1 rev_note)))))
(while (= (cdr (assoc '0 att_list)) "ATTRIB") (cond ((= (cdr (assoc 2 att_list)) "DATE") (setq att_date (cdr (assoc 1 att_list))))
((= (cdr (assoc 2 att_list)) "LETTER") (setq att_letter (cdr (assoc 1 att_list))))
((= (cdr (assoc 2 att_list)) "INITIALS") (setq att_init (cdr (assoc 1 att_list))))
((= (cdr (assoc 2 att_list)) "LINE-1") (setq att_line1 (cdr (assoc 1 att_list))))
((= (cdr (assoc 2 att_list)) "LINE-2") (setq att_line2 (cdr (assoc 1 att_list))))
((= (cdr (assoc 2 att_list)) "LINE-3") (setq att_line3 (cdr (assoc 1 att_list))))
)
(setq att_list (entget (entnext (cdr (assoc -1 att_list)))))
)
(setq rev_ins (cdr (assoc 10 rev_note)))
;create new revision note 3.5mm down from last entry of last revision note
(cond ((/= att_line3 "") (setq ins_y -10.5))
((/= att_line2 "") (setq ins_y -7.0))
((/= att_line1 "") (setq ins_y -3.5))
)
(setq new_ins (subst (+ (cadr rev_ins) ins_y) (cadr rev_ins) rev_ins))
(setvar "attdia" 0); turn off attribute dialogue box
(setq new_insa (strcat (rtos (car new_ins)) "," (rtos (cadr new_ins)) "," (rtos (caddr new_ins))))
(setq year (substr (rtos (getvar "CDATE") 2 0) 3 2)
month (substr (rtos (getvar "CDATE") 2 0) 5 2)
day (substr (rtos (getvar "CDATE") 2 0) 7 2)
rev_date (strcat day (substr att_date 3 1) month (substr att_date 3 1) year)
)
(if (<= (ascii att_letter) 57) (setq rev_letter (if (= (strlen (itoa (+ (atoi att_letter) 1))) 1) (strcat "0" (itoa (+ (atoi att_letter) 1))) (itoa (+ (atoi att_letter) 1)))) (setq rev_letter (chr (+ (ascii att_letter) 1))))
(command "-insert" "rev_note" new_insa "1" "1" "0" "RECORD DRAWING" rev_letter rev_date "IS" "" "")
;set titleblock revision to match new revision note
(setq att_list2 (entget (entnext (ssname ss 0))))
(while (= (cdr (assoc '0 att_list2)) "ATTRIB") (cond ((= (cdr (assoc 2 att_list2)) "CURRENT-REV") (entmod (subst (cons '1 rev_letter) (assoc '1 att_list2) att_list2))))
(setq att_list2 (entget (entnext (cdr (assoc -1 att_list2)))))
)
(setq counter (+ counter 1))
)
(command "regenall")
(RESTORE_VAR)
(princ)
)
(Defun RESTORE_VAR ()
; (command "-layer" "thaw" c_lay "on" c_lay "")
(setvar "CLAYER" c_lay)
; (command "-layer" "thaw" "*" "on" "*" "unlock" "*" "freeze" f_list "off" o_list "lock" l_list "")
(setvar "BLIPMODE" c_blp)
(setvar "CECOLOR" c_col)
(setvar "CMDECHO" c_cmd)
(setvar "TILEMODE" c_til)
(setvar "OSMODE" c_osm)
(setvar "DIMZIN" c_dimzin)
(setvar "QAFLAGS" c_qaf)
(setvar "TEXTSTYLE" c_textstyle)
(setvar "OSMODE" c_osm)
(setvar "ATTDIA" c_attdia)
(setvar "CTAB" c_ctab)
)
(defun laylist ()
:retrieves list of entries in Layer Table
(setq x nil)
(while (setq p "" d (tblnext "layer" (null d)))
(setq x (append x (list d)))
)
;creates list of layer names frozen
(setq count 1)
(setq froz_list nil)
(while (<= count (length x))
(setq elist (nth (1- count) x))
(if (= (cdr (assoc 70 elist)) 1) (setq froz_list (append froz_list (list(cdr (assoc 2 elist))))))
(if (= (cdr (assoc 70 elist)) 5) (setq froz_list (append froz_list (list(cdr (assoc 2 elist))))))
(setq count (+ count 1))
)
;creates list of layer names locked
(setq count 1)
(setq lock_list nil)
(while (<= count (length x))
(setq elist (nth (1- count) x))
(if (= (cdr (assoc 70 elist)) 4) (setq lock_list (append lock_list (list(cdr (assoc 2 elist))))))
(if (= (cdr (assoc 70 elist)) 5) (setq lock_list (append lock_list (list(cdr (assoc 2 elist))))))
(setq count (+ count 1))
)
;creates list of layer names turned off
(setq count 1)
(setq off_list nil)
(while (<= count (length x))
(setq elist (nth (1- count) x))
(if (< (cdr (assoc 62 elist)) 0) (setq off_list (append off_list (list(cdr (assoc 2 elist))))))
(setq count (+ count 1))
)
;creates string of layer names frozen
(setq count 1)
(setq f_list "")
(while (<= count (length froz_list))
(setq elist (nth (1- count) froz_list))
(setq f_list (strcat f_list "," elist))
(setq count (+ count 1))
)
(setq f_list (substr f_list 2))
;creates string of layer names locked
(setq count 1)
(setq l_list "")
(while (<= count (length lock_list))
(setq elist (nth (1- count) lock_list))
(setq l_list (strcat l_list "," elist))
(setq count (+ count 1))
)
(setq l_list (substr l_list 2))
;creates string of layer names turned off
(setq count 1)
(setq o_list "")
(while (<= count (length off_list))
(setq elist (nth (1- count) off_list))
(setq o_list (strcat o_list "," elist))
(setq count (+ count 1))
)
(setq o_list (substr o_list 2))
)
It works on some of our drawings but not others The common factor is different drawing sheets
