Anyone know why...internal stack limit reached (simulated)?

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)
)

 

recursive functions are said to have the ability to run out of stack space,
so I've heard here from others who actually understand that kind of thing

here's one way to rewrite it in activex(partially)
;active x version by Mark Propst
;change all text, mtext, and attdefs to given layer

(defun CREP (/ textlayer)
;this would get rewritten also to active x if i had time
(COMMAND "-PURGE" "B" "" "N")

;this way you can change layername easily
(setq TextLayer "ALLTEXT")
(setq ThisDrawing(vlax-get-property(vlax-get-acad-object)'ActiveDocument))
(setq layers (vlax-get-property ThisDrawing 'layers))

(if(vl-catch-all-error-p
(setq newlay
(vl-catch-all-apply
'vlax-invoke-method
(list
layers
'item
TextLayer
);list
));get layer if it exists
);layer doesn't exist
(progn;else create it
(setq newlay
(vlax-invoke-method
layers
'add
textlayer
))
)
);if

;make sure textlayer is not active
(vlax-put-property ThisDrawing 'ActiveLayer (vlax-invoke-method layers
'item "0"))
;freeze
(vlax-put-property newlay 'freeze :vlax-true)

(princ(strcat"\nChange text to " textlayer " layer"))
(ChangeTextToTextLayer ThisDrawing textLayer)

(princ"\nDone")
)


(defun ChangeTextToTextLayer (oDoc textLayer / blockcol blkobj kind
oldlayname oldlayobj)
;get block collection (includes ModelSpace and all Paperspace tabs and all
blocks)
(setq BlockCol
(vlax-get-property oDoc
'Blocks
)
)

(vlax-for blkobj BlockCol;for every block def
(princ(strcat"\nProcessing block " (vlax-get-property blkobj 'name)))
(vlax-for subObj blkobj;for every object in block def
(setq kind(vlax-get-property subobj 'ObjectName))

(if
(and
(or
(wcmatch kind "*Text" )
(= "AcDbAttributeDefinition" kind)
);or
(/= "S-GRID-TEXT1-32"(STRCASE (setq oldLayName(vlax-get-property subobj
'layer))))
);and
;matching entity founc
(progn
(setq oldlayobj(vlax-invoke-method layers 'item oldlayname))
(if(equal (vlax-get-property oldlayobj 'Lock):vlax-true)
;unlock, change, reLock
(progn
(vlax-put-property oldlayobj 'Lock :vlax-false)
(vlax-put-property subobj 'layer textlayer)
(vlax-put-property oldlayobj 'Lock :vlax-true)
);progn
;else just change
(progn
(vlax-put-property subobj 'layer textlayer)
)
);if layer is locked
);progn
);if matching entity found
);for each subobject
);for each block


;;;----------------------------------------------- -
;likewise this section could be rewritten to active x
;not good to mix actievx calls with 'command' calls
(setq SET1 (ssget "x"))
(command "change" SET1 "" "P" "C" "BYLAYER" "p" "lt" "bylayer" "p" "lw"
"bylayer" "")
(PRINC)
)

hth
Mark


I get about 1700 blocks modified, but then I get the following message..

what the trouble is and how it might be corrected? I really appreciate you
guys helping me out when i hit these walls!

 

Mark,
thank you so much for taking the time to rewrite that! I know almost nothing about active X but the program worked for 99% of the text objects (once I caught the wordwrap induced error on your longest comment). The only objects that failed to change were the double nested mirrored attributes (really weird stuff). I can work around that!
Thanks for going out of your way to set that up for me. I'll work on digesting the active X using this as an example....

 

nothing about active X but the program worked for 99% of the text objects
(once I caught the wordwrap induced error on your longest comment). The
only objects that failed to change were the double nested mirrored
attributes (really weird stuff). I can work around that!

digesting the active X using this as an example....

cool
yeah we were just rewriting block definitions there, any existing inserts
with attributes would have remained unchanged since existing attribs don't
respond to the parent definitions changes as non-attributes would have.
I didn't think about that and was just using a quickie test dwg with a few
text things and few blocks to test (and none of the blocks had attribs)

It was really just a sample of what active x would look like to do what the
crunch routine was attempting to do.
I wouldn't have thought that would have changed existing attribs but i
didn't take enuf time to study it good enuf to see exactly what all it was
doing - it was a little confusing at first with the inner defun and
recursive call ....
but i digress
we'd have to go through all the inserts as well and update their attribute
characteristics

i'll look at that later but the sun is going down, got to get something done
later
Mark

 

You may be exceeding the allowable number of Selection Sets (112 I think..), in the sequence:
(REPEAT RPT
(TBLNEXT "BLOCK")
(CRUNCH)
)
;;;----------------------------------------------- -
(setq SET1 (ssget "x"))
(command "change" SET1 "" "P" "C" "BYLAYER" "p" "lt" "bylayer" "p" "lw" "bylayer" "")

After the (command "change" .....
Add:
(setq SET1 nil); release selection set

Bob

 

Hi Mark,
Here is an alternative that does handle inserts:

Code:

;;Demonstration
;;D. C. Broad, Jr. 7/10/04

;;;Strip mtext color codes from a mtext formatted string
(defun STRIPMTC  (STR / CI)
(setq CI (vl-string-search "\\C" STR))
(cond
((null CI) STR)
((strcat (substr STR 1 CI)
(STRIPMTC (substr STR (+ 2 (vl-string-search ";" STR CI))))))))

;;;-----------MAIN PROGRAM -------------------------------;;;
(defun C:PREP
(/ APP DOC LAYS TXTLAY LAY
BLOCK OBJ ONAME ATT PutTextLayer)
(vl-load-com)    ;load vlisp
(princ
"\nChanging colors, linetypes, and
lineweights to bylayer. Please wait... \n")
;;general objects
(setq APP  (vlax-get-acad-object)
DOC  (vla-get-activedocument APP)
LAYS (vla-get-layers DOC)
)
(vla-startundomark DOC)
(command "-PURGE" "B" "" "N") ;remove unreferenced block defs
;;save layer state and unlock all layers
(command "-layer" "a" "s" "temporary" "" ""
"un" "*" "")

(setq TXTLAY "ALLTEXT")
;;ensure that current layer is not to be frozen
(if (= (strcase (getvar "clayer")) (strcase TXTLAY))
(vla-put-layer doc "0"))
;;create new layer if necessary
(setq LAY (vla-add LAYS TXTLAY))
(vla-put-freeze LAY :vlax-true)

;;LOCAL LAYERING FUNCTION
;;-rules for layering
(defun PutTextLayer  (OBJ)
(if
(not
(member (strcase (vla-get-layer OBJ)) '("S-GRID-TEXT1-32")))
(vla-put-layer OBJ TXTLAY))
)

;;loop through each block definition
(vlax-for BLOCK  (vla-get-blocks DOC)
(if
(= :vlax-true (vla-get-isxref BLOCK))
(princ (strcat "\nSkipping external reference: "
(vla-get-name BLOCK)
"\n"))
;;do the following only if the block/layout is not an xref
(vlax-for OBJ  BLOCK
;;Object type is key to properties
(setq ONAME (vla-get-objectname OBJ))
;;Deal with separate types of text entities
(cond
;;multi-line text entity---------;;
((= ONAME "AcDbMText")
(vla-put-textstring
OBJ
(STRIPMTC (vla-get-textstring OBJ)))
(PutTextLayer OBJ)
)
;;block has attributes-----------;;
((and (= (vla-get-objectname OBJ) "AcDbBlockReference")
(= :vlax-true (vla-get-hasattributes OBJ)))
(foreach ATT
(vlax-safearray->list
(variant-value (vla-getattributes OBJ)))
(vla-put-color ATT acbylayer)
(PutTextLayer ATT)
))
;;other type of text entity
((member ONAME '("AcDbText" "AcDbAttributeDefinition"))
(PutTextLayer OBJ)
)
)
;;changes for every object
(vla-put-color OBJ acbylayer)
(vla-put-linetype OBJ "BYLAYER")
(vla-put-lineweight OBJ aclnwtbylayer)
)))
;;end loop
;;restore layer states and delete temporary state
(command "layer" "a" "r" "temporary" "d" "temporary" "" "")
(vla-update APP)
(vla-endundomark DOC)
(princ "Done.  Use undo to reverse effects.")
(princ))
[\code]

 

Wow, Thanks Doug.
I ran the program on my three test drawings and you succeeded in getting it all. I do appreciate all the help I'm getting on this one, even though I was content with Mark's active X solution as it was.
I'll have to analyze this for a while before I can begin to digest it. I see it has a lot of visual lisp in it. I'm only a little familiar with VLISP having only used a few commands to set plotters on sheet set-up tabs via our set-up program. This does raise a question in my mind - is "active X the same thing as the visual lisp extensions? Maybe this is all just semantics, but I wonder if separate rules apply for the three distinctions - LISP, VLISP and active X. Anyway, thanks to you as well for taking the time to dig into this one. I know it took more than a few minutes to come up with that. Thanks..

 

No, Bob, That's what I suspected a while ago. But the error is generated well before that. I think instead that it must be involving the following sequence running out of room....

(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))
)

 

Ron,

It is probably better to think of Visual LISP as "simply" AutoLISP v2.0 <g>.
You get the VLIDE and more functions.

The ActiveX interface makes the same object model for AutoCAD VBA available
to Visual LISP.

--
R. Robert Bell


Wow, Thanks Doug.
I ran the program on my three test drawings and you succeeded in getting it
all. I do appreciate all the help I'm getting on this one, even though I
was content with Mark's active X solution as it was.
I'll have to analyze this for a while before I can begin to digest it. I
see it has a lot of visual lisp in it. I'm only a little familiar with
VLISP having only used a few commands to set plotters on sheet set-up tabs
via our set-up program. This does raise a question in my mind - is "active
X the same thing as the visual lisp extensions? Maybe this is all just
semantics, but I wonder if separate rules apply for the three distinctions -
LISP, VLISP and active X. Anyway, thanks to you as well for taking the time
to dig into this one. I know it took more than a few minutes to come up
with that. Thanks..

 

You're welcome.

You can also see quickly how a bad recursive program behaves.

(defun bad (x)
(bad x))

;;Call with (bad "day")