AUTOCAD中的几个LISP程序
合集下载
相关主题
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
(setvar "CMDECHO" cmdmode) ) (princ "\n\tc: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")
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 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 "\n\tc:arn loaded. Start command with arn.") 3.修改编号 作图时，常常需要对图中的物体进行编号，有时会在已编好号的物体中插入几个物体，那么
(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 (<= i number) (>= 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 "\n\tc:chnumber loaded. Start command with chn.") 4.自动画管线图的小程序 画一些管路原理图时，常常有许多管路在图中相交，而这些管路实际并不相连。我们常把在
在这之后的编号都需作相应的增加。对于比较多的编号，一个个的寻找再修改就很麻烦，下
面这个程序可以自动完成对编号的寻找及修改过程。
为了能够清楚的看清要改变的数字及及其所处的位置，用变量“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(getint"\nThe number from which to change:")) (setq j(getint"\nThe number to which to add:")) (setq k(getint"\nHow much you want to add:")) (setq ssl (sslength sset))
wenku.baidu.com
(setq total (+ total number)) ) ) ;显示和及加数的个数，便于用户检查是否多选或漏选。 (princ "\nThe total is ") (princ total) (princ "of the ") (princ ssl1) (princ "numbers\n") ) )
相交点处次要的管路断开，在用一半圆连接两断点，下面的程序可以帮助大家完成做这一繁
琐的工作。
程序中使用“break”命令截断需要被断开的管线，再用“arc”命令画一半圆连接两断点。 变量 p 读取管线交点；p1、p2 为点 p 的左右或上下两点；p3 为连接 p1、p2 半圆的中点。由 于使用“break”命令时若 AUTOCAD 环境处于对象捕捉方式（OSMODE≠0），则“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 " Direction[H/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) (- (cadr p) 1.5))) (setq p2 (list (car p) (+ (cadr p) 1.5))) (setq p3 (list (+ (car p) 1.5) (cadr p))) ) ) (command "break" p1 p2) (command "arc" p1 p3 p2) (setvar "OSMODE" myosmode) (princ) ) (princ "\nStart command with brel which will break a line and join it with an arc.")
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 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 "\n\tc:arn loaded. Start command with arn.") 3.修改编号 作图时，常常需要对图中的物体进行编号，有时会在已编好号的物体中插入几个物体，那么
(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 (<= i number) (>= 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 "\n\tc:chnumber loaded. Start command with chn.") 4.自动画管线图的小程序 画一些管路原理图时，常常有许多管路在图中相交，而这些管路实际并不相连。我们常把在
在这之后的编号都需作相应的增加。对于比较多的编号，一个个的寻找再修改就很麻烦，下
面这个程序可以自动完成对编号的寻找及修改过程。
为了能够清楚的看清要改变的数字及及其所处的位置，用变量“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(getint"\nThe number from which to change:")) (setq j(getint"\nThe number to which to add:")) (setq k(getint"\nHow much you want to add:")) (setq ssl (sslength sset))
wenku.baidu.com
(setq total (+ total number)) ) ) ;显示和及加数的个数，便于用户检查是否多选或漏选。 (princ "\nThe total is ") (princ total) (princ "of the ") (princ ssl1) (princ "numbers\n") ) )
相交点处次要的管路断开，在用一半圆连接两断点，下面的程序可以帮助大家完成做这一繁
琐的工作。
程序中使用“break”命令截断需要被断开的管线，再用“arc”命令画一半圆连接两断点。 变量 p 读取管线交点；p1、p2 为点 p 的左右或上下两点；p3 为连接 p1、p2 半圆的中点。由 于使用“break”命令时若 AUTOCAD 环境处于对象捕捉方式（OSMODE≠0），则“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 " Direction[H/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) (- (cadr p) 1.5))) (setq p2 (list (car p) (+ (cadr p) 1.5))) (setq p3 (list (+ (car p) 1.5) (cadr p))) ) ) (command "break" p1 p2) (command "arc" p1 p3 p2) (setvar "OSMODE" myosmode) (princ) ) (princ "\nStart command with brel which will break a line and join it with an arc.")