error: An error has occurred i
When layer merge later , Will remove the original layer, and displayer:Conversion to " ??? " layer successful,Time(secs):0.141 ....But ,now ,Failed to normal end.
Please wait, processing.....*cancel*; error: An error has occurred inside the *error* functionbad argument type: symbolp 1
why?
DCL
ea_lyrtrans : dialog { label = "Layer Merge"; : column { : row { : column { : boxed_column { width = 10; label = "merge to"; : row { children_alignment = top; : edit_box { height =1; key = "Nlyr"; } : image_button { height = 2; width =4; key = "col"; } } : popup_list { key = "Sel"; } } : column { : toggle { label = "Keep color"; key = "color"; value = "1"; } : toggle { label = "Keep linear"; key = "ltyp"; value = "1"; } : toggle { label = "Ignore the block layer 0"; key = "lay"; value = "1"; } } } : boxed_column { label = "layer list"; : list_box { key = "what"; height = 9; width = 17; multiple_select =true; allow_accept = true; } } } : row { alignment = centered; fixed_width = true; : button { label = "preview" ; key = "pre"; } : button { label = "select" ; key = "list"; } : button { label = "conversion" ; key = "Trans"; } : ok_button { label = "exit" ; key = "accept"; is_cancel = true; } }}}
Layer Merge23.dcl
Layer Merge23.lsp I want post the lisp code,but
"The text that you have entered is too long (20593 characters). Please shorten it to 15000 characters long."
Can download Attached Files in #1
Part1.
;by eachy ;flowerson edit(vl-load-com)(if (>= (atof (getvar "acadver")) 16.0) (vl-arx-import "acapp.arx") (vl-arx-import "acadapp.arx"));|The global variable nlyr:new layer llyr:conversion list name:layer list fillc : new layer colour tf : keep colour "1" keep "0" Don't keep tf1 :keep linear "1" keep "0" Don't keep ltf: Ignore the block layer 0"1" Ignore "0" modify|;(defun c:TEST (/ ea:string_parse ea:string_unparseea:pross ea:get-utimeRGBtoOLE_colorOLEtoRGB_color RGBtoACIea:getcecolor ea:chglyrcolorea:translyr ea:chgcolor ea:fillcolorea:pre ea:table getsslyrmyerr mknewlyr ea:clearcsetthisdrawing blocks layersname nullss olderrltf nlyr llyrfillc tf tf1_$ver _ealyrtr_id what_nextoAcad xtmp bn ) ;|(if (or (> (atoi (rtos (getvar "cdate") 2 0)) 20041231)(< (atoi (rtos (getvar "cdate") 2 0)) 20040906) ) (vla-eval (vlax-get-acad-object) (strcat"MsgBox \"\nAuthor: Eachy\n\nhttp:\\\\www.xdcad.net\""", ""vbExclamation+vbSystemModal"", ""\"Layer Merge V2.3 \"" ) ) ;_ end eval ) ;_ end if|; (defun ea:table (s / d r) (while (setq d (tblnext s (null d))) (setq r (cons (cdr (assoc 2 d)) r)) ) (acad_strlsort (reverse r)) ) (defun ea:string_parse (str delimiter / post strlst) (if str (progn(setq strlst '())(while (vl-string-search delimiter str)(setq post (vl-string-search delimiter str))(setq strlst (append strlst (list (substr str 1 post))))(setq str (substr str (+ post 2))))(vl-remove "" (append strlst (list str))) ) ) ;_ end if ) ;_ end defun ea:string_pase (defun ea:string_unparse (lst delimiter / return) (setq return "") (foreach str lst (setq return (strcat return delimiter str)) ) (substr return 2) ) ;;The progress bar (defun Ea:pross (k l) (grtext -2 (strcat "Has been completed" (rtos (/ (* 100.0 k) l) 2 0 ) "%...." ) ) ) (defun ea:get-utime () (* 86400 (getvar "tdusrtimer")) ) ;; Convert a list of RGB to TrueColor ;; (RGBtoOLE_color '(118 118 118)) (defun RGBtoOLE_color (RGB-codes / r g b) (setq r (lsh (car RGB-codes) 16)) (setq g (lsh (cadr RGB-codes) ) (setq b (caddr RGB-codes)) (+ (+ r g) b) ) ;;Truecolor -> rgb (defun OLEtoRGB_color (OLE_color / r g b) (setq r (lsh OLE_color -16)) (setq g (lsh (lsh OLE_color 16) -24)) (setq b (lsh (lsh OLE_color 24) -24)) (strcat "RGB:" (vl-princ-to-string r) "," (vl-princ-to-string g) "," (vl-princ-to-string b) ;(list r g b)) ) ) ;; (defun RGBtoACI (RGB-codes / colorobj) (setq ColorObj (vla-GetInterfaceObject oAcad "AutoCAD.AcCmColor.16") ) (vlax-invoke ColorObj 'setRGB (car RGB-codes) (cadr RGB-codes) (caddr RGB-codes) ) (vlax-get-property ColorObj 'ColorIndex) ) (defun ea:Clearcset (/ cset) (if (not (vl-catch-all-error-p (setq cset (vl-catch-all-apply'vla-item(list (vla-get-selectionsets thisdrawing) "CURRENT") ) ) )) (vla-delete cset) ) (princ) ) ;;************************************************************************** ;;conversion main code (defun ea:translyr (/ ea:chg_layer_color_ltyp_0 ea:chgattblkea:chg_ssget_blockdefea:chg_not_ssget_blockdef llyrclt t0 nlfilter cset ln s slt1 blst lllt x nllyr0colorobj 0_in e0 all_0 nn tmp ) (defun ea:chg_layer_color_ltyp_0 (obj mark / alyr cl colobj olt) (if (/= (cdr (assoc 0 (entget (vlax-vla-object->ename obj ) ) ) ) "ACAD_PROXY_ENTITY") (progn(setq alyr (vla-get-layer obj))(if _$ver (progn (setq colobj (vla-get-truecolor obj) cl (vla-get-colorindex colobj ) ) (if (= cl 256) ;_ bylayer (setq colobj (cdr (assoc alyr llyrc))) ) ) ; (if (= (setq cl (vla-get-color obj )) 256) (setq cl (cdr (assoc alyr llyrc))) ));;modify layer(if (and (/= alyr nlyr) (not (and mark (= alyr "0") (= ltf "1"))) ) (vla-put-layer objnlyr)) ;_ end if;;Restore color(if (= tf "1") ;_keep (cond ((and mark (= alyr "0") ; (= cl 256) ;_ bylayer ) (if _$ver(progn (vla-put-colorindex colobjacByblock) ; (vla-put-truecolor obj ' colobj))(vla-put-color obj0) ) ;_ byblock ) ((and (/= alyr nlyr) (= cl 256)) ; (if _$ver(vla-put-truecolor objcolobj)(vla-put-color obj cl) ) ;_ end if ) (t) ) ;_ end cond (if (and _$ver (/= cl 256) ) (progn (vla-put-colorindex colobj 256);_ bylayer (vla-put-truecolor objcolobj) ) (vla-put-color obj256) )) ;_end if(if (= tf1 "1") (if (and (= (setq olt (vla-get-linetype obj ))"BYLAYER" ) (/= olt "BYBLOCK") (vlax-property-available-p obj 'linetype t) ) (vlax-put-property obj 'linetype (cdr (assoc alyr lt))) ) (if (and (/= (vla-get-linetype obj ) "BYLAYER") (vlax-property-available-p obj 'linetype t) ) (vla-put-linetype obj ' "BYLAYER") )) ;_ end if) ;_ end progn ) ;_ end progn (if) ) ;_ end defun ea:chg_color_ltyp_0 (defun ea:ChgAttBlk (blk mark / seqent attlst) (setq attlst (vlax-safearray->list (vlax-variant-value (vla-getattributes blk)) ) ) (mapcar '(lambda (x)(if (vl-position (vla-get-layer x ) llyr) (ea:chg_layer_color_ltyp_0 x mark)) ) attlst ) (if (vl-position (vlax-get-property (setq seqent (vlax-ename->vla-object (entnext (vlax-vla-object->ename (last attlst)) ) ) ) 'layer ) llyr)(vlax-put-property seqent 'layer nlyr) ) ; (if (and (= tf1 "0") (/= (vla-get-linetype seqent ) "BYLAYER"))(vla-put-linetype seqent"BYLAYER") ) ) ;_end defun ea:chgattblk ;;main code (if (and (/= llyr "") (/= nlyr "")) (progn (if (not blocks)(setq blocks (vla-get-blocks thisdrawing )))(if (not layers)(setq layers (vla-get-layers thisdrawing )))(setq t0 (ea:get-utime))(if (not (tblsearch "layer" nlyr))(vla-add layers nlyr));;(vla-startundomark thisdrawing)(vlax-map-collectionlayers'(lambda (x) (vla-put-lock x:vlax-false)))(setq nl (mapcar 'atoi (ea:string_parse llyr " ")) filter (ea:string_unparse (setq llyr (mapcar '(lambda (x) (nth x name)) nl)) "," )) ;_end setq(if (not (vl-position "0" llyr))(setq nllyr (append llyr '("0")))(setq nllyr llyr))(setq l (vla-get-count blocks ))(if (= tf "1") ; (setq llyrc(mapcar '(lambda (x / col mod bkname) (if _$ver(cons x (vla-get-truecolor (vla-item layers x) )) (cons x (cdr (assoc 62 (tblsearch "layer" x)))) ) ;_ end if ) ;_ end lambda (if (not (vl-position nlyr nllyr)) (append (list nlyr) nllyr) nllyr )) ;_end mapcar ) ;_ end setq ) ;_ end if (if (= tf1 "1")(setq lt(mapcar '(lambda (x) (cons x (cdr (assoc 6 (tblsearch "layer" x)))) ) (if (not (vl-position nlyr nllyr)) (append (list nlyr) nllyr) nllyr ))))(ea:clearcset)(if (ssget "x" (list '(-4 . "") ) ) ;_ end ssget(progn (setq l (+ l (vlax-get-property (setq cset (vla-get-activeselectionset thisdrawing ) ) 'count ) ) n 1 ) (vlax-map-collection cset '(lambda (x / bbn)(Ea:pross n l)(cond ((= (vla-get-objectname x ) "AcDbBlockReference") (if (vl-position (vla-get-layer x) llyr) (progn(ea:chg_layer_color_ltyp_0 x nil) (if (not blst) (setq blst (list (setq bbn (vla-get-name x ) ) ) ) (if (not (vl-position (setq bbn (vla-get-name x) ) blst ) ) (setq blst (append blst (list bbn))) )) ) ) (if (= (vla-get-hasattributesx) :vlax-true) (ea:chgattblk x nil) ) ) (t (ea:chg_layer_color_ltyp_0 x nil)))(setq n (1+ n)) ) )) ;_ while) ;_ end progn part2
(vlax-map-collection(vlax-get-property thisdrawing 'blocks)'(lambda (i / bn e tmp) (if (and(setq bn (strcase (vlax-get-property i 'name)))(not (wcmatch bn "`**_SPAC*"))(/= (vla-get-count i) 0) ) ;;(vlax-map-collection (if (vl-position bn blst);_ in ssget block (vlax-map-collection i '(lambda (e / etyp lay bbn) (setq etyp (vla-get-objectname e) lay(vla-get-layer e) ) (cond ((and (wcmatch etyp "*Block*") (not (vl-position (strcase (vla-get-name e)) blst ) ) (vl-position lay llyr) ) (if (not 0_in) (setq 0_in (list (vla-get-name e))) (if (not (vl-position (setq bbn (vla-get-name e)) 0_in ) ) (setq 0_in (append (list bbn) 0_in)) ) ) (ea:chg_layer_color_ltyp_0 e t) (if (= (vlax-get-property e 'hasattributes) :vlax-true ) (ea:chgattblk e t) ) ) ((vl-position lay llyr) (ea:chg_layer_color_ltyp_0 e t) ) (t) ) ) ) ;_ end vlax-map-collection (vlax-map-collection ;_ not in ssget 但可能在 blst 引用内(0_in) i '(lambda (e / etyp lay) (setq etyp (vla-get-objectname e) lay(vla-get-layer e) ) (cond ((vl-position lay llyr) (cond ((wcmatch etyp "*Block*") (ea:chg_layer_color_ltyp_0 e t) (if (not (vl-position (strcase (vla-get-name e)) blst ) ) (if (not 0_in) (setq 0_in (list (vla-get-name e))) (if (not (vl-position (setq bbn (vla-get-name e)) 0_in ) ) (setq 0_in (append (list bbn) 0_in) ) ) ) ) (if (= (vlax-get-property e 'hasattributes) :vlax-true ) (ea:chgattblk e t) ) ) ((/= lay "0") (ea:chg_layer_color_ltyp_0 e t) ) (t) ) ) ((and (= lay "0") ; (not (vl-position lay llyr)) ) (if (not 0_in) (setq 0_in (list bn)) (if (not (vl-position bn 0_in)) (setq 0_in (append (list bn) 0_in) ) ) ) (setq nn(read bn) tmp (eval nn) ) (if (not tmp) (set nn (list e)) (set nn (cons e tmp)) ) ) ;_ end if (t) );_ end if );_ end lambda ) ;_ end vlax-map-collection ) ;_ end if ) ;_ end if ) ;_ end lambda) ; (if 0_in(progn (setq 0colorobj (vla-get-truecolor (vla-item layers"0"))) (vla-put-colorindex 0colorobj acByblock) (mapcar '(lambda (x / 0lst)(if (not (setq 0lst (eval (read x)))) (mapcar '(lambda (e0) (if _$ver (vla-put-truecolor e0 0colorobj) (vla-put-color e0 0) ) ) olst )) ) 0_in )))(setvar "clayer" "0")(vla-purgeall thisdrawing)(if (setq s (ssget "x" (list (cons 8 nlyr) '(0 . "INSERT"))))(progn (setq sl (sslength s)) (while (> sl 0) (entupd (ssname s (setq sl (1- sl)))) )) ;_ end progn) ;_ end if;;(vla-endundomark thisdrawing)(setq llyr nil name (ea:table "layer") blocks (vlax-get-property thisdrawing 'blocks) layers (vlax-get-property thisdrawing 'layers))(if fillc(progn (setq ll (entget (tblobjname "layer" nlyr)) ll (vl-remove-if '(lambda (x) (vl-position (car x) '(62 420 430))) ll ) ) (entmod (append ll fillc))))(if t0(progn (setq t1 (ea:get-utime)) (princ (strcat "\nConversion to " nlyr " layer successful,Time(secs): ") ) (princ (- t1 t0))))(if all_0 (mapcar '(lambda (x) (set x nil)) all_0)) ) ;_ end progn ) ;_end if ) ;_ end dufun ea:translyr ;;preview (defun ea:pre (/ nl layers str) (if (and (/= llyr nil) (/= llyr "")) (progn(vla-startundomark thisdrawing)(setq nl (mapcar 'atoi (ea:string_parse llyr " ")) nl (mapcar '(lambda (x) (nth x name)) nl) )(vlax-map-collection(vlax-get-property thisdrawing 'layers)'(lambda (l) (if (vl-position (vlax-get-property l 'name) nl) (progn(if (= (vlax-get-property l 'layeron) :vlax-false) (vlax-put-propertyl 'layeron :vlax-true))(if (= (vlax-get-property l 'freeze) :vlax-true) (vlax-put-property l 'freeze :vlax-false)) ) (vlax-put-property l 'layeron :vlax-false) ) ))(vla-endundomark thisdrawing)(setq str (getstring "\nEnter exit...."))(vl-cmdf ".u") ) ) ;_end if (princ) ) ;_ end defunea:per (defun getssLyr (/ ss ssl lyr slyr slst) (princ "\nChoose to merge the layer entities...") (if (setq ss (ssget)) (progn(setq ssl (sslength ss))(while (> ssl 0)(setq lyr (cdr (assoc 8 (entget (ssname ss (setq ssl (1- ssl)))))))(if slyr (if (not (vl-position lyr slyr)) (setq slyr (cons lyr slyr)) ) (setq slyr (list lyr)))) ;_ end while(setq slst (mapcar '(lambda (l) (vl-position l name)) slyr ))(if llyr(setq slst(append slst (mapcar 'atoi (ea:string_parse llyr " ")))))(setq llyr (ea:string_unparse (mapcar 'vl-princ-to-string (vl-sort slst '= what_next 2) (if (not name) (setq name (ea:table "layer")) ) (if (not (new_dialog "ea_lyrtrans" _ealyrtr_id)) (exit) ) (start_list "what") (mapcar 'add_list name) (end_list) (start_list "Sel") (mapcar 'add_list name) (end_list) (if llyr (set_tile "what" llyr) ) (if (and (/= nlyr "") nlyr) (set_tile "Nlyr" nlyr) ) (ea:fillcolor) (if tf (set_tile "color" tf) ) (if tf1 (set_tile "ltyp" tf1) ) (action_tile "Trans" (strcat"(princ \"\nPlease wait, processing.....\")""(setq nlyr (get_tile \"Nlyr\"))""(setq llyr (get_tile \"what\"))""(setq tf (get_tile \"color\"))""(setq tf1 (get_tile \"ltyp\"))""(setq ltf (get_tile \"lay\"))""(done_dialog 4)" ) ) (action_tile "accept" "(done_dialog 1)") (action_tile "lay" "(setq ltf $value)") (action_tile "Nlyr" "(setq nlyr $value)") (action_tile "color" "(setq tf $value)") (action_tile "ltyp" "(setq tf1 $value)") (action_tile "col" "(setq nlyr (get_tile \"Nlyr\"))(ea:chgcolor)(ea:fillcolor)(if fillc(set_tile \"color\" \"0\"))" ) (action_tile "Sel" "(set_tile \"Nlyr\" (nth (atoi $value) name))" ) (action_tile "pre" "(setq nlyr (get_tile \"Nlyr\"))(setq llyr (get_tile \"what\")) (done_dialog 5)" ) (action_tile "list" "(setq llyr (get_tile \"what\"))(done_dialog 6)" ) (action_tile "what" (strcat"(setq nlyr (get_tile \"Nlyr\"))""(setq llyr $value)""(if (= $reason 4)(progn (setq nlyr (get_tile \"Nlyr\"))(setq llyr $value)(done_dialog 5)))" ;_ double click ) ) (setq what_next (start_dialog)) (cond ((= what_next 4) (ea:translyr) ) ((= what_next 5) (ea:pre) ) ((= what_next 6) (getsslyr) ) ) ) ;_end while (unload_dialog _ealyrtr_id) (vla-endundomark thisdrawing) (vlax-release-object thisdrawing) (vlax-release-object oAcad) (if blocks (vlax-release-object blocks)) (if layers (vlax-release-object layers)) (if 0_in (mapcar '(lambda (x) (set (read x) nil)) 0_in)) (setq 0_in nil) (setq *error* olderr) (princ)) ;_end defun(princ "\n\tLayer Merge V2.3, command : TEST. BY eachy")(princ) Who can help me to check this code ?Thanks very much!
页:
[1]