Having Trouble Modifying Attribute Layers at Entity Level

Hi guys,
It's time for me to put on my LISP hat again (it's been awhile and I'm rusty). I've cobbled together a program (from chunks of code some of you will recognize) to satisfy a request from a structural engineer to move all text objects in an architectural background (except those on the column buble layer) to a brand new layer (and freeze it) and then change all the objects in the drawing to display "bylayer" - for our x-referencing ease. The difficulties come with blocks with nested text, attributes and mtext. I've been able to get quite a lot of it to work, however I seem to be maxing out autolisp (if that's possible). I get about 1700 blocks modified, but then I get the following message..

Command: Hard error occurred ***
internal stack limit reached (simulated)

Here is my hacked together program. Does anyone have any suggestions as to what the trouble is and how it might be corrected? I really appreciate you guys helping me out when i hit these walls!

;;; ADAPTED FROM TxTRot by Jason Piercey 12-12-01 AND TABLE by Michael Puckett MODIFIED by Ron Powell 07-02-04
; This routine moves all text (except column buble text on layer "s-grid-text1-32") to layer "ALLTEXT".
(defun CREP (/ ss1 B1 ss2 SE1 i EBLK Ent EntLst ELAY SET1 SUBENTLST KIND RPT)
(COMMAND "-PURGE" "B" "" "N")
(command "-layer" "M" "ALLTEXT" "S" "0" "F" "ALLTEXT" "")

(setq ss1 (ssget "x" '((-4 . "<OR")
(0 . "TEXT")
(0 . "MTEXT")
(0 . "ATTDEF")
(-4 . "OR>")
)
)
i 0
)
(repeat (sslength ss1)

(setq Ent (ssname ss1 i)
EntLst (entget Ent)
ELAY (cdr (assoc 08 EntLst))
)
(IF
(/= (STRCASE "S-GRID-TEXT1-32") ELAY )
(PROGN
(setq EntLst (subst (cons 08 "ALLTEXT") (assoc 08 EntLst) EntLst)
)
(entmod EntLst)
(ENTUPD Ent)
)
)
(setq i (1+ i))
)
;;;------------------------------------------------
;;;

(defun table (x / d r);;michael puckett
(if (member (read x) '(appid block dimstyle layer ltype style ucs view vport))
(reverse
(while (setq d (tblnext x (null d)))
(setq r (cons (cdr (assoc 2 d)) r))
)
)
)
)
(SETQ RPT (- (LENGTH (TABLE "BLOCK")) 1))


(setq B1 (TBLNEXT "BLOCK" T))
(SETQ SE1 (CDR (ASSOC -2 B1)))
(SETQ KIND (CDR (ASSOC 0 (ENTGET SE1))))

(DEFUN CRUNCH ()
(COND
((OR
(equal "TEXT" KIND)
(equal "MTEXT" KIND)
(equal "ATTDEF" KIND))
(SETQ SUBENTLST (ENTGET SE1))
(setq SUBEntLst (subst (cons 08 "ALLTEXT") (assoc 08 SUBEntLst) SUBEntLst)
)
(entmod SUBEntLst)
(ENTUPD B1)
)
((SETQ SE1 (ENTNEXT))
(SETQ KIND (CDR (ASSOC 0 (ENTGET SE1))))
(CRUNCH)
)
)
)
(CRUNCH)
(REPEAT RPT
(TBLNEXT "BLOCK")
(CRUNCH)
)
;;;------------------------------------------------
(setq SET1 (ssget "x"))
(command "change" SET1 "" "P" "C" "BYLAYER" "p" "lt" "bylayer" "p" "lw" "bylayer" "")
(PRINC)
)

 

try this

(defun CREP (/ ss1 B1 ss2 SE1 i EBLK Ent EntLst ELAY SET1 SUBENTLST KIND RPT)
(COMMAND "-PURGE" "B" "" "N")
(command "-layer" "M" "ALLTEXT" "S" "0" "F" "ALLTEXT" "")

(setq ss1 (ssget "x" '((-4 . "<OR")
(0 . "TEXT")
(0 . "MTEXT")
(0 . "ATTDEF")
(-4 . "OR>")
)
)
i 0
)
(repeat (sslength ss1)

(setq Ent (ssname ss1 i)
EntLst (entget Ent)
ELAY (cdr (assoc 08 EntLst))
)
(IF
(/= (STRCASE "S-GRID-TEXT1-32") ELAY )
(PROGN
(setq EntLst (subst (cons 08 "ALLTEXT") (assoc 08 EntLst) EntLst)
)
(entmod EntLst)
(ENTUPD Ent)
)
)
(setq i (1+ i))
)
;;;------------------------------------------------
;;;

