Can't find error "; error: malformed list on input " in lisp

Can't find error "; error: malformed list on input " in lisp

Sandervp
Advocate Advocate
2,141 Views
9 Replies
Message 1 of 10

Can't find error "; error: malformed list on input " in lisp

Sandervp
Advocate
Advocate

Could somebody help me please?

 

I've got a lisp file and it doesn't work because an error.

 

This lisp shall "clean" a drawing by creating a few new layers, puts some objects into one of those layers and after the command "laymrg", he puts every object in the right color. Insert a block is also a task of this lisp.

 

But I can't find the problem int he lisp with vlisp....

 

This is the lisp;

 

;**********opschonen van aangeleverde tekeningen**********

(defun c:CLEAN (/ adoc lay layers laylst locklst x)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq layers (vla-Get-Layers adoc))
  (vlax-for lay layers
    (if (= (vla-get-lock lay) :vlax-true)
      (progn
        (setq locklst (cons (vla-get-name lay) locklst))
        (vla-put-lock lay :vlax-false)
      )
    )
  )
  (setq laylst '(("BOUW" 8) ("MAATVOERING" 1) ("TEXT" 8) ("STRAMIEN" 1) ("DOORSNEDELIJN" 1) ("WIJZIGINGEN" 8))
  (mapcar '(lambda (x)
             (setq lay (vla-add layers (car x)))
             (vla-put-color lay (cadr x))
           )
          laylst
  )

(vlax-for layt (vla-get-layouts adoc)
  (vlax-for blk (vla-get-block layt)
    (if 
      (and (wcmatch (setq etype (vla-get-objectname blk)) "*Dimension*,*Leader,*Text")
     
	  )
	   (progn
        (vla-put-layer blk
          (cond
            ((wcmatch etype "*Dimension*") "MAATVOERING")
            ((wcmatch etype "*Leader,*Text") "TEXT")
          )
        )
        (vla-put-Color blk 256)
      )
    )
  )
)

  (if locklst
    (vlax-for lay layers
      (if (vl-position (vla-get-name lay) locklst)
        (vla-put-lock lay :vlax-true)
      )
    )
  )
   (princ)


;**********OVERIGE LAGEN NAAR BOUW**********

(defun C:LayMrg2Bouw nil (LayMrg2Bouw) (princ))

