[编程交流] error: An error has occurred i

Please wait, processing.....*cancel*; error: An error has occurred inside the *error* functionbad argument type: symbolp 1

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;       }     }  }}

;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_unparse  ea:pross      ea:get-utime  RGBtoOLE_color  OLEtoRGB_color       RGBtoACI  ea:getcecolor ea:chglyrcolor  ea:translyr   ea:chgcolor   ea:fillcolor  ea:pre        ea:table      getsslyr  myerr        mknewlyr      ea:clearcset  thisdrawing   blocks      layers  name        nullss      olderr  ltf        nlyr      llyr  fillc        tf      tf1  _$ver        _ealyrtr_id   what_next  oAcad        x  tmp 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:chgattblk  ea:chg_ssget_blockdef  ea:chg_not_ssget_blockdef     llyrc  lt        t0       nl  filter        cset       l  n        s       sl  t1        blst       ll  lt        x       nllyr  0colorobj      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 obj  nlyr)  ) ;_ end if  ;;Restore color  (if (= tf "1") ;_keep    (cond      ((and mark     (= alyr "0") ;     (= cl 256) ;_ bylayer       )       (if _$ver  (progn    (vla-put-colorindex colobj  acByblock) ;    (vla-put-truecolor obj ' colobj)  )  (vla-put-color obj  0)       ) ;_ byblock      )      ((and (/= alyr nlyr) (= cl 256)) ;        (if _$ver  (vla-put-truecolor obj  colobj)  (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 obj  colobj)      )      (vla-put-color obj  256)    )  ) ;_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-collection  layers  '(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-hasattributes  x) :vlax-true)       (ea:chgattblk x nil)     )    )    (t (ea:chg_layer_color_ltyp_0 x nil))  )  (setq n (1+ n))       )    )  ) ;_ while) ;_ end progn

 (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-property  l '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 defun  ea: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[www.xdcad.net]")(princ)