(setq ln (sslength ss1)) (setq n 0) (repeat ln (setq na (ssname ss1 n)) (setq ent (entget na)) (setq oldt1 (assoc 1 ent)) (setq oldt (cdr oldt1)) (setq newt (strcat oldt ht)) (setq newt1 (cons 1 newt)) (setq ent (subst newt1 oldt1 ent)) (entmod ent) (setq n (+ n 1)) );repeat
);while ) (defun chgterr (s) (if (/= s "Function cancelled") ; If an error (such as CTRL-C) occurs (princ (strcat "\nError: " s)) ; while this command is active... ) (setq p nil) ; Free selection set (setq *error* olderr) ; Restore old *error* handler (princ) ) (defun C:CHT(/ p l n e os as ns st s nsl osl sl si chf chm olderr) (setq olderr *error* ; Initialize variables *error* chgterr chm 0) (setq p (ssget)) ; Select objects (if p (progn ; If any objects selected (while (< 0 (setq osl (strlen (setq os (getstring t "查找字串: "))))) ;while1 begain (setq nsl (strlen (setq ns (getstring t "替换字串: ")))) (setq l 0 n (sslength p)) (while (< l n) ; For each selected object... while2 begain (if (= "TEXT" ; Look for TEXT entity type (group 0) (cdr (assoc 0 (setq e (entget (ssname p l)))))) (progn (setq chf nil si 1) (setq s (cdr (setq as (assoc 1 e)))) (while (= osl (setq sl (strlen (setq st (substr s si osl))))) (if (= st os) (progn (setq s (strcat (substr s 1 (1- si)) ns (substr s (+ si osl)))) (setq chf t) ; Found old string (setq si (+ si nsl)) ) (setq si (1+ si)) ) ) (if chf (progn ; Substitute new string for old (setq e (subst (cons 1 s) as e)) (entmod e) ; Modify the TEXT entity (setq chm (1+ chm)) )) ) ) (setq l (1+ l)) ) ;while2 end (princ (strcat "共找到字串'" os "'" (rtos chm 2 0) "次\n")) ; Print total lines changed (setq chm 0) ) ;while1 end ) ;progn end ) ;if end (terpri) (setq *error* olderr) ; Restore old *error* handler (princ "查找完成......") (princ) ) ;defun end
全部回复（2 ）
只看楼主 我来说两句抢地板回复 举报
(prin1 "图层开关操做程序:1是关闭所选实体所在的层;2是打开所有层命令;3是关闭除选择实体所在层以外的图层;4~7是图层的锁操作与1~3雷同,在Autocad环境下加载后即可用,也可以把程序加在acad2000.lisp~acad2006.lisp文件的结尾每次打开图形文件自动加载")
(princ " 图层操作程序由朱子德编写 All rights reserved 请打1,2,3,4,5,6 或7")
(defun c:1()
(while t
(prin1 "请选择要关闭层的实体")
(setq ss0 (ssget))
(setq yv (getvar "clayer"))
(setq ln (sslength ss0))
(setq n 0)
(repeat ln
(setq na (ssname ss0 n))
(setq ent (entget na))
(setq cen (assoc 8 ent))
(setq cenn (cdr cen))
(if (= cenn yv) (command "layer" "off" cenn "y" "")
(command "layer" "off" cenn "")
);if
(setq n (+ n 1))
);repeat
);while
)
(defun c:2()
(command "layer" "on" "*" "")
)
(defun c:3()
(prin1 "请选择不关闭层的实体")
(setq ss0 (ssget))
(command "layer" "off" "*" "y" "")
(setq ln (sslength ss0))
(setq n 0)
(repeat ln
(setq na (ssname ss0 n))
(setq ent (entget na))
(setq cen (assoc 8 ent))
(setq cenn (cdr cen))
(command "layer" "on" cenn "")
(setq n (+ n 1))
);repeat
)
(defun c:4()
(while t
(prin1 "请选择要上琐层的实体")
(setq ss0 (ssget))
(setq ln (sslength ss0))
(setq n 0)
(repeat ln
(setq na (ssname ss0 n))
(setq ent (entget na))
(setq cen (assoc 8 ent))
(setq cenn (cdr cen))
(command "layer" "lock" cenn "")
(setq n (+ n 1))
);repeat
)
)
(defun c:5()
(while t
(prin1 "请选择要解琐层的实体")
(setq ss0 (ssget))
(setq ln (sslength ss0))
(setq n 0)
(repeat ln
(setq na (ssname ss0 n))
(setq ent (entget na))
(setq cen (assoc 8 ent))
(setq cenn (cdr cen))
(command "layer" "unlock" cenn "")
(setq n (+ n 1))
);repeat
)
)
(defun c:6()
(prin1 "请选择不上锁层的实体")
(setq ss0 (ssget))
(command "layer" "lock" "*" "")
(setq ln (sslength ss0))
(setq n 0)
(repeat ln
(setq na (ssname ss0 n))
(setq ent (entget na))
(setq cen (assoc 8 ent))
(setq cenn (cdr cen))
(command "layer" "unlock" cenn "" )
(setq n (+ n 1))
);repeat
)
(defun c:7 ()
(command "layer" "unlock" "*" "")
)
(defun c:qt()
(setq qt (getstring"在文字前增加新的字串"))
(princ "选择要替代的字串")
(while t
(setq ss1 (ssget (list (cons 0 "TEXT")) ))
(setq ln (sslength ss1))
(setq n 0)
(repeat ln
(setq na (ssname ss1 n))
(setq ent (entget na))
(setq oldt1 (assoc 1 ent))
(setq oldt (cdr oldt1))
(setq newt (strcat qt oldt))
(setq newt1 (cons 1 newt))
(setq ent (subst newt1 oldt1 ent))
(entmod ent)
(setq n (+ n 1))
);repeat
);while
)
(defun c:ht()
(setq ht (getstring"在文字后增加新的字串"))
(princ "选择要替代的字串")
(while t
(setq ss1 (ssget (list (cons 0 "TEXT")) ))
(setq ln (sslength ss1))
(setq n 0)
(repeat ln
(setq na (ssname ss1 n))
(setq ent (entget na))
(setq oldt1 (assoc 1 ent))
(setq oldt (cdr oldt1))
(setq newt (strcat oldt ht))
(setq newt1 (cons 1 newt))
(setq ent (subst newt1 oldt1 ent))
(entmod ent)
(setq n (+ n 1))
);repeat
);while
)
(defun chgterr (s)
(if (/= s "Function cancelled") ; If an error (such as CTRL-C) occurs
(princ (strcat "\nError: " s)) ; while this command is active...
)
(setq p nil) ; Free selection set
(setq *error* olderr) ; Restore old *error* handler
(princ)
)
(defun C:CHT(/ p l n e os as ns st s nsl osl sl si chf chm olderr)
(setq olderr *error* ; Initialize variables
*error* chgterr
chm 0)
(setq p (ssget)) ; Select objects
(if p
(progn ; If any objects selected
(while (< 0 (setq osl (strlen (setq os (getstring t "查找字串: "))))) ;while1 begain
(setq nsl (strlen (setq ns (getstring t "替换字串: "))))
(setq l 0 n (sslength p))
(while (< l n) ; For each selected object... while2 begain
(if (= "TEXT" ; Look for TEXT entity type (group 0)
(cdr (assoc 0 (setq e (entget (ssname p l))))))
(progn
(setq chf nil si 1)
(setq s (cdr (setq as (assoc 1 e))))
(while (= osl (setq sl (strlen
(setq st (substr s si osl)))))
(if (= st os)
(progn
(setq s (strcat (substr s 1 (1- si)) ns
(substr s (+ si osl))))
(setq chf t) ; Found old string
(setq si (+ si nsl))
)
(setq si (1+ si))
)
)
(if chf (progn ; Substitute new string for old
(setq e (subst (cons 1 s) as e))
(entmod e) ; Modify the TEXT entity
(setq chm (1+ chm))
))
)
)
(setq l (1+ l))
) ;while2 end
(princ (strcat "共找到字串'" os "'" (rtos chm 2 0) "次\n")) ; Print total lines changed
(setq chm 0)
) ;while1 end
) ;progn end
) ;if end
(terpri)
(setq *error* olderr) ; Restore old *error* handler
(princ "查找完成......")
(princ)
) ;defun end
回复 举报