Message 1 of 10
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
Solved! Go to Solution.