将选定块定义颜色更改为颜色 2
这是开发中的 lisp 例程。将选定块定义中的所有文本更改为颜色 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"))
(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)
页:
[1]