( defun table (x / d r);;michael puckett
(if (member (read x) '(appid block dimstyle layer ltype style ucs view vport))
(reverse
(while (setq d (tblnext x (null d)))
(setq r (cons (cdr (assoc 2 d)) r))
)
)
)
)
(SETQ RPT (- (LENGTH (TABLE "BLOCK")) 1))


(setq B1 (TBLNEXT "BLOCK" T))
(SETQ SE1 (CDR (ASSOC -2 B1)))
(SETQ KIND (CDR (ASSOC 0 (ENTGET SE1))))
(setq i 0); added initialize i count

(DEFUN CRUNCH ()
(COND
((OR
(equal "TEXT" KIND)
(equal "MTEXT" KIND)
(equal "ATTDEF" KIND))
(SETQ SUBENTLST (ENTGET SE1))
(setq SUBEntLst (subst (cons 08 "ALLTEXT") (assoc 08 SUBEntLst) SUBEntLst)
)
(entmod SUBEntLst)
(ENTUPD B1)
)
((> i 1500)(GC)(setq i 0));added if count i > 1500 Forces a garbage collection, which frees up unused memory
((SETQ SE1 (ENTNEXT))
(SETQ KIND (CDR (ASSOC 0 (ENTGET SE1))) i (1+ i)); added i count
(CRUNCH)
)
)
)
(CRUNCH)
(REPEAT RPT
(TBLNEXT "BLOCK")
(CRUNCH)
)
;;;----------------------------------------------- -
(setq SET1 (ssget "x"))
(command "change" SET1 "" "P" "C" "BYLAYER" "p" "lt" "bylayer" "p" "lw" "bylayer" "")
(PRINC)
)

cheers

 

Changed a couple of things.

(defun CREP (/ ss1 B1 ss2 SE1 i EBLK Ent EntLst ELAY SET1 SUBENTLST KIND RPT)
(COMMAND "-PURGE" "B" "" "N")
(command "-layer" "M" "ALLTEXT" "S" "0" "F" "ALLTEXT" "")
(setq ss1 (ssget "x" '((-4 . "<OR")
(0 . "TEXT")
(0 . "MTEXT")
(0 . "ATTDEF")
(-4 . "OR>")
)
)
i 0
)
(repeat (sslength ss1)
(setq Ent (ssname ss1 i)
EntLst (entget Ent)
ELAY (cdr (assoc 08 EntLst))
); setq
(if (/= "S-GRID-TEXT1-32" (strcase ELAY))
(progn
(setq EntLst (subst (cons 08 "ALLTEXT") (assoc 08 EntLst) EntLst))
(entmod EntLst)
(entupd Ent)
); progn
); if
(setq i (1+ i))
); repeat

;;;------------------------------------------------

(defun table (x / d r);;michael puckett
(if (member (read x) '(appid block dimstyle layer ltype style ucs view vport))
(reverse
(while (setq d (tblnext x (null d)))
(setq r (cons (cdr (assoc 2 d)) r))
)
)
)
)

;;;------------------------------------------------

(SETQ RPT (- (LENGTH (TABLE "BLOCK")) 1))
(repeat RPT
(setq B1 (TBLNEXT "BLOCK" T))
(SETQ SE1 (CDR (ASSOC -2 B1)))
(SETQ KIND (CDR (ASSOC 0 (ENTGET SE1))))
(CRUNCH)
); repeat

;;;------------------------------------------------

(DEFUN CRUNCH ()
(if (or
(equal "TEXT" KIND)
(equal "MTEXT" KIND)
(equal "ATTDEF" KIND)
); or
(progn
(SETQ SUBENTLST (ENTGET SE1))
(setq SUBEntLst (subst (cons 08 "ALLTEXT") (assoc 08 SUBEntLst) SUBEntLst))
(entmod SUBEntLst)
(ENTUPD B1)
); progn
); if
); function crunch


;;;------------------------------------------------

(setq SET1 (ssget "x"))
(command "change" SET1 "" "P" "C" "BYLAYER" "p" "lt" "bylayer" "p" "lw" "bylayer" "")
(PRINC)
;;
); function PREP

Bob

 

AAAAAAGGGGHHHH! I can't possibly keep up with this fire I've started! I posted this same problem under 3 different thread topic names because I had gotten 0 replied after 2 days each time. (see Anyone know why...internal stack limit reached (simulated)? )

Don't take that as a complaint. Thanks again for all the help on this, but I'm now trying to analyze 4 different solutions to the problem and yes - this did stop the erroring. This also succeeded in changing everything but attribute text and that's quite a lot of stuff.

Doug Broad's v-lisp solution is the most complete of the four though. Somehow he managed to get to the double nested attributes and put them on the alltext layer too. Thanks everyone for the lessons learned and contributions. Feel free to keep playing with it if you want to, but I can't look into more solutions and I'll have my fill just trying to understand the four I've already got.

Thank you Bob, and Zeha for the great solutions and method examples to some very complex problems. I appreciate all you contribute to this great forum..

Ron Powell
CAD Manager
jdh Engineering

 

Probably better to just let a single thread take it's coarse.



Bob