AUTOCAD中的几个LISP程序.doc

AUTOCAD中的几个LISP程序李敬 - 机械制图中，常常得做许多大量的重复工作。下面这几个用Lisp编写得程序，是我画图时经常使用的，节省了我的不少时间，希望也能帮助广大使用AUTOCAD的工程师们。 1.自动求和 机械制图中材料表的填写是毕不可少的，填写完后还需根据材料表求出总重量。一般一幅图中常有几十个物体，将这些重量一项一项相加个繁琐的过程，而且容易出错。使用下面这个程序，只需用鼠标选定需要相加的数，其和就会自动的显示在命令行中。 因为在AUTOCAD中没有“数”这种实体，所有的数都以实体“TEXT”存在，所以程序中使用了“atof”函数，将以字符串形式表示的数转换为实数。 (defun c:total( / cmdmode sset ssl nsset temp ssl1 total) (if *error* quit) (setq cmdmode (getvar cmdecho) (setvar cmdecho 0) (prompt nSelect numbers to add: ) (setq sset (ssget) (if (null sset) (princ nError: Nothing selected!n) ;过滤出选中的“text”实体，并报告有多少“text”实体被选中。 (progn (setq ssl (sslength sset) (setq nsset (ssadd) (while ( ssl 0) (setq temp (ssname sset (setq ssl(1- ssl) (if (= (cdr (assoc 0 (entget temp) TEXT) (ssadd temp nsset) ) ) (setq ssl (sslength nsset) (print ssl) (princ text entities are found.) ;选出所有可转化为数的“TEXT”，并求和。 (setq total 0) (setq ssl1 ssl) (while ( ssl 0) (setq temp (ssname nsset (setq ssl (1- ssl) (setq number (atof(cdr(assoc 1 (entget temp) (if (= 0 number) (setq ssl1 (1- ssl1) (setq total (+ total number) ) ) ;显示和及加数的个数，便于用户检查是否多选或漏选。 (princ nThe total is ) (princ total) (princ of the ) (princ ssl1) (princ numbersn) ) ) (setvar CMDECHO cmdmode) ) (princ ntc:total loaded. Start command with total.) 2.自动生成递增数 用CAD作图时，常需画一些距离一定、数值递增的数。如填写材料表时，“序号”一栏就需填写由下至上的递增数。通常，我们先用“text”命令写一个数，再用“array”命令将其按一定方向阵列，最后用“edit”命令一个一个的改正。下面这个程序可将你从这单调重复的动作中解放出来。 (defun c:arn( / ent temp d a number yorn) (setq cmdmode (getvar cmdecho) (setvar cmdecho 0) ;选择一个实体，并判断能否作为生成递增数的初始数。 (setq ent (entsel nSelect number to arn: ) (if (null ent) (progn (princ nError: Nothing selected!n) (exit) ) ) (setq temp (entget (car ent) (if (= (cdr (assoc 0 temp) TEXT) ;输入生成递增数的个数、数间距及其方向。 (progn (setq number(getint Number of texts:) (setq d(getdist Dist between texts:) (setq a (atoi(cdr(assoc 1 temp) (initget 1 V H) (setq yorn (getkword Direction(V/H)?) (if (= yorn V) (setq p (list 0 d) ) (if (= yorn H) (setq p (list d 0) ) ;重复拷贝前一个数，并将拷贝数加1。 (while (/= number 1) (command copy ent p ) (setq ent (entlast) (setq temp (entget ent) (setq a (+ a 1) (entmod (subst (cons 1 (itoa a) (assoc 1 temp) temp) (setq number (1- number) ) ) ) (setvar CMDECHO cmdmode) ) (princ ntc:arn loaded. Start command with arn.) 3.修改编号 作图时，常常需要对图中的物体进行编号，有时会在已编好号的物体中插入几个物体，那么在这之后的编号都需作相应的增加。对于比较多的编号，一个个的寻找再修改就很麻烦，下面这个程序可以自动完成对编号的寻找及修改过程。 为了能够清楚的看清要改变的数字及及其所处的位置，用变量“h”记录数字的高度，变量“viewctr”及“viewsize”记录了使用命令前的视窗中心及其大小。 (defun c:chn( / cmdmode viewctr viewsize sset i j k ssl nsset temp ent number x1 y1 x y h yorn) (defun *error*(s) (exit) ) (setq cmdmode (getvar cmdecho) (setvar cmdecho 0) (setq viewctr (getvar viewctr) (setq viewsize (getvar viewsize) (prompt nSelect numbers to add: ) (setq sset (ssget) (if (null sset) (progn (princ nError: Nothing selected!n) (exit) ) ) ;根据用户指定范围过滤出需要改变的编号，并报告找到多少编号。 (setq i(getintnThe number from which to change:) (setq j(getintnThe number to which to add:) (setq k(getintnHow much you want to add:) (setq ssl (sslength sset) (setq nsset (ssadd) (while ( ssl 0) (setq temp (ssname sset (setq ssl(1- ssl) (if (= (cdr (assoc 0 (entget temp) TEXT) (progn (setq number (atoi(cdr(assoc 1 (entget temp) (if(and (= j number) (ssadd temp nsset) ) ) ) (setq ssl (sslength nsset) (if (= ssl 0) (progn princ(nNo numbers selected!) (exit) (print ssl) (princ numbers are found.) ;使被改变编号以一定大小处于屏幕中心位置并被高亮度显示， ;改变每个编号前先询问用户，以免改变了不想改变的编号。 (setq x1 (car viewctr) (setq y1 (cadr viewctr) (setq ent (entget (ssname nsset (- ssl 1) (setq h (cdr(assoc 40 ent) (while ( ssl 0) (setq ent(entget (ssname nsset (setq ssl (1- ssl) (setq x (cadr(assoc 10 ent) (setq y (caddr(assoc 10 ent) (if (or ( (abs (- x x1) (* h 10) ( (abs (- y y1) (* h 6) (progn (command zoom c (list x y ) (* h 20) ) (setq x1 x) (setq y1 y) ) ) (redraw (cdr(assoc -1 ent) 3) (initget 1 Yes No) (setq number (atoi(cdr(assoc 1 ent) (princ nThe number ) (princ number) (setq yorn (getkword to be Changed?(y/n) (if (= yorn Yes) (entmod (subst (cons 1 (itoa(+ number k) (assoc 1 ent) ent) ) (redraw (cdr(assoc -1 ent) 1) ) ;所有编号改变完成后，恢复使用本命令前的视窗。 (command zoom c viewctr viewsize) (setvar CMDECHO cmdmode) ) (princ ntc:chnumber loaded. Start command with chn.) 4.自动画管线图的小程序 画一些管路原理图时，常常有许多管路在图中相交，而这些管路实际并不相连。我们常把在相交点处次要的管路断开，在用一半圆连接两断点，下面的程序可以帮助大家完成做这一繁琐的工作。 程序中使用“break”命令截断需要被断开的管线，再用“arc”命令画一半圆连接两断点。变量p读取管线交点；p1、p2为点p的左右或上下两点；p3为连接p1、p2半圆的中点。由于使用“break”命令时若AUTOCAD环境处于对象捕捉方式（OSMODE0），则“break”命令截断的p1、p2两点可能为变为p1、p2附近的捕捉点。所以程序开始时用变量myosmode记录系统变量OSMODE，而后设置OSMODE为0，程序结束后再设置还原OSMODE。变量horn判断用户需要断开的是水平线还是垂直线。 (defun c:brel(/myosmode horv p p1 p2 p3) (setq myosmode (getvar OSMODE) (setvar OSMODE 0) (setq p (getpoint nSelect point to break:) (initget 1 H V) (setq horv (getkword DirectionH/V?) (if (= horv H) (progn (setq p1 (list (- (car p) 1.5) (cadr p) (setq p2 (list (+ (car p) 1.5) (cadr p) (setq p3 (list (car p) (+ (cadr p) 1.5) ) (progn (setq p1 (list (car p) (- (cad