(defun LayMrg2Bouw ( / d lay)
  (command "_.LAYER" "_UNLOCK" "*" "")
  (setvar 'CLAYER "0")
  (if (not (tblsearch "LAYER" "Bouw")) (command "_.-LAYER" "_N" "Bouw" ""))

  (while (setq d (tblnext "LAYER" (null d)))
    (if (not (wcmatch (setq lay (strcase (cdr (assoc 2 d)) T)) "*|*,0,defpoints,BOUW,MAATVOERING,TEXT,DOORSNEDELIJN,WIJZIGINGEN"))
      (progn
	(command "_.-LAYMRG" "_N" lay "" "_N" "BOUW" "Yes")))
	(while (> (getvar 'CMDACTIVE) 0) (command "yes")))
  (princ)

;**********Routine to change the color of a block**********

 (defun C:cbl (/ CNT CMD EN1 EN2 EG1 EG2 NAM SS1)
 (setq CMD (getvar "CMDECHO"))
 (setvar "CMDECHO" 1)
 
(load "ai_utils")
 
(setq blk_list (ai_table "block" 12)) ; no Xrefs or
 ; Xref dependents.
 (if (>= (getvar "maxsort") (length blk_list)) ; Alphabetize if greater
 (if blk_list (setq blk_list (acad_strlsort blk_list))) ; than maxsort.
 )
 
(setq old_vp (getvar "cvport");save current viewport
 old_tile (getvar "tilemode");save current tilemode
 c_layer (getvar "layer")
 old_expert (getvar "expert"));save current layr
 (command "view" "s" "CBL")
 (ddslayer);save current layer settings
 (command "layer" "set" "0" "")
 (setvar "cmdecho" 1);debug
 (command "layer" "thaw" "*" "on" "*" "unlock" "*" "");thaw, on, unlock all
 
(setq rep 0)
 (repeat (length blk_list) ;process block list
 (BCBL (nth rep blk_list))
 (setq rep (+ 1 rep))
 )
 
(COMMAND "change" "all" "" "p" "c" "bylayer" "")
 
;restore commands here
 
(command "zoom" "e")
 (ddrlayer) ;restore layer settings
 (command "layer" "set" c_layer "");set back to original layer
 (command "view" "r" "CBL")
 (setvar "attreq" old_attreq)
 (setvar "expert" old_expert)
 (prin1)
 (princ "\n\tLoaded CBL.LSP. Type CBL to begin.")
 (princ)
 ); end
 
;layer setting save routine
 (defun ddslayer ()
 (setq
 c_lay (getvar "clayer")
 lay_set_list nil
 layer_name (tblnext "layer" "T")
 )
 (while layer_name
 (setq lay_set (get_set layer_name))
 (setq layer_list (append layer_list (list lay_set)))
 (setq layer_name (tblnext "layer"))
 )
 )
 ;-------------------------------------------------?----
 ; BIT SET
 ;-------------------------------------------------?----
 (defun BITSET (A B) (= (boole 1 A B) B))
 ;-------------------------------------------------?----
 ; DXFGET
 ;-------------------------------------------------?----
 (defun DXFGET (A B) (cdr (assoc A B)))
 ;-------------------------------------------------?----
 ; Get layer settings
 ;-------------------------------------------------?----
 (defun get_set (LAYER)
 (if LAYER
 (list
 (> (DXFGET 62 LAYER) 0) ;negative if off
 (bitset (DXFGET 70 LAYER) 1) ;set if frozen
 (bitset (DXFGET 70 LAYER) 4) ;set if locked
 (DXFGET 2 LAYER) ;layer name
 )
 )
 )
 
(defun ddrlayer() ;layer restore routine
 (command "regenauto" "off")
 (setq rep 0)
 (command ".layer")
 (repeat (length layer_list)
 (setq t_layer (nth rep layer_list)
 l_name (cadddr t_layer)
 )
 (command
 (if (car t_layer) "on" "off") l_name)
 (command
 (if (cadr t_layer) "freeze" "thaw") l_name)
 (command
 (if (caddr t_layer) "lock" "unlock") l_name)
 (setq rep (+ 1 rep))
 )
 (command "")
 )
 (princ)
 (prompt "\n\t\tStart with 'CBL'")(prin1)
 ;end
 




;---Loop through entities in the block---
 (defun BCBL (NAM)
 

(SETQ EN2 (cdr (assoc -2 (tblsearch "BLOCK" NAM)))
 )
 (PRBLK EN2 NAM)
 (setvar "CMDECHO" CMD)
 (princ)
 )
 
;*******Subroutine to change color and layer********
 (defun PRBLK (EN2 NAM)
 (setq CNT 0)
 (while EN2
 (setq CNT (1+ CNT)
 EG2 (entget EN2)
 EN2 (entnext (cdr (assoc -1 EG2)))
 )
 (grtext -2 (strcat NAM " block entity # " (itoa CNT)))
 ;---Check color---
 (if (assoc 62 EG2)
 (setq EG2 (subst (cons 62 256) (assoc 62 EG2) EG2))
 (setq EG2 (append EG2 (list (cons 62 256))))
 )
 (entmod EG2)
 ;---Set to layer 0---
 
(if (/= (cdr (assoc 8 EG2)) "0")
 (progn
 (setq EG2 (subst (cons 8 "0") (assoc 8 EG2) EG2))
 (entmod EG2)
 )
 )
 ;---Check for nested blocks---
 (if (= (cdr (assoc 0 EG2)) "INSERT")
 (progn
 (setq NM2 (cdr (assoc 2 EG2))
 EN3 (cdr (assoc -2 (tblsearch "BLOCK" NM2)))
 )
 (PRBLK EN3 NM2)
 )
 );endif
 )
 ---Update all blocks in the drawing---
 (setq SS1 (ssget "X" (list (cons 2 NAM)));find all insertions of that block, if any
 CNT 0)
 (if SS1 (progn
 (setq C (- (sslength SS1) 1)) ; set counter
 (while (>= C CNT) ; while entities in the list
 (setq EN1 (ssname SS1 CNT))
 (setq CNT (1+ CNT))
 (entupd EN1)
 );end while C
 );progn
 );if SS1
 );defun



;**********OPSCHONEN**********

(DEFUN C:OPSCHONEN();_OPSCHONEN TEKENING
  (COMMAND "QSAVE")
  (COMMAND "-OVERKILL" "ALL" "*" "DONE")
  (COMMAND "PURGE" "A" "*" "N")
  (C:CLEAN)
  (COMMAND "-insert" "C:\Users\sander.vanpelt\Documents\BLOCK LAGEN XREF OPSCHONEN.dwg" "0,0,0" "1" "1" "0")
  (C:LayMrg2Bouw)
  (C:CBL)
)
  

 

 

Who can help me?

 

Thanks already

 

0 Likes
Accepted solutions (2)
2,142 Views
9 Replies
Replies (9)
Message 2 of 10

Ajilal.Vijayan
Advisor
Advisor
Accepted solution

Try after closing the parenthesis at these lines.

(setq laylst '(("BOUW" 8) ("MAATVOERING" 1) ("TEXT" 8) ("STRAMIEN" 1) ("DOORSNEDELIJN" 1) ("WIJZIGINGEN" 8)))
   (princ)
);defun c:clean

;**********OVERIGE LAGEN NAAR BOUW**********
  (princ)
);defun LayMrg2Bouw 
;**********Routine to change the color of a block**********
0 Likes
Message 3 of 10

Sandervp
Advocate
Advocate

Hello Ajilal Vijavan         

 

I want to add a command or other lisp to this whole code which shall remove all the layouts. These layouts do not have the same name in each drawing, that's the reasing why I can't use the "-layout" command (maybee I'm wrong).

 

I've got a lisp file which shall delete all the layouts AFTER I confirmed this with a Yes.

 

How do I have to change this code, in a way, I don't have to confirm this or is there a command/ macro I can use for removing all the layouts?

 

Thank you

 

(defun c:erl ( / confirm ) 
   (princ "\nWaarschuwing: dit zal alle layouts verwijderen. ")
 (initget 1 "Y N ")
 (setq confirm (getkword "\nDoorgaan? [Yes/No] : "))
 (if (or (= confirm "")
 (= confirm "Y"))
 (vlax-for x (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
 (if (/= "Model" (vla-get-name x)) (vla-delete x) ) )
 (princ "\nDe layouts zijn niet verwijderd. ") ) 
(princ)
 )

 

(Btw; some text in the lisp is Dutch) 

0 Likes
Message 4 of 10

Ajilal.Vijayan
Advisor
Advisor

So you want to remove all the layouts ?

Please note that even if you delete all layouts, AutoCAD will bring one layout back.

If yes, try with this code.

Spoiler
(defun c:erl ( / confirm lay) 
(princ "\nWaarschuwing: dit zal alle layouts verwijderen. ")
(vlax-for x (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
	(setq lay (vla-get-name x))
	(if (vl-catch-all-error-p(setq err(vl-catch-all-apply 'vla-delete (list x))))
		(princ (strcat "\nDe layouts zijn niet verwijderd ->" lay))
		(princ (strcat "\nDe layouts zijn verwijderd -> ->" lay))	
	);if
);vlax-for
(princ)
);defun
0 Likes
Message 5 of 10

Sandervp
Advocate
Advocate

Thanks again Ajilal.

 

The lisp is working allmost perfect.

At the end of the lisp, almost every layer is changed into the layer "bouw". But it wants to change the layer "bouw" also into the layer "bouw". Because of this, the lisp will not do the "cbl" command (color by layer), and saving at the end. 

 

 

 

Command: _.-LAYMRG
Select object on layer to merge or [Name]: _N
Enter layer name or [?]: bouw
Selected layers: BOUW.
Select object on layer to merge or [Name/Undo]:
Select object on target layer or [Name]: _N
Enter layer name or [?]: BOUW
Cannot merge a layer with itself. Layer BOUW is already selected.

Select object on target layer or [Name]: Yes

*Invalid selection*
Expects a point or Last/Name]:
; error: Function cancelled

Select object on target layer or [Name]: *Cancel*

 

0 Likes
Message 6 of 10

hmsilva
Mentor
Mentor

HI Sandervp,

remove the T from

(if (not (wcmatch (setq lay (strcase (cdr (assoc 2 d)) T )) "*|*,0,defpoints,BOUW,MAATVOERING,TEXT,DOORSNEDELI​JN,WIJZIGINGEN"))

 

From the help files, strcase function:

If specified as T, all alphabetic characters in string are converted to lowercase. Otherwise, characters are converted to uppercase

 

Hope this helps,
Henrique

EESignature

0 Likes
Message 7 of 10

Sandervp
Advocate
Advocate

Thank you HMsilva!

 

This problem is solved, but the "CBL" part doesn't work well now.

I'll get this error at the end:

 

Command: layer
Current layer:  "0"
Enter an option [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Freeze/Thaw/LOck/Unlock/stAte/Description/rEconcile]: set
Enter layer name to make current or <select object>: Enter an option [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Freeze/Thaw/LOck/Unlock/stAte/Description/rEconcile]:
Command: view Enter an option [?/Delete/Orthographic/Restore/Save/sEttings/Window]: r Enter view name to restore: CBL
Command: ; error: AutoCAD variable setting rejected: "attreq" nil

 

I'd add the command save at the end of the lisp, but the lisp doesn't reach this command because of the error

0 Likes
Message 8 of 10

hmsilva
Mentor
Mentor
Accepted solution

@Sandervp wrote:

Thank you HMsilva!

 

This problem is solved, but the "CBL" part doesn't work well now.

I'll get this error at the end:

 

Command: layer
Current layer:  "0"
Enter an option [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Freeze/Thaw/LOck/Unlock/stAte/Description/rEconcile]: set
Enter layer name to make current or <select object>: Enter an option [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Freeze/Thaw/LOck/Unlock/stAte/Description/rEconcile]:
Command: view Enter an option [?/Delete/Orthographic/Restore/Save/sEttings/Window]: r Enter view name to restore: CBL
Command: ; error: AutoCAD variable setting rejected: "attreq" nil

 

I'd add the command save at the end of the lisp, but the lisp doesn't reach this command because of the error


You're welcome, Sandervp!


The error is because you are setting

(setvar "attreq" old_attreq)

and the variable 'old_attreq' is nil, you'll have to set

(setq old_attreq (getvar "attreq" ))

at the code beginning...

 

Hope this helps,
Henrique

Henrique

EESignature

Message 9 of 10

Sandervp
Advocate
Advocate

Thanks Henrique!!

0 Likes
Message 10 of 10

hmsilva
Mentor
Mentor

@Sandervp wrote:

Thanks Henrique!!


You're welcome, Sandervp!
Glad I could help

Henrique

EESignature

0 Likes