《很好用的结构lisp》由会员分享，可在线阅读，更多相关《很好用的结构lisp（8页珍藏版）》请在金锄头文库上搜索。
1、(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“ “
2、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“ “) )
3、(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-del
4、ete g)(command “purge“ “all“ “ “n“) )(defun c:sd (/ a b ent ent2 elist etypeoldval bltxt entdata btxt ostrpt oltxt)(princ “n * 文字替换程序 * Writen by 赵“)(princ “n 请选择复制源文字目标:“)(setq ent (nentsel)(if (= ent nil)(setq oldval (getstring “n 请输入文字:“ c)(progn(setqent2 entelist (entget (car ent)etype (cdr (ass
5、oc 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)(set
6、q 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)(entmod (subst (cons 1 btxt) (assoc 1 entdata) entdata)(if(setq bltxt (car (reve
7、rse (cadddr bltxt)(entupd bltxt) )(princ “n 原文字为:“)(princ oltxt)(princ “. 已被替换为: “)(princ oldval)(princ “ .“)(princ);(defun c:ef (/ p1 p2 ) ; (princ “n 画钢筋“) ; (setq p1 (getpoint “n 起点:“) ; (setq p2 (getpoint p1 “n 下一点:“) ; (setq clayer (getvar “clayer“) ; (command “layer“ “m“ “rein“ “) ; (command “
8、pline“ p1 “w“ “40“ “ p2 ; PAUSE) ; (setvar “clayer“ clayer); (princ) ;);(defun c:pu () ; (princ); (command “purge“ “all“ “ “n“) ;);(defun C:cf () ; (princ “改变目标为指定层n“) ; (setq p (ssget) ; (setq 1(“thin“) ; 2(“text“) ; 3(“dim“) ; ) ; (setq lay (getstring “输入目标层名: “) ; (command “change“ p “ “p“ “la“ l
9、ay “) ;);打开所有层; (defun c:laa ( )(command “layer“ “on“ “*“ “) ;copy layer entities to another layer ;layer copy (defun c:lac (/ ss nm e la)(print “ obj:“)(setq ss(ssget)(setq nm (car (entsel “n target objects for new layer:“)e (entget nm)la (cdr (assoc 8 e)(command “copy“ ss “ “0,0“ “0,0“ “change“ ss
10、 “ “p“ “la“ la “) ) ;设目标实体所在图层为当前层并关其它层 (defun c:lao (/ e n n1 nn)(setq e (car (entsel “nobject for layer/on:“)n (cdr (assoc 8 (entget e) n1 n nn n)(while (setq e (car (entsel “nobject for orther layer/on:“)(setq n (cdr (assoc 8 (entget e)nn (strcat nn “,“ n)(command “layer“ “s“ n1 “off“ “*“ “ “on“
11、nn “) ) ;设目标实体所在图层 (defun c:las (/ e)(setq e (car (entsel “nobject for layer-set:“)lan (cdr (assoc 8 (entget e)(command “layer“ “s“ lan “) ) ;解锁目标实体所在图层 ;(defun c:lau (/ e n) ; (while (setq e (car (entsel “nobject for unlock-layer:“) ; (progn ; (setq n (cdr (assoc 8 (entget e) ; (command “layer“ “u“
12、 n “) ;);(vl-load-com)(defun dxf(a b)(cdr(assoc a b)(command“undo“group“)(if(and(setq ss(ssget (0 . “INSERT“)(setq new(getstring “n 名称:“)(not(tblsearch “block“ new) )(progn(setq old(dxf 2(entget(ssname ss 0)(command “-insert“ old (0 0) “1“1“ 0)(command “explode“(entlast)(command “-block“ new (0 0)“P
13、“ “)(setq j 0)(repeat(sslength ss)(setq e(ssname ss j)en(entget e)en(subst(cons 2 new)(assoc 2 en)en)(entmod en)(setq j(1+ j)(command“undo“end“)(princ)(defun C:Z=0 () (setvar “cmdecho“ 0) (princ “n 正在处理图形数据,请稍候.“) (command “_.UCS“ “) (command “_.move“ “_all“ “ (0 0 1e99) “ “_.move“ “_p“ “ (0 0 -1e99
14、) “) (princ “nOK,已将所有图元的标高值即 Z 坐标归零.“)(setvar “cmdecho“ 1) (princ) );end (defun C:Z=0 ()(defun c:os()(princ )(command “osmode“ 695) )(defun C:mk (/ ss )(princ “nSelect objects: “)(setvar “blipmode“ 1)(setq ss (ssget)(setq p1 (getpoint “n 起点:“)(setq p2 (getpoint “n 下一点:“)(command “mirror“ ss “ p1 p2
15、“y“ )(setvar “blipmode“ 0) ) (defun C:OI ()(setvar “blipmode“ 1)(setq ss (ssget)(setq d (getdist “n 距离:“)(if (null d)(setq d 250.0)(setq p1 (getpoint “哪侧:“)(command “OFFSET“ d ss p1 “)(setvar “blipmode“ 0)(command “erase“ “p“ “)(DEFUN C:Z0 (/ SSS1 n s1 old1 new1 s2 old2 new2 )(prompt “nr 加载 Z 轴坐标归零程序。“)(cmdla0)(princ“nt 将线 Z 轴坐标归零。“)(princ“nt 选择实体: “)(while(not(SETQ SSS1 (ssget)(setq n 0)(while (setq s1 (ssname SSS1 n) (SETQ OLD1 (ASSOC 10 (entget S1)(SETQ NEW1 (list 10 (cadr old1)(caddr old1) 0)(SETQ
