很好用的结构lisp.docVIP

(defun c:u1 () (princ \n设置角度) (setq p1 (getpoint \n起点:)) (setq p2 (getpoint \n终点:)) (command ucs z p1 p2 ) ) (defun c:u2 () (command ucs w ) ) (defun c:u3 () (princ \n设置角度) (setq p1 (getpoint \n起点:)) (setq p2 (getpoint \n终点:)) (command ucs z p1 p2 plan )) (defun c:us () (command ucs w plan )) (defun c:zd () (command zoom d)) (defun c:hz () (princ) (command -layer f * t hatch DRAWORDER all b -layer t * ) ) (defun c:ep() (command explorer) ) (defun c:as () (setq p1 (getpoint \n起点:)) (setq p2 (getpoint p1 \n下一点:)) (command line p1 p2 pause trim ) ) (defun C:Pu (/ gnList doc groups g) (princ \n此程序搜索不包含任何物体的空组并清除之\n ) (princ) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (setq groups (vla-get-groups doc)) (vlax-for g groups (princ \n分析组：) (princ (vla-get-name g)) (if (= (vla-get-count g) 2) (progn (princ (strcat ......删除空组 (vla-get-name g))) (vla-delete g) ) ) ) (command purge all n) ) (defun c:sd (/ a b ent ent2 elist etype oldval bltxt entdata btxt ostr pt oltxt) (princ \n ******* 文字替换程序 ******* Writen by 赵) (princ \n 请选择复制源文字目标:) (setq ent (nentsel)) (if (= ent nil) (setq oldval (getstring \n 请输入文字: c)) (progn (setq ent2 ent elist (entget (car ent)) etype (cdr (assoc 0 elist)) ) (setq oldval (cdr (assoc 1 elist))) (princ \n ) (princ \n复制文字内容为: ) (princ oldval) ) ) (setq q 9) (while q (princ \n ) (setq bltxt (nentsel \n请选择需要替换的文字目标:)) (if (= bltxt nil) (setq q nil) (progn (setq entdata (entget (car bltxt)) btxt (cdr (assoc 1 entdata)) ostr btxt ) (setq elist (entget (car bltxt))) (setq etype (cdr (assoc 0 elist))) ;; (setq oltxt (car (assoc 1 elist))) (setq oltxt (cdr (assoc 1 elist))) (if (= etype ATTRIB) (progn (setq pt (cadr bltxt)) (command .attedit pt V R oldval n) ) (progn (setq btxt oldval) (entm