[编程交流] 将选定块定义颜色更改为颜色 2

;;;   File Name: COLOR-TEXT-OBJECTS-IN-SELECTED-BLOCKS-TO-COLOR-2.LSP
;;;   Description:  Changes all the text in selected block definitions to color 2.
;;;   Will skip alfl XREF & XREF dependent blocks. 
;;;

(defun C:CHTXTINSELBLOCKSCOLOR2 (/ ent el s1 blk_name num nval antw atel atoff e1 e2 en tag nl en C SS K CBL BLK CBL2 C ACL ALY NLY EE NCL NEWE eset cntr enlist pt BLKDATA NEWCOLOR NEWLAYER XREFFLAG XDEPFLAG BLKENTNAME COUNT ENTDATA OLDCOLOR BLKENTNAME *ERROR* ERR-UBC LAY_NAME LT OLDERR)

(graphscr)
(setvar "cmdecho" 0)
(command "_undo" "_m")
(prompt "\nCOLOR-TEXT-OBJECTS-IN-SELECTED-BLOCKS-TO-COLOR-2.LSP - Versie 1.0")
(prompt "\nAutoCAD lisp routine voor het selecteren en wijzigen in blocks van de kleur van alle text-objecten in AutoCAD kleur 2 geel")
(prompt "\nBehandelt geen XREF & geneste blokken")
(graphscr)
  (setvar "cmdecho" 0)
  (setvar "attreq" 0)
  (command "undo" "mark")
  (princ "\n\rSelekteer een block waarvan je de attributen kleur wilt aanpassen !")
  (if (setq ent (car (entsel "\n<Wijs een blok aan = Automatisch>  / Enter=handmatig  >>")))
   (progn
    (setq el (entget ent))
    (if (= (cdr (assoc 0 el)) "INSERT")
     (progn
      ;(setq s1 (ssget "x" (list (cons 2 (cdr (assoc 2 el))))))
      (setq blk_name (cdr (assoc 2 el)) lay_name (cdr (assoc 8 el)))
      (setq s1 (ssget "x" (list (cons 2 blk_name) (cons 8 lay_name))))
      (princ (strcat "\nSelekteren van alle blokken:" blk_name " op laag:"lay_name ))

     )
    )
   )
   ;else
   (progn (princ "\n\rSelekteer een blok >>")
    (setq s1 (ssget))
   )
  )
  (if s1
   (progn (setq num (1- (sslength s1)) atoff '())
   (terpri) (terpri)
   (initget 1 "J j N n")
   (setq nval (getstring "\nNieuwe Attribuut kleur NUMMER :"))
   (setq antw (getstring "\Alle attribuut kleuren aanpassen  [J/N]"))
  (if  (or (= antw "N") (= antw "n"))
   (progn (while (setq ent (car (nentsel "\nVan elke attributen moeten de kleuren aangepast worden...>>")))
  (setq atel (entget ent))
   (setq atoff (append atoff (list (cdr (assoc 2 atel))))) ) ) )
  (while  (/= num -1)
   (setq e1 (ssname s1 num))
   (setq e2 (entget e1))
   (if (and (=  (cdr (assoc 66 e2)) 1)
            (= (cdr (assoc 0 e2)) "INSERT")
       )
  (progn
   (prompt"\e[2J")
   (princ (strcat "\rOgenblikje... Nog " (itoa num) " blokken.... " ))
   (setq en (entnext e1) el (entget en))
   (while (/= (cdr (assoc 0 el)) "SEQEND")
    (if (and (member (setq tag (cdr (assoc 2 el))) atoff))
     (progn
;(setq nl (cons 40 nval) ol (assoc 40 el) el (subst nl ol el))
;(entmod el)
     (command  "attedit" "y" "" "" "" (cdr (car el)) "color" nval "")
     )
      (if (or (= antw "J") (= antw "j"))
       (progn
;(setq nl (cons 40 nval) ol (assoc 40 el) el (subst nl ol el))
;(entmod el)
       (command "attedit" "y" "" "" "" (cdr (car el)) "color" nval "")
       )
      )
    )
    (setq en (entnext en) el (entget en))
   )
   (entupd en)
   )
  )
  (setq num (1- num)) ) ) )

(defun err-ubc (s)                                ; If an error (such as CTRL-C) occurs
                                                ; while this command is active...
        (if (/= s "Function cancelled")
                  (princ (strcat "\nError: " s))
        )
        (setq *error* olderr)                        ; Restore old *error* handler
        (princ)
);err-ubc

        (setq olderr *error* *error* err-ubc)
        (initget "?")
        (while
                (or (eq (setq C (getint "\nType nieuw kleur code/<?>: ")) "?")
                    (null C)
                    (> C 256)
                    (< C 0)
                );or
                (textscr)
                (princ "\n                                                           ")
                (princ "\n                 Kleur code     |   Kleur omschrijving     ")
                (princ "\n                ________________|_________________________ ")
                (princ "\n                                |                          ")

                (princ "\n                       2        |      GEEL - YELLOW       ")
                (princ "\n                                               \n\n\n")
                (initget "?")
        );while

                (prompt "\nSelecteer blokken om bij te werken. ")

        (SETQ SS (SSGET '((0 . "INSERT"))))
        (SETQ K 0)
        (WHILE (< K (SSLENGTH SS))
                (setq CBL (tblsearch "BLOCK" (CDR (ASSOC 2 (ENTGET (SETQ BLK (SSNAME SS K)))))))
                (SETQ CBL2 (CDR (ASSOC -2 CBL)))
                (WHILE (BOUNDP 'CBL2)
                        (SETQ EE (ENTGET CBL2))

                        ;Update layer value
                         (SETQ NCL (CONS 62 C))
                        (SETQ ACL (ASSOC 62 EE))
                        (IF (= ACL nil)
                                (SETQ NEWE (APPEND EE (LIST NCL)))
                                (SETQ NEWE (SUBST NCL ACL EE))
                        );if
                        (ENTMOD NEWE)

                        (SETQ CBL2 (ENTNEXT CBL2))
                );end while
                (ENTUPD BLK)
                (SETQ K (1+ K))
        );end while
        (setq *error* olderr)
        (princ)
;)

(setq eset
(ssget
(list
(cons -4 "<OR")
(cons 0 "MTEXT")
(cons 0 "TEXT")
(cons -4 "OR>")
)
)
)
(if (and eset (> (sslength eset) 0))
(progn
(setq cntr 0 lt (getvar "dimscale"))
(while(< cntr (sslength eset))
(setq en(ssname eset cntr))
(setq enlist(entget en))
(setq pt(cdr(assoc 10 enlist)))
(grclear)
(redraw)
(grdraw pt (setq pt(polar pt 2.9671 (* lt 12.2080))) 90 -1)
(grdraw pt (setq pt(polar pt 0.7854 (* lt 4.5020))) 90 -1)
(grdraw pt (setq pt(polar pt 2.3562 (* lt 20.0000))) 90 -1)
(grdraw pt (setq pt(polar pt 0.7854 (* lt 5.0000))) 90 -1)
(grdraw pt (setq pt(polar pt 5.4978 (* lt 20.0000))) 90 -1)
(grdraw pt (setq pt(polar pt 0.7854 (* lt 4.5020))) 90 -1)
(grdraw pt (setq pt(polar pt 4.8869 (* lt 12.2080))) 90 -1)
(command "CHANGE" en "" "Properties" "Color" "2" "")
(grdraw pt (setq pt(polar pt 2.9671 (* lt 12.2080))) 90 -1)
(grdraw pt (setq pt(polar pt 0.7854 (* lt 4.5020))) 90 -1)
(grdraw pt (setq pt(polar pt 2.3562 (* lt 20.0000))) 90 -1)
(grdraw pt (setq pt(polar pt 0.7854 (* lt 5.0000))) 90 -1)
(grdraw pt (setq pt(polar pt 5.4978 (* lt 20.0000))) 90 -1)
(grdraw pt (setq pt(polar pt 0.7854 (* lt 4.5020))) 90 -1)
(grdraw pt (setq pt(polar pt 4.8869 (* lt 12.2080))) 90 -1)
(setq cntr(+ cntr 1))
)
)
)
(alert (strcat "Aantal gewijzigde text-veld-objecten en/of Mtext-veld-objecten: " (itoa cntr) "."))
(grclear)
(redraw)

(command ".undo" "group")
   (setq BLKDATA (tblnext "BLOCK" t))
   (setq NEWCOLOR (cons 62 2))  ;this will set 62 (color) to 2
;   (setq NEWLAYER (cons 8 "0"))  ;this will set 8 (layer) to 0
   ; While there is an entry in the block table to process, continue
   (while BLKDATA
      (prompt "\nRedefining colors for block: ")
      (princ (cdr (assoc 2 BLKDATA)))
      ; Check to see if block is an XREF or is XREF dependent
      (setq XREFFLAG (assoc 1 BLKDATA))
      (setq XDEPFLAG (cdr (assoc 70 BLKDATA)))
      ; If block is not XREF or XREF dependent, i.e., regular block, then proceed.
      (if (and (not XREFFLAG) (/= (logand XDEPFLAG 32) 32))
         (progn
            (setq BLKENTNAME (cdr (assoc -2 BLKDATA)))
            (setq COUNT 1)
            (terpri)
            ; As long as we haven't reached the end of the block's defintion, get the data
            ; for each entity and change its color assignment to BYLAYER.
            (while BLKENTNAME
               (princ COUNT)
               (princ "\r")
               (setq ENTDATA (entget BLKENTNAME)); get entities data 
               (setq OLDCOLOR (assoc 62 ENTDATA))  ;get entities old color value
               (if OLDCOLOR                         ; if value exist (null = bylayer)
                  (entmod (subst newcolor oldcolor ENTDATA)) ; substitute old color to byblock
                  (entmod (cons newcolor ENTDATA))      ; modify ent data w/ byblock values
               )
               (setq BLKENTNAME (entnext BLKENTNAME)) ;if attributes exist, then edit next one
               (setq COUNT (+ COUNT 1));
            ) ;end while for attribute trap
         ) ;progn
         (progn
            (princ "    XREF...skipping!")
         ) ;progn
      );end if not an Xref
      (setq BLKDATA (tblnext "BLOCK")) ;next block please
   ) ;end while loop of blk data available to edit
(command ".undo" "end")
(command ".regen")
(setvar "cmdecho" 1)
(prompt "\nDe AutoCAD-selecteren-en-wijzigen-van-de-kleur-van-text-objecten-in-blocks-naar-AutoCAD-kleur-2-geel-routine opdracht is beëindigd, er zijn geen objecten meer geselecteerd. Start de routine opnieuw met AutoCAD commando: CHTXTINSELBLOCKSCOLOR2")
(princ)
)
(princ "\nCOLOR-TEXT-OBJECTS-IN-SELECTED-BLOCKS-TO-COLOR-2.LSP - AutoCAD lisp routine wijzigt in geselcteerde blocks de tekst kleur in geel. AutoCAD kleur 2.")
(princ "\nStart deze AutoCAD-trim-routine met AutoCAD commando: chtxtinselblockscolor2")
(princ)