几个lisp程序范例
用LISP语言自定义AutoCAD命令
用LISP语言自定义AutoCAD命令LISPAutoCADAutoLISP语言作为AutoCAD的二次开发工具，虽然在功能、运行速度和保密性等方面比起ARX等工具要逊色一些，但由于它易学易用，交互性好，灵活性强，对于那些经常使用AutoCAD进行绘图的普通用户来说，不失为一种理想的开发工具。
下面就介绍用AutoLISP语言自定义的几个AutoCAD绘图命令，可以起到简化操作、提高作图效率的作用。
一、键槽尺寸视图的绘制命令“jct”在绘制轴、齿轮或带轮等零件图时，经常需要画轴上键槽处的剖视图或轮毂键槽的端面视图，比较麻烦；由于键槽的尺寸随轴径的变化而变化，所以我们可以用LISP程序来实现自动绘图。
加载下面的程序，在命令行中键入”jct”并回车，通过人机交互的形式输入有关参数，可自动完成轴上键槽的剖视图和轮毂键槽的端面视图的绘制。
代码示例如下所示。
(defun C:jct ()(setq pt0 (getpoint "\n 请输入视图的中心位置点:"))(initget 7)(setq loop T)(while loop(setq d (getreal "\n 请输入键槽处的轴径(12<d<130)(mm):"))(if(or (< d 12) (> d 130))(alert "轴径数据输入错误!\n\n请重新输入!")(setq loop nil));if);while(cond;根据轴径检索键槽尺寸((and (> d 12) (<= d 17)) (setq b 5 t1 3.0 t2 2.3));b表示键槽的宽度((and (> d 17) (<= d 22)) (setq b 6 t1 3.5 t2 2.8));t1表示轴上键槽的深度((and (> d 22) (<= d 30)) (setq b 8 t1 4.0 t2 3.3));t2表示轮毂上键槽的高度((and (> d 30) (<= d 38)) (setq b 10 t1 5.0 t2 3.3))((and (> d 38) (<= d 44)) (setq b 12 t1 5.0 t2 3.3))((and (> d 44) (<= d 50)) (setq b 14 t1 5.5 t2 3.8))((and (> d 50) (<= d 58)) (setq b 16 t1 6.0 t2 4.3))((and (> d 58) (<= d 65)) (setq b 18 t1 7.0 t2 4.4))((and (> d 65) (<= d 75)) (setq b 20 t1 7.5 t2 4.9))((and (> d 75) (<= d 85)) (setq b 22 t1 9.0 t2 5.4))((and (> d 85) (<= d 95)) (setq b 25 t1 9.0 t2 5.4))((and (> d 95) (<= d 110)) (setq b 28 t1 10.0 t2 6.4))((and (> d 110) (<= d 130)) (setq b 32 t1 11.0 t2 7.4)))(command "circle" pt0 "d" d)(command "zoom" "a")(setq s1 (ssget "l" ))(setq di (-(* (/ d 2.0) (/ d 2.0)) (* (/ b 2.0) (/ b 2.0)))dx (sqrt di)dy (/ b 2.0)pt1 (list (+ (car pt0) dx) (+ (cadr pt0) dy)))(initget "Zc Lc");Zc表示画轴键槽的剖视图,Lc表示画轮毂键槽的端面视图(setq zrl (getkword "\n 画轴键槽的剖视图还是轮毂键槽的端面视图(Z/L)?"))(if (= zrl "Zc")(progn;计算轴键槽上点的坐标(setq pt2 (list (+ (car pt0) (-(/ d 2.0) t1)) (+ (cadr pt0) dy)) pt3 (polar pt2 (- (/ pi 2.0)) b)pt4 (polar pt3 0 (- dx (- (/ d 2.0) t1)))));progn);if(if (= zrl "Lc")(progn;计算轮毂键槽上点的坐标(setq pt2 (list (+ (car pt0) (+(/ d 2.0) t2)) (+ (cadr pt0) dy)) pt3 (polar pt2 (- (/ pi 2.0)) b)pt4 (polar pt3 (- pi) (- (+ (/ d 2.0) t2) dx))));progn);if(command "pline" pt1 pt2 pt3 pt4 "");画键槽(setq s2 (ssget "l"))(command "layer" "m" 5 "l" "center" 5 "c" 1 5 "")(command "ltscale" 8)(command "line" (polar pt0 (- pi) (+ (/ d 2.0) 10));画中心线(polar pt0 0 (+ (/ d 2.0) 10)) "")(command "line" (polar pt0 (-(/ pi 2.0)) (+ (/ d 2.0) 10))(polar pt0 (/ pi 2.0) (+ (/ d 2.0) 10)) "")(command "layer" "s" 0 "")(if (= zrl "Zc")(progn(setq s3 (entsel "\n 请选择修剪的目标:"))(command "trim" s2 "" s3 "");修剪形成键槽(command "hatch" "U" "45" "2" "n" s1 s2 ""));画轴上键槽处剖视图的剖面线);if(if (= zrl "Lc")(progn(setq s4 (entsel "\n 请选择修剪的目标:"))(command "trim" s2 "" s4 "");修剪形成键槽(command "rotate" s1 s2 "" pt0 90));将轮毂键槽的端面视图旋转90度);if);end defun二、螺纹孔剖视图的绘制命令“lwk”在绘制机械零件图时，经常要画螺纹孔的剖视图，同样由于螺纹孔的有关尺寸都随螺纹的公称直径而变化，我们可以用下面的程序自动完成其剖视图的绘制。
LISP编程举例
Lisp是一门历史悠久的语言，全名叫LISt Processor，也就是“表处理语言”，它是由John McCarthy于1958年就开始设计的一门语言。
和Lisp同时期甚至更晚出现的许多语言如Algo 等如今大多已经消亡，又或者仅仅在一些特定的场合有一些微不足道的用途，到现在还广为人知的恐怕只剩下了Fortran和COBOL。
但唯独Lisp，不但没有随着时间而衰退，反倒是一次又一次的焕发出了青春，从Lisp分支出来的Scheme、ML等语言在很多场合的火爆程度甚至超过了许多老牌明星。
那么这颗常青树永葆青春的奥秘究竟在哪里呢？如果你只接触过C/C++、Pascal这些“过程式语言”的话，Lisp可能会让你觉得十分不同寻常，首先吸引你眼球（或者说让你觉得混乱的）一定是Lisp程序中异常多的括号，当然从现在的角度来讲，这种设计的确对程序员不大友好，不过考虑到五六十年代的计算机处理能力，简化语言本身的设计在那时算得上是当务之急了。
Lisp的基本语法很简单，它甚至没有保留字（有些语言学家可能对这一点有异议，别怕，我听你们的），它只有两种基本的数据，仅有一种基本的语法结构就是表达式，而这些表达式同时也就是程序结构，但是正如规则最简单的围棋却有着最为复杂的变化一样，Lisp使用最基本的语言结构定义却可以完成其它语言难于实现的、最复杂的功能。
废话少说，现在我们就来看看Lisp语言中的基本元素。
Lisp的表达式是一个原子(atom)或表(list)，原子(atom)是一个字母序列，如abc；表是由零个或多个表达式组成的序列，表达式之间用空格分隔开，放入一对括号中，如：abc()(abc xyz)(a b(c)d)最后一个表是由四个元素构成的，其中第三个元素本身也是一个表。
正如算数表达式1+1有值2一样，Lisp中的表达式也有值，如果表达式e得出值v，我们说e返回v。
如果一个表达式是一个表，那么我们把表中的第一个元素叫做操作符，其余的元素叫做自变量。
编写LISP程序进行城市地下管线竣工图标注的实例
Ｕｎ ｄ ｅ ｒ ｇ ｒ ｏ ｕ ｎ ｄ Ｐ ｉ ｐ ｅ ｌ ｉ ｎ ｅ Ｃｏ ｍｐ ｌ ｅ ｔ ｉ ｏ ｎ Ｍａ ｐ
Ｌ Ｉ ＡＮＧ Ｈｕ ａ—ｂ ｉ ｎ ｇ
（ Ｚ ｈ ａ ｏ ｑ ｉ ｎ ｇ Ｃ ｏ ｎ ｓ ｔ ｒ ｕ ｃ ｔ ｉ ｏ ｎ Ｐ ｌ ａ ｎ ｎ ｉ ｎ ｇ Ｓ ｕ ｒ ｖ ｅ ｙ Ｂ ￣ｇ ａ ｄ ｅ ｏ ｆ Ｇｕ ａ ｎ ｇ ｄ ｏ ｎ ｇ ，Ｚ ｈ ａ ｏ ｑ ｉ ｎ ｇ ５ ２ ６ ０ ６ ０ ， Ｃ ｈ ｉ ｎ ａ ）
０ 引 言
城市地 下管 线 竣 ｒ 测 量 赴 一 项 非 常烦 琐 的 工 作 ， 它 除 了要 经过 艰 苦 的外 业 测 量 外 ， 还 要进 行 耐心 的 内业 绘 图， 特 别是 在绘 制 管 线竣 工 图 过程 中 ， 需要 对 各 类管 线 的 大小 、 走向、 高程 等元 素 进 行标 注 ， 这种 标 注 是大 量 的 、 重 复 的。笔者 在开 始接 触 绘 制城 市地 下管 线 竣 工 图这 项 工 作时 ， 利用 Ｃ Ａ Ｄ 自带 的标 注 功能进 行标 注 ， 不仅 费力 也 不
梁 华 冰
（ 广 东省肇庆市城市建设规划测量队 ， 广东 肇庆 ５ ２ ６ ０ ６ ０ ）
摘
一
要： 城 市地下管线竣 工图绘制过程 中有 大量、 且重复性 的标 注 ， 通过编 写 Ｌ Ｉ Ｓ Ｐ程序 可 以轻松 、 快速 地 完成这
项工作 ． 从 而提 高作 图速 度 ， 并且 保 证 作 图 的 工 整 。
Ｌ Ｉ Ｓ Ｐ （ Ｌ ｉ ｓ ｔ Ｐ ｒ ｏ ｃ ｅ ｓ ｓ ｏ ｒ ） 程序语 言是 内 嵌于 Ａ ｕ ｔ ｏ ｄ Ｃ Ａ Ｄ的
一
种 二次 开 发 丁具 ， 是 一 种 编 程 语 言。这 种 语 言很 容 易
超经典CAD_lisp程序集锦、CAD快捷键大全
超经典CAD lisp程序集锦如果您使用 AutoCAD,下面的内容对您一定有帮助。
在某些方面能大大提高您的工作效率。
下面的程序均以源程序方式给出，您可以使用、参考、修改它。
bg.lsp --- 表格自动生成asc.lsp --- 将文本文件内容写入图中，字符是单个的wf.lsp --- 将图中字符写入磁盘exstr.lsp --- 将字符串分解成单字pgtxt.lsp --- 将字符合成字符串pb.lsp --- 通过给出长度将字符串分成两个串cht.lsp --- 直接修改文字内容或块属性ct.lsp --- 对数字串进行加减chh.lsp --- 直接修改文字高度chhw.lsp --- 直接修改文字高宽比(针对PKPM软件将字符定位点改为左下角) chst.lsp --- 直接修改文字字体txt.shx --- 修改后的标准txt.shx文件。
(kuozhan.sld为增强的内容幻灯片)tiao.lsp --- 配合修改过的标准字体文件，将中文字符调大tiao1.lsp --- 配合修改过的标准字体文件，将英文字符调小untiao.lsp --- 上两个程序的复原sht.lsp --- 在图中查找字符串zhuang.lsp --- 桩点及钎探号绘制（勘测图）dim.lsp --- 配合JT.DWG将尺寸标注调成适合建筑结构设计(1:1)dimm.lsp --- 配合JT.DWG将尺寸标注调成适合建筑结构设计(1:100)di1.lsp～di8.lsp --- 直接连续标注尺寸(用于1:1的图)di100.lsp～di800.lsp --- 直接连续标注尺寸(用于1:100的图)详细内容及附件下载请浏览北纬服务论坛/thread-2724-1-1.html该程序实现的功能如图中所示，只要选择矩形，便可将穿过矩形的直线剪切（以前是一条一条的选择），由于水平有限，程序的语句可能太繁琐，但功能对我面言很实用（以前我下载了一个，但效果不好，连矩形外也剪掉了），请各位高手优化！源程序如下：代码:p1 (car l1)) (command "erase" e0 "") (setq count 0) (repeat 3 (setq count (+ count 1)) (setq pt (nth count l1)) (command "trim" rect "" "f" p1 pt """") ) (setq p1 (cadr l1)) (command "erase" e0 "") (setq count 1) (repeat 2 (setq count (+ count 1)) (setq pt (nth count l1)) (command "trim" rect "" "f" p1 pt """") ) (setvar "osmode" 687))你的程序在实际使用中，有时将矩形的边或矩形外的线剪切掉了，我的程序参照你的程序重新编了一下，不好意思，借用了你的思路.(朋友多，互相学习)有些语句实际上重复了，昨天我又改了下，源程序如下：(defun c:mytrim(/ rect e0 e1 pt x ptx pty l1 i p1 p2 p1x p1y point count)(setvar "osmode" 0)(setq l1 nil)(setq i 0)(setq rect (car (entsel "\n请选择需剪切的矩形:")))(setq e0 (entget rect))(while (setq x (nth i e0))(if(= (car x) 10)(progn(setq ptx (nth 1 x))(setq pty (nth 2 x))(setq x (list ptx pty))(setq l1 (cons x l1))))(setq i (1+ i)))(reverse l1)(setq p1 (car l1))(setq p1x (nth 0 p1))(setq p1y (nth 1 p1))(setq count 0)(repeat 3(setq count (+ count 1))(setq pt (nth count l1))(setq ptx (nth 0 pt))(setq pty (nth 1 pt))(setq point (mapcar '+ p1 pt))(setq point (mapcar '/ point '(2.0 2.0 2.0))) (if(and (/= (nth 0 point) p1x)(/= (nth 0 point) ptx)(/= (nth 1 point) p1y)(/= (nth 1 point) pty))(setq p point)))(setq l1 nil)(command "offset" 5 rect p "")(setq e0 (entlast))(setq e1 (entget e0))(princ e1)(setq i 0)(while (setq x (nth i e1))(if(= (car x) 10)(progn(setq ptx (nth 1 x))(setq pty (nth 2 x))(setq x (list ptx pty))(setq l1 (cons x l1))))(setq i (1+ i)))(reverse l1)(setq p1 (car l1))(setq p2 p1)(command "erase" e0 "")(setq count 0)(repeat 3(setq count (+ count 1))(setq pt (nth count l1)) (command "trim" rect "" "f" p1 pt "" "") (setq p1 pt))(command "trim" rect "" "f" p1 p2 "" "")(setvar "osmode" 687))画箍筋的lisp程序画剪力墙暗柱很实用。
CADLISP程序
1. 计算所有线段总长度(加载后只需框选所有线段便可得出这些线段的总长度) (defun c:LL ()(setvar "cmdecho" 1)(setq en ( ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))(setq i 0)(setq ll 0)(repeat (sslength en)(setq ss (ssname en i))(setq endata (entget ss))(command "lengthen" ss "")(setq dd (getvar "perimeter"))(setq ll (+ dd ll))(setq i (1+ i)))(princ " 所选线条总长为:")(princ ll)(princ))2. 标注所有线段(加载后只需框选所有线段便可得标注这些线段)(defun c:LLL ()(COMMAND "UCS""")(setvar "cmdecho" 1)(SETVAR "OSMODE" 0)(setq AcadObject (vlax-get-acad-object)AcadDocument (vla-get-ActiveDocument Acadobject)mSpace (vla-get-ModelSpace Acaddocument));;选取需要测量的样条曲线、圆弧、直线、椭圆(setq en ( ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))(setq i 0);;获取系统参数textsize(setq shh (getvar "textsize"))(setq str_hh (strcat "\n 文字高度<"(rtos shh 2)">:")) (setq hh (getdist str_hh))(while hh(setvar "textsize" hh)(setq hh nil));;输入标注文字高度;;循环开始(repeat (sslength en)(setq ss (ssname en i))(setq endata (entget ss))(command "lengthen" ss "")(setq dd (getvar "perimeter"))(princ (strcat "\n 长度="(rtos dd 2)));;寻找代表图层的字符申(setq aa (assoc 0 endata));;获取图层名称(setq aa1 (cdr aa));;判断线条种类(cond((=aa1 "SPLINE");; 如果是spline(progn(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))(setq startPnt1 (vla-get-ControlPoints arcObj))(setq p1(vlax-safearray->list (vlax-variant-value startPnt1)) (setq x1 (car p1))(setq y1 (cadr p1))(setq z1 (caddr p1))(repeat (- (/ (length p1) 3) 1);;循环，寻找最后一个控制点(setq p1 (cdddr p1))(setq x2 (car p1))(setq y2 (cadr p1))(setq z2 (caddr p1)))(setq pp2 (list x2 y2 z2))))((=aa1 "LWPOLYLINE");;如果是LWPOLYLINE(progn(setq arcObj (VLAX-ENAME->VLA-OBJECT ss)) (setq startPnt1 (vla-get-Coordinates arcObj))(setq p1(vlax-safearray->list (vlax-variant-value startPnt1)) )(setq x1 (car p1))(setq y1 (cadr p1))(setq z1 (caddr p1))(setq pp1 (list x1 y1 z1))(repeat (- (/ (length p1) 3) 1);;循环，寻找最后一个控制点(setq p1 (cdddr p1))(setq x2 (car p1))(setq y2 (cadr p1))(setq z2 (caddr p1)))))(t；；如果是其他种类线条(progn(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))(setq startPnt1 (vla-get-StartPoint arcObj));;获取起点(setq endPnt1 (vla-get-EndPoint arcObj));;获取终点(setq pp1(vlax-safearray->list (vlax-variant-value startPnt1)) )(setqpp2 (vlax-safearray->list (vlax-variant-value endPnt1)) ))))(setq x1 (car pp1))(setq y1 (cadr pp1))(setq z1 (caddr pp1))(setq x2 (car pp2))(setq y2 (cadr pp2))(setq z2 (caddr pp2))(setq x (/ (+ x1 x2) 2))(setq y (/ (+ y1 y2) 2))(setq z (/ (+ z1 z2) 2))(setq pt (list x y z));;取得线段两端的中点(setq ang (angle ppi pp2))；；获取角度(if (> (* (/ ang pi) 180) 180)(setq ang (+ ang pi)))(command "text""bc"pt""(* (/ ang pi) 180)(strcat "" (rtos dd 2))"")(setq i (1+ i)))(prin1))(prompt "\n <> 在图中直接写出长度")(prin1)3. 连续打断程序(defun c:br1 ()(command "break" pause "f" pause "@"))4. 将CAD文字导入Excel表格(defun c:Q2()(setq ffn (getfiled " 写出文件......... xls" 1))(princ "\n 选取文字...”)(setq ss ( ssget))(setq ff (open ffn "w"))(setq i 0)(repeat (sslength ss)(setq ssn (ssname ss i))(setq ssdata (entget ssn))(setq sstyp (cdr (assoc 0 ssdata)))(if (or (= sstyp "TEXT") (= sstyp "MTEXT"))(progn(setq txt (cdr (assoc 1 ssdata)))(princ txt ff)(princ "\n" ff)))(setq i (1+ i)))(close ff)(princ (strcat "\n 写出文件:"ffn))(prin1))5删除带颜色图元以下程序在别人的贴子里贴过.为了说明问题，今天再贴一次. 改颜色的LISP程序(defun c:c1()(ssget)(command "chprop" "p ...... c" "1" "") (princ)) (defun c:c2()(ssget)(command "chprop" "p ...... c" "2" "") (princ)) (defun c:c3()(ssget)(command "chprop" "p ...... c" "3" "") (princ)) (defun c:c4()(ssget)(command "chprop" "p ...... c" "4" "") (princ))(defun c:c5()(ssget)(command "chprop" "p ...... c" "5" "") (princ))(defun c:c6()(ssget)(command "chprop" "p ...... c" "6" "") (princ))(defun c:c7()(ssget)(command "chprop" "p ...... c" "7" "") (princ))(defun c:c8()(ssget)(command "chprop" "p ...... c" "8" "") (princ))你用C1命令就可以将图元改为红色了.其余类似.删除红色图元(defun C:D1 (/ m A M)(setq m:err *error* *error* *merr*)(setvar "cmdecho" 0)(command "UNDO" "G")(prompt " 选择图形")(setq A (ssget '((62.1))))(if (/= A nil)(progn(setq M (sslength A))(command "erase" A "")(princ "\n 共删除红色图元<")(princ M)(princ "> 个")))(command "UNDO" "E") (princ)这样，键入D1命令，就可以删除红色的图元了枯藤老树昏鸦，小桥流水人家，古道西风瘦马。
LISP语言教程(1)
(quote x)返回x.为了可读性我们把(quote x)简记为'x.
> (quote a)
a
> 'a
a
> (quote (a b c))
(a b c)
atom
(atom x)返回原子t如果x的值是一个原子或是空表,否则返回().在Lisp中我们按惯例用原子t表示真,而用空表表示假.
> (atom 'a)
(cond ((atom z)
(cond ((eq z y) x)
('t z)))
('t (cons (subst x y (car z))
(subst x y (cdr z))))))
偶然地我们在这儿看到如何写cond表达式的缺省子句.第一个元素是't的子句总是会成功的.于是
(cond (x y) ('t z))
等同于我们在某些语言中写的
if x then y else z
一些函数
既然我们有了表示函数的方法,我们根据七个原始操作符来定义一些新的函数.为了方便我们引进一些常见模式的简记法.我们用cxr,其中x是a或d的序列,来简记相应的car和cdr的组合.比如(cadr e)是(car(cdr e))的简记,它返回e的第二个元素.
示例
假设我们要定义函数(subst x y z),它取表达式x,原子y和表z做参数,返回一个象z那样的表,不过z中出现的y(在任何嵌套层次上)被x代替.
> (subst 'm 'b '(a b (a b c) d))
(a m (a m c) d)
我们可以这样表示此函数
(label subst (lambda (x y z)
LISP使用说明
1.TXGX-修正单行文字、多行文字或块属性的小数位。
2.(defun rtos2(number mode n/st gst sn ln cn dn)函数：RTOS函数的增强版，将指定的数字字符串转换为指定小数位的数字字符串；st为要处理的字符串，n为要保留的小数位数。
3.2PLI--显示二维多段线上各顶点的坐标值。
4.3PLI--显示三维多段线上各顶点的三维坐标值。
5.AAPL--该程序主要用于绘制横断面图时计算填挖方面积。
6.(defun aa4p(x1y1x2y2x3y3x4y4/)函数：给定四点计四点确定两直线之间的填挖方面积。
7.PLTR--将二维多段线顶点按相反顺序排列.8.BBG-标注标高9.SY2-拾取一个标高文本和一个点来设置坐标系.10.MBG-制作标高块BG.11.MBX-制作标高块BX.12.MBXY-制作标高块BXY13.GX-更新坐标标注.14.M2T-多行文本转换为单行文本。
15.SY-拾取已标注好的标高块来设置坐标系.16.BBX－标宽度17.BXY—标坐标18.SXY—根据标注好的坐标块设置坐标值。
19.RDTX2--拾取单行文本,多行文本的文本值。
20.GMT--规范化多行文字(command"-style""chbz""isocp.shx,hhztxt.shx""0""0.7""0""N""N")21.GMT2--增强版的规范化文字22.BR1---指定一点将所穿越的实体截断23.BBR----指定两点将所穿越的实体截断.24.BZWB----根据标注文字位置坐标，文字方向及标注文本字符串来进行文本标注25.DMTR----将横断面图中的断面线转换为平面图中的三维点线。
26.EZ—将指定点标高设置为当前标高。
CADLISP程序
1.计算所有线段总长度(加载后只需框选所有线段便可得出这些线段的总长度)(d e f u n c:L L() (s e t v a r"c m d e c h o"1) (setq en (ssge t(list '(0 . "spline,a rc,line,ellipse,LW POLYLIN E")))) (s e t q i0) (s e t q l l0) (r e p e a t(s s l e n g t h e n) (s e t q s s(s s n a m e e n i)) (s e t q e n d a t a(e n t g e t s s))(c o m m a n d"l e n g t h e n"s s"")(s e t q d d(g e t v a r"p e r i m e t e r")) (s e t q l l(+d d l l)) (s e t q i(1+i)))(p r i n c"所选线条总长为：")(p r i n c l l)(p r i n c))2.标注所有线段(加载后只需框选所有线段便可得标注这些线段)(d e f u n c:L L L() (C O M M A N D"U C S""") (s e t v a r"c m d e c h o"1) (S E T V A R"O S M O D E"0) (s e t q A c a d O b j e c t(v l a x-g e t-a c a d-o b j e c t)A c a d D o c u m e n t(v l a-g e t-A c t i v e D o c u m e n t A c a d o b j e c t)m S p a c e(v l a-g e t-M o d e l S p a c e A c a d d o c u m e n t));;选取需要测量的样条曲线、圆弧、直线、椭圆(setq en (ssge t(list '(0 . "spline,a rc,line,ellipse,LW POLYLIN E")))) (s e t q i0) ;;获取系统参数t e x t s i z e (s e t q s h h(g e t v a r"t e x t s i z e")) (s e t q s t r_h h(s t r c a t"\n文字高度<"(r t o s s h h2)">:"))(s e t q h h(g e t d i s t s t r_h h)) (w h i l e h h (s e t v a r"t e x t s i z e"h h) (s e t q h h n i l)) ;;输入标注文字高度;;循环开始(r e p e a t(s s l e n g t h e n) (s e t q s s(s s n a m e e n i)) (s e t q e n d a t a(e n t g e t s s))(c o m m a n d"l e n g t h e n"s s"")(s e t q d d(g e t v a r"p e r i m e t e r")) (p r i n c(s t r c a t"\n长度="(r t o s d d2))) ;;寻找代表图层的字符串(s e t q a a(a s s o c0e n d a t a)) ;;获取图层名称(s e t q a a1(c d r a a));;判断线条种类(c o n d((=a a1"S P L I N E") ;;如果是s p l i n e(p r o g n (s e t q a r c O b j(V L A X-E N A M E->V L A-O B J E C T s s)) (s e t q s t a r t P n t1(v l a-g e t-C o n t r o l P o i n t s a r c O b j))(s e t q p 1 (v l a x-s a f e a r r a y->l i s t(v l a x-v a r i a n t-v a l u e s t a r t P n t1))) (s e t q x1(c a r p1))(s e t q y1(c a d r p1)) (s e t q z1(c a d d r p1)) (s e t q p p1(l i s t x1y1z1)) (r e p e a t(-(/(l e n g t h p1)3)1) ;;循环，寻找最后一个控制点(s e t q x2(c a r p1))(s e t q y2(c a d r p1))(s e t q z2(c a d d r p1))) (s e t q p p2(l i s t x2y2z2)))) ((=a a1"L W P O L Y L I N E") ;;如果是L W P O L Y L I N E(p r o g n (s e t q a r c O b j(V L A X-E N A M E->V L A-O B J E C T s s)) (s e t q s t a r t P n t1(v l a-g e t-C o o r d i n a t e s a r c O b j)) (s e t q p 1 (v l a x-s a f e a r r a y->l i s t(v l a x-v a r i a n t-v a l u e s t a r t P n t1)))(s e t q y1(c a d r p1)) (s e t q z1(c a d d r p1)) (s e t q p p1(l i s t x1y1z1)) (r e p e a t(-(/(l e n g t h p1)3)1) ;;循环，寻找最后一个控制点(s e t q p1(c d d d r p1))(s e t q x2(c a r p1))(s e t q y2(c a d r p1))(s e t q z2(c a d d r p1))) (s e t q p p2(l i s t x2y2z2))))(t ;;如果是其他种类线条(p r o g n (s e t q a r c O b j(V L A X-E N A M E->V L A-O B J E C T s s)) (s e t q s t a r t P n t1(v l a-g e t-S t a r t P o i n t a r c O b j));;获取起点(s e t q e n d P n t1(v l a-g e t-E n d P o i n t a r c O b j));;获取终点(s e t q p p 1 (v l a x-s a f e a r r a y->l i s t(v l a x-v a r i a n t-v a l u e s t a r t P n t1)))(s e t q p p2(v l a x-s a f e a r r a y->l i s t(v l a x-v a r i a n t-v a l u e e n d P n t1)))))) (s e t q x1(c a r p p1))(s e t q y1(c a d r p p1)) (s e t q z1(c a d d r p p1)) (s e t q x2(c a r p p2)) (s e t q y2(c a d r p p2)) (s e t q z2(c a d d r p p2)) (s e t q x(/(+x1x2)2)) (s e t q y(/(+y1y2)2)) (s e t q z(/(+z1z2)2)) (s e t q p t(l i s t x y z)) ;;取得线段两端的中点(s e t q a n g(a n g l e p p1p p2)) ;;获取角度(i f(>(*(/a n g p i)180)180)(s e t q a n g(+a n g p i)))(c o m m a n d"t e x t""j""b c"p t""(*(/a n g p i)180) (s t r c a t""(r t o s d d2))"") (s e t q i(1+i)))(p r i n1))(p r o m p t"\n<>在图中直接写出长度") (p r i n1)3.连续打断程序(d e f u n c:b r1()(c o m m a n d"b r e a k"p a u s e"f"p a u s e"@"))4.将C A D文字导入E x c e l表格(d e f u n c:Q2() (s e t q f f n(g e t f i l e d"写出文件""""x l s"1)) (p r i n c"\n选取文字...") (s e t q s s(s s g e t)) (s e t q f f(o p e n f f n"w")) (s e t q i0) (r e p e a t(s s l e n g t h s s) (s e t q s s n(s s n a m e s s i)) (s e t q s s d a t a(e n t g e t s s n)) (s e t q s s t y p(c d r(a s s o c0s s d a t a))) (i f(o r(=s s t y p"T E X T")(=s s t y p"M T E X T"))(p r o g n (s e t q t x t(c d r(a s s o c1s s d a t a))) (p r i n c t x t f f) (p r i n c"\n"f f)))(s e t q i(1+i)))(c l o s e f f) (p r i n c(s t r c a t"\n写出文件:"f f n)) (p r i n1) )5删除带颜色图元以下程序在别人的贴子里贴过.为了说明问题,今天再贴一次.改颜色的LISP程序(defun c:c1()(ssget)(command "chprop" "p" "" "c" "1" "") (princ))(defun c:c2()(ssget)(command "chprop" "p" "" "c" "2" "") (princ)) (defun c:c3()(ssget)(command "chprop" "p" "" "c" "3" "") (princ)) (defun c:c4()(ssget)(command "chprop" "p" "" "c" "4" "") (princ)) (defun c:c5()(ssget)(command "chprop" "p" "" "c" "5" "") (princ)) (defun c:c6()(ssget)(command "chprop" "p" "" "c" "6" "") (princ)) (defun c:c7()(ssget)(command "chprop" "p" "" "c" "7" "") (princ)) (defun c:c8()(ssget)(command "chprop" "p" "" "c" "8" "") (princ))你用C1 命令就可以将图元改为红色了.其余类似.删除红色图元(defun C:D1 (/ m A M)(setq m:err *error* *error* *merr*)(setvar "cmdecho" 0)(command "UNDO" "G")(prompt "选择图形")(setq A (ssget '((62 . 1)) ))(if (/= A nil)(progn(setq M (sslength A))(command "erase" A "")(princ "\n共删除红色图元<")(princ M)(princ ">个")))(command "UNDO" "E")(princ) )这样,键入D1 命令,就可以删除红色的图元了.。
lisp编程实例 )
Visual LISP 编程应用实例集一、 计算类程序1.计算阶剩值n! (注意：采用了递归方式)(defun jsen (n)(if (= n 0) 1 (* n (jsen (1- n)))));2.迭代计算（013=--x x）(defun ddai (x) (setq x1 0 x2 x e 1.0e-5 i 0)(while (> (abs (- x2 x1)) e) (setq x1 x2) (setq x2 (expt (+ x1 1) (/ 1 3.0))) (setq i (1+ i)));while (print "x=") (princ x2) (print "i=") (princ i)(princ));end3.一元二次方程求解(02=++c bx ax )(defun px2 (a b c)(setq d (- (expt b 2.0) (* 4 a c)))(cond ((< d 0) (prompt "\nNo root!"))((= d 0) (progn (setq x (/ b (* -2.0 a))) (prompt "\nOne root! x=") (princ x))) ((> d 0) (progn (setq x1 (/ (- (sqrt d) b) (* 2.0 a)) x2 (/ (+ (sqrt d) b) (* -2.0 a))) (prompt "\nTwo root! x1=") (princ x1) (prompt " x2=") (princ x2))));cond (princ));end4.成绩分析统计注意：使用该程序前须将全班成绩输入一个数据文件中保存，格式为（78 89 67 ….） (defun sjfx (fname)(setq f (open fname "r")) (setq lb nil) (while (setq sd (read-line f)) (setq lb (append lb (read sd)))) (close f) (setq xsum 0) (foreach x lb (setq xsum (+ x xsum))) (setq n (length lb) xb 0) (setq xbar (/ xsum (* 1.0 n))) (foreach x lb (setq xb (+ xb (* (- x xbar) (- x xbar))))) (setq xbzc (sqrt (/ xb (* 1.0 n)))) (repeat 18 (terpri))(prompt "************ 统计结果 ******************") (terpri)(prompt (strcat " 全班总平均分数 X=" (rtos xbar 2 3))) (terpri)(prompt (strcat " 标准差 δ=" (rtos xbzc 2 3))) (terpri)(prompt (strcat " Total number: N=" (rtos n 2 0))) (terpri)(prompt "****************************************") (terpri)(princ));end二、数据检索类1.根据计算模数检索标准模数值(假定mc 为1~10之间的任意值，以实参代入) (defun jsm (mc)(setq ml '(1 1.25 1.5 2 2.5 3 4 5 6 8 10)) (setq m 0 n 0)(while (< m mc) (setq m (nth n ml) n (1+ n)));while(prompt (strcat "\nm=" (rtos m 2 1)))(princ));end2.检索一类数据文件（一类数据文件必须存在，且数据格式必须统一） (defun js1 (fname kd / ft nt j x)(setq f (open fname "r")) (setq ft (read (read-line f)) nt (read (read-line f)))(while (/= kd (car nt)) (setq nt (read (read-line f)))) ;while(setq j -1) (repeat (length nt) (setq j (1+ j) x (nth j ft)) (set x (nth j nt)))；reapeat(close f) nt);end3.检索二类数据文件（二类数据文件必须存在，且数据格式必须统一）(defun js2 (fname kd / ft nt j x)(setq f (open fname "r")) (setq ft (read (read-line f)) nt (read (read-line f)))(while (or (<= kd (car nt)) (> kd (cadr nt))) (setq nt (read (read-line f))));while(setq j -1) (repeat (length nt) (setq j (1+ j) x (nth j ft)) (set x (nth j nt)));repeat(close f) nt);end三、参数化绘图类1.绘制正弦曲线函数y=sinx (注意：计算数据存放在表变量lpt中)(defun ds (/ x0 xe x y pt)(setq bp (getpoint "\n给出基点:"))(command "ucs" "o" bp) (setq scx 10 scy 20) (setq x0 0 xe (* pi 2) x 0 y 0) (setq step (/ xe 180.0)) (while (<= x0 (* scx xe)) (setq y (* scy (sin x))) (setq lpt (append lpt (list (list x0 y))))(setq x0 (+ x0 (* scx step)) x (+ x step)));while(setq lpt (append lpt (list (list (* scx xe) 0))))(command "leader" (list (+ (* scx xe) 10) 0) "0,0" "" "" "n")(command "leader" (list 0 (+ scy 10)) "0,0" "" "" "n")(command "pline") (foreach pt lpt (command pt)) (command "")(princ));end2.装有键的轴或孔的图形绘制（注：平键数据存于二类数据文件jc.dat中）(defun jcz (d flag / x1 x2 x cp pt1 pt2 pt3 pt4 t1)(if (not js2) (load "d:/cad_1/js2")) (js2 "d:/cad_1/jc.dat" d)(initget 6) (setq cp (getpoint "\nCenter point:")) (command "ucs" "o" cp)(setq x1 (expt (* 0.5 d) 2.0) x2 (expt (* 0.5 b) 2.0)) (setq x (sqrt (- x1 x2)))(if (= flag 1) (setq t1 tz) (setq t1 (* -1 tk)))(setq pt1 (list x (* 0.5 b)) pt2 (list (- (* 0.5 d) t1) (* 0.5 b))pt3 (polar pt2 (* 1.5 pi) b) pt4 (polar pt1 (* 1.5 pi) b))(command "pline" pt1 "a" "ce" "0,0" pt4 "l" pt3 pt2 pt1 "")(if (= flag 1) (command "hatch" "u" 45 4 "" "l" "")) (command "layer" "s" "center" "" "" "") (command "line" (polar '(0 0) pi (+ 3 (* 0.5 d))) (polar '(0 0) 0 (+ 3 (* 0.5 d))) "")(command "line" (polar '(0 0) (* 0.5 pi) (+ 3 (* 0.5 d))) (polar '(0 0) (* 1.5 pi) (+ 3 (* 0.5 d))) "") (command "layer" "s" 0 "" "" "") (princ));end3.绘制阴阳图形(defun yinyang (r)(setq bp (getpoint "\nEnter center point:")) (command "color" 2) (command "circle" bp r) (command "pline" (polar bp (* 0.5 pi) r) "a" bp (polar bp (* 1.5 pi) r) "")(command "bhatch" "p" "s" (polar bp (* 0.5 pi) (* 0.5 r)) "") (command "color" 1) (command "bhatch" "p" "s" (polar bp (* 1.5 pi) (* 0.5 r)) ""));end4.绘制一个五角星图案(defun star_5 (r)(command "color" 1) (setq cp (getpoint "\nCenter point:"))(setq p t1 (polar cp (* 0.017453 18) r) pt2 (polar cp (* 0.017453 54) r) p2 (polar cp (* 0.5 pi) r)) (setq p1 (inters cp pt2 pt1 (polar pt1 pi r)) p3 (polar cp (* 0.017453 126) (distance cp p1))) (command "pline" cp p1 p2 p3 cp p2 "") (setq s (ssadd (entlast)))(command "bhatch" "p" "s" (polar cp (* 0.017453 70) (* 0.2 r)) "") (setq s (ssadd (entlast) s)) (command "color" 2) (command "bhatch" "p" "s" (polar cp (* 0.017453 95) (* 0.2 r)) "") (setq s (ssadd (entlast) s))(command "array" s "" "p" cp 5 "" "")(princ));end5.绘制图框(n=0,1~5)(defun tk (n)(setq lpt '(1189 841 594 420 297 210 148))(setq l (nth n lpt) b (nth (+ n 1) lpt))(if (< n 3) (setq c 10) (setq c 5))(command "rectangle" '(0 0) (list l b))(command "rectangle" (list 25 c) (list (- l c) (- b c))));end6.绘制参数曲线x=sin2a, y=sin5a [0~2pi]（注意：采用了递归方式）(defun draw_xy ()(setq bp (getpoint "\nEnter base point:"))(command "ucs" "o" bp)(command "pline" (draw_xy_aux 0)));main;--------------------------------------------------(defun draw_xy_aux (a)(cond ((> a (* 2 pi)) (command "0,0" "" "ucs" "w"))(t (command (list (sin (* 2.0 a)) (sin (* 5.0 a))))(draw_xy_aux (+ a 0.05))));cond);end7.绘制参数曲线x=sin5a.cosa, y=sin5a.sin4a（注意：采用了数据文件读、写方式）(defun qx_xy ()(setq f (open "qx.dat" "w")) (setq a 0)(while (< a (* 2 pi)) (setq x (* (sin (* 5 a)) (cos a)) y (* (sin (* 5 a)) (sin (* 4 a))))(princ x f) (princ "," f) (princ y f) (princ "\n" f) (setq a (+ a 0.05)));while(princ "0,0" f) (close f)(draw_qx) (princ));main;-------------------------------------------------(defun draw_qx ()(setq bp (getpoint "\nEnter base point:"))(command "ucs" "o" bp "pline")(setq f (open "qx.dat" "r"))(while (setq pt (read-line f)) (command pt))(close f)(command "" "ucs" "w")(princ));end8.绘制由方程y=cos(0.9x)产生的图形（注：计算数据存放于表变量lpt中）(defun c:spr (/ cp lpt x)(setq cp (getpoint "\nCenter point:"))(setq x 0 lpt nil)(repeat (fix (1+ (/ (* 20 pi) 0.2)))(setq lpt (append lpt (list (polar cp x (cos (* 0.9 x))))))(setq x (+ x 0.2)));repeat(setq lpt (append lpt (list (polar cp (* 20 pi) 1) "")))(command "pline")(foreach pt lpt (command pt))(princ));end四、对话框编程实例1．定制对话框zdbx:dialog{label="带圆正多边形";:row{:boxed_column{:edit_box{label="边数";key="number";value=6;}:edit_box{label="半径";key="rad";value=20;}}:boxed_column{:radio_button{label="内接圆";key="nq";}:radio_button{label="外切圆";key="wq";value=1;}}}ok_cancel;}2．程序驱动(defun dbx ()(setq id (load_dialog "e:/jscad/zdbx"))(if (< id 0) (exit))(if (not (new_dialog "zdbx" id)) (exit))(action_tile "number" "(set_tile $key $value)")(action_tile "rad" "(set_tile $key $value)")(action_tile "nq" "(setq fg 1)")(action_tile "wq" "(setq fg 0)")(action_tile "accept" "(qsj) (done_dialog)")(action_tile "cancel" "(setq what -1) (done_dialog)")(start_dialog)(unload_dialog id)(if (> what 0) (draw_zdbx n r flag)));end;----------------------------(defun draw_zdbx (n r flag)(setq bp (getpoint "\nBase point:"))(command "circle" bp r)(command "polygon" n bp flag r));---------------------------(defun qsj ()(setq n (atoi (get_tile "number")))(setq r (atof (get_tile "rad")))(if (= fg 1) (setq flag "i") (setq flag "c"))(setq what 1));end五．局部菜单设计编程实例//***MENUGROUP=用户菜单***POP1[用户菜单][--][->平键联接][圆头平键]^c^c(if (not aj) (load "d:/cad_1/aj")) (aj)[半圆头键]^c^c(if (not bj) (load "d:/cad_1/bj")) (bj)[方型平键]^c^c(if (not cj) (load "d:/cad_1/cj")) (cj)[键槽轴面]^c^c(if (not jcz) (load "d:/cad_1/jcz")) (jcz 1)[<-键槽孔面]^c^c(if (not jcz) (load "d:/cad_1/jcz")) (jcz 0)[~--][->图纸幅面][A0幅面]^c^crectangle 0,0 1189,841 rectangle 25,10 1179,831[A1幅面]^c^crectangle 0,0 841,594 rectangle 25,10 831,584[A2幅面]^c^crectangle 0,0 594,420 rectangle 25,10 584,410[A3幅面]^c^crectangle 0,0 420,297 rectangle 25,10 410,287[A4幅面]^c^crectangle 0,0 297,210 rectangle 25,5 287,205[<-A5幅面]^c^crectangle 0,0 210,147 rectangle 25,5 200,142[~--][标题栏]^C^C(command "insert" "d:/cad_1/btl" pause "" "" pause) [粗糙度]^C^C(command "insert" "d:/cad_1/czd1" pause "" "" pause) [基准符号]^c^c(command "insert" "d:/cad_1/jzfh" pause "" "" pause) [清屏幕]^c^c(if (not cls) (load "d:/cad_1/cls")) cls;[--][圆多边形]^C^C(if (not dbx) (load "e:/jscad/zdbx")) (dbx)[--]---------------------------------------------------------------------------------------------------------------- (说明：该程序仅用于《CAD软件二次开发》课程学习参考和上机训练，不得随意传抄)梯形♦(defun dytx (sd xd gd)♦(setq bp (getpoint "\nEnter base point:"))♦(command "ucs" "o" bp)♦(setq p1 (list (* 0.5 (- xd sd)) gd)♦p2 (polar p1 0 sd)♦p3 (list xd 0))♦(command "pline" "0,0" p1 p2 p3 "c")♦(command "ucs" "w"));endW五角星(defun wjx (r)(setq cp (getpoint "\n指定中心点："))(setq p1 (polar cp (* 0.5 pi) r)p2 (polar cp (* 0.017453 162) r)p3 (polar cp (* 0.017453 234) r)p4 (polar cp (* 0.017453 306) r)p5 (polar cp (* 0.017453 18) r))(setq p12 (inters p1 p3 p2 p5)p23 (inters p1 p3 p2 p4)p34 (inters p2 p4 p3 p5)p45 (inters p1 p4 p3 p5)p15 (inters p1 p4 p2 p5))(command "pline" p1 p12 p2 p23 p3 p34 p4 p45 p5 p15 "c")(command "circle" cp r))鼓形(defun c:gx ()(setq c (getpoint "input a point:"))(command "ucs" "o" c)(setq h (getreal "input h"))(setq r (getreal "input r"))(setq p1 (list (sqrt (- (* r r) (* h h)) )h))(setq p2 (list (- 0 (sqrt (- (* r r) (* h h)) ))h))(setq p3 (list (- 0 (sqrt (- (* r r) (* h h)) ))(- 0 h)))(setq p4 (list (sqrt (- (* r r) (* h h)) )(- 0 h)))(command "arc" p4 "en" p1 "r" r)(command "arc" p2 "en" p3 "r" r)(command "line" p1 p2"")(command "line" p4 p3""))例子编程如下：(defun bolt (F b) (setq d1min (sqrt (/ (* 4 f) (* pi b)))) (princ “\n 松螺栓最小直径d1=”) (princ d1min) (princ));endCommand:(bolt 5800 180)返回：松螺栓最小直径d1=6.4052♦ 复选框：(Toggle/CheckBox)♦ 单选按钮（Radio_Button)♦ 选择按钮（Button)♦ 编辑框（Edit_Box)♦ 列表框（List_Box)♦ 下拉式列表框（Popup_List)♦ 滑块（Slider)♦ 图像（Image)或图像按钮（image_button)♦ 说明文字（Text):retirement_button{label = "设计计算";key = "accept";is_default = true;}♦ dxan:dialog{][41σπF d ≥♦label="确定图纸幅面";♦:boxed_radio_row{label="幅面规格";♦:radio_button{label="A0"; key="a0"; }♦:radio_button{label="A1"; key="a1"; }♦:radio_button{label="A2"; key="a2"; }♦:radio_button{label="A3"; key="a3"; }♦:radio_button{label="A4"; key="a4"; }♦:radio_button{label="A5"; key="a5"; value=1;}♦}♦ok_cancel;♦}zcl:dialog{label="渐开线直齿圆柱齿轮设计";:row{:list_box{label = "模数（mm)";key="m_number";list="1.25\n1.5\n2\n2.5\n3\n4\n5\n6\n8\n10\n12\n16\n20\n25\n32\n40\n50";value=2;height=5;}:spacer{width=2;}:boxed_column{:edit_box{label=" 齿数&z";key="z_number";}:edit_box{label="变位系数x";key="x_number";value=0;} :edit_box{label="顶高系数ha*";key="ha*";value=1.0;} :edit_box{label="顶隙系数c*";key="c*";value=0.25;}}}ok_cancel;}。
CADLISP程序
1.计算所有线段总长度(加载后只需框选所有线段便可得出这些线段的总长度)(defun c:LL ())om1d(sevteacr h c(setq en (ssge t (list '(0 .spline,arc,line,ellipse,LWPOLYLINE))))(setq i 0)) q l0(setl) (selshter(n epeant g)( m)stsq nesse i(anse (setq endata (entget ss)))(command le ngthen ss(setq dd (getvar perimeter))(setq ll (+ dd ll))))(siet q+ i1())为总线所nr( pic选条长：)(ll nir(pc)irpnc)2.标注所有线段(加载后只需框选所有线段便可得标注这些线段) (defun c:LLL ()) SND (UCOMCMA) hcet vmcadr (os1e)DVO AMSORETS 0E((setq AcadObject (vlax-get-acad-object) AcadDocument (vla-get-ActiveDocument Acadobject)mSpace (vla-get-ModelSpace Acaddocument));;选取需要测量的样条曲线、圆弧、直线、椭圆(setq en (ssge t (list '(0 . spline,arc,line,ellipse,LWPOLYLINE))))(setq i 0)estez;;获取x系t统参数i(setq shh (getvar textsize))(setq str_hh (strcat \n文字高度)) :> )2 hhs sotr( <(setq hh (getdist str_hh))hh lwe(ihsetvar t(extsize hh)) e t)qhi(s nlh度字注入;;输标高文环循;;开始ngth enrepeat (ssle())s)s (s est(ameq e nnis (setq endata (entget ss)))(command lengthen s s(setq dd (getvar perimeter))(princ (strcat \n长度= (rtos dd 2)))表代图; ;寻找层的字符串(setq (assoc aa endata)) 0层名获;图称取;rd))aa c( 1aaes( qt;;判断线条种类dn( ocENaa1) S (LPI(=i 如n是;果sp;e lgorp (n(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))(setq startPnt1 (vla-get-ControlPoints arcObj))(setq p1(vlax-safearray->list (vlax-variant-value startPnt1)) )) )pr x(1 ca1q( set) y1r (q1 cpad s(e)t)1zar1pq d ( (dstec)(setq p p1 (list x1 y1 z1)) (repeat (- (/ (length p1) 3) 1);;循环，寻找最后一个控制点(setq p1 (cdddr p1))) ((sc1ea tqr) x2p) 1 ca y)(s2p etdr q (r1 )z 2dc aqs( p ) e td()(setq pp2 (list x2 y2 z2))))((= aa1 LWPOLYLINE)LWPO L Y果是L;;INE 如n(g rpo(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))(setq startPnt1 (vla-get-Coordinates arcObj))(setq p1(vlax-safearray->list (vlax-variant-value startPnt1)))(setq x1 (car p1))) c s( eat1qd yp1r ) ()a()sd1ert1 qd( c zp(setq pp1 (lis t x1 y1 z1))(repeat (- (/ (length p1) 3) 1);;循环，寻找最后一个控制点)) pq 1ddcdpr ( 1 e(stpt q) c) a1x 2 s( e ( r1 yp) r2((desact q)1p) 2(s) ectdqd (az r))pp2 qes(ts il(t2x 2yz 2)))t (条种是如;;果他其类线(progn(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))(setq startPnt1 (vla-get-StartPoint arcObj));;获取起点(setq endPnt1 (vla-get-EndPoint arcObj));;获取终点1tp q p( se (vlax-safearray->list (vlax-variant-value startPnt1)) )qe( s t pp2 (vlax-safearray->list (vlax-variant-value endPnt1)) ))))))1pp rac( 1x qtes((setq y1 (cadr pp1))) d (pstedpq rz1) (c1a) pa()s2re p qt2( cx) )2 2a( spredy(tq cpp zrd p2c(q s2) et) ad((setq x (/ (+ x1 x2) 2))2) y1 ) (/q(set y y2)(+(z2z1 ) 2) (+) q e(st/ ztzxtiest( q l spy )) (线;两的取中;段得端点(set q ang (angle pp1 pp2))角取度;;获(if (> (* (/ ang pi) 180) 180)(setq ang (+ ang pi)))txet dnammoc(jb cpt180)ia (*(/ng p)) 2)tt (srcao (rts dd)))+(1qe(st ii))pr(in1))度长出写rp(< \ pmotn接中图在>直)inr(p1连.断3打续程序(defun c:br1 ()(command break pause f pause @))4.将CAD文字导入Excel表格)d:e( f2u(cnQ(setq ffn (getfiled 写出文件xls 1))(princ \n选取文字...)) (stss)es(gtqs e) oe nw fff (fpnsqe(t)) q(s 0eti) ssha gt( eelr(epnsst) e si n(q namss)sstes(s)q se)tensd ( tgatsasnt(es(setq sstyp (cdr (assoc 0 ssdata)))))TXETM pytss =( )TXET pytss =( ro( fi((progn(setq txt (cdr (assoc 1 ssdata)))(princ txt ff)ffc \n)(prin))1i (+ i)) s(etq))sfe fc(lo)n)件f :f文写\ ars nr(pic(tctn出) nrpi1( )5删除带颜色图元.以下程序在别人的贴子里贴过为了说明问题.,今天再贴一次LISP改颜色的程序(defun c:c1()(ssget)(command chprop p \ c \) (princ))(defun c:c2()(ssget)(command chprop p \ c \) (princ))(defun c:c3()(ssget)(command chprop p \ c \) (princ)) (defun c:c4()(ssget)(command chprop p \ c\) (princ))(defun c:c5()(ssget)(command chprop p \ c _x0005_ \) (princ))(defun c:c6()(ssget)(command chprop p \ c \) (princ))(defun c:c7()(ssget)(command chprop p \ c _x0007_ \) (princ))(defun c:c8()(ssget)(command chprop p \ c 8 \) (princ))你用C1 命令就可以将图元改为红色了.其余类似.删除红色图元(defun C:D1 (/ m A M)(setq m:err *error* *error* *merr*)(setvar cmdecho 0)(command UNDO G)瀨潲灭?选择图形)(setq A (ssget '((62 . 1)) ))(if (/= A nil)(progn(setq M (sslength A))(command erase A \)(princ \共删除红色图元<)(princ M)(princ >个)))(command UNDO E)(princ) ).就可以删除红色的图元了,命令D1 键入,这样．。
AUTOCAD中的几个LISP程序
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”，并求和。
LISP程序课件
• • • • • • • • • • •
\\ 表示字符 ”\” \” 表示字符 “” “ \r 表示回车 \n 表示换行 \nnn 表示八进制代码为nnn的ASCII字符 字符串常数的最大长度为100，但赋给一个符号的字符串长度没有这个限制。 下列都是合法的字符串 “\nEnter first point:” 注意换行的写法 “ABC\”D” 注意字符串中含“的写 法 “c:\\Autocad2000\\FONTS\\TEXT.SHX” 注意目录的写法 “” 空串 2.1.4 符号
• • • •
•
• • • • • •
2.1 AutoLISP的数据类型 整型(INT)、实型(REAL)、字符型(STR)、符号(SYM)、表(LIST)、内部函数 (SUBR)、文件描述符(FILE)、实体名(ENAME)、选择集(PICKSET)、函数分 页表(PAGETB)、VLA对象（Visual Lisp Activex）。 2.1.1整型 整数由数字组成，不包含小数点。AutoLISP 的整数是 32 位带符号的数，取 值范围从 +2,147,483,647 到 -2,147,483,648（注意，getint 函数只接受 16 位的数，即 +32767 到 -32678）。当用户在 AutoLISP 表达式中直接使用整 数时，该值被称为常量。数字 2、-56 和 1,200,196 都是有效的 AutoLISP 整 数。 如果输入的数超出了允许的最大整数（导致整数溢出），AutoLISP 会将整数 转换为实数。然而，如果对两个有效整数执行算术运算，其结果超出了允许 的最大整数，得出的数是无效的。下面样例说明 AutoLISP 如何处理整数溢 出。 最大的正整数保留其值： _$ 2147483647 2147483647 如果输入一个大于允许最大值的整数，AutoLISP 将其值返回为实数： _$ 2147483648 2.14748e+009
第11章 设计Auto_LISP程序
AutoLISP的语法结构 AutoLISP的功能函数 Visual LISP编写环境 AutoLISP程序设计与应用 实例练习 习题
11.1 AutoLISP的语法结构
图11-1 AutoLISP语法结构示例
11.2 AutoLISP的功能函数
1.数学运算功能函数 2.逻辑运算功能函数 3.转换运算功能函数 4.列表处理功能函数 5.字符串、字符、文 件处理函数 6.等待输入功能函数 7.几何运算功能函数 8.对象处理函数功能
其函数书写格式和返回值如下： （1）(APPEND 列表 列表 …) 返回：结合所有列表成一个列表。 （2）(ASSOC 关键元素 联合列表) 返回：根据关键元素找寻列表中的关键信息。 （3）(CAR 列表) 返回：列表中的第一个元素，通常用来求X坐标。 （4）(CADR 列表) 返回：列表中的第二个元素，通常用来求Y坐标。 （5）(CADDR 列表) 返回：列表中的第三个元素，通常用来求Z坐标。
（6）(READ_LINE［文件代码］) 返回：经由键盘或文件中读取一行字符串。 （7）(READ_CHAR［文件代码］) 返回：经由键盘或文件中读取单一字符。 （8）(STRCASE 字符串［字样］) 返回：转换字符串大小写。 （9）(STRCAT 字符串1 字符串2 …) 返回：将各字符串合并为一个字符串。 （10）(STRLEN 字符串) 返回：字符串构成的字符数（字符串长度）。 （11）(WCMATCH 字符串 格式) 返回：Ｔ或nil，将字符串与通用字符串比较。
（6）(GETORIENT［基点］ ［提示］) 返回：请求输入角度数值，响应一个弧度值不受 ANGBASE，ANGDIR的影响。 （7）(GETPOINT［基点］ ［提示］) 返回：请求输入一个点的坐标。 （8）(GETREAL［提示］) 返回：请求输入一个实数值。 （9）(GETSTRONG［提示］) 返回：请求输入一个字符串。 （10）(INITGET ［位］ 字符串) 返回：设定下次GET*** 函数的有效输入。
AutoCAD-LISP实用程序
(setvar "plinetype" 0)
(setq pt0 (getpoint "\n 请输入视图的中心位置点:"))
(initget 7)
(setq loop T)
(while loop
(setq d (getreal "\n 请输入键槽处的轴径(12<d<130)(mm):"))
(if (= CTYPE "E") (setq INC INC1) (setq INC INC))
(if (= CTYPE "N") (setq INC INC3) (setq INC INC))
(setq TMS (FIX (+ 0.00001 (/ DIST INC))))
(setvar "OSMODE" 0)
多重复制
(defun C:CM ()
(setq A nil)
(setq OM (getvar "OSMODE"))
(setvar "OSMODE" 33)
(setq PNT1 (getpoint "\n拾取第一点： "))
(setq PNT2 (getpoint "\n拾取第二点： " PNT1))(terpri)
(setq A (ssget))
(setq INCR 0)
(repeat TMS
(setq INCR (+ INCR INC))
(setq NEWPT (polar PNT1 ANG INCR))
LISP函数(分类)大全
AutoLisp函数一、数学运算功能函数1．l（十数值数值…）返回：累计实数或整数数值1．2（一数值数值…）返回：差值1．3（* 数值数值…）返回：所有数值乘积1．4（/ 数值数值…）返回：第一个数值除以第二个以后数值的商1．5（l十数值）返回：数值十ll. 6（1—数值）返回：数值一ll．7（abs 数值）返回：数值的绝对值1．8（atan 数值）返回：反正切值1．9（cos 角度）返回：角度的余弦值，角度值为弧度1．10（exp 数值）返回：数值的指数1．11（expt 底数指数）返回：底数的指数值1．12（fix 数值）返回：将数值转换为整数值1．14（gcd 数值1 数值2）返回：两数值的最大公因数1．15（log 数值）返回：数值的自然对数值1．16（max 数值数值…）返回：数值中的最大值1．17（min 数值数值…）返回：数值中的最小值1．18 pi 常数∏，其值约为3．14159261．19（rem 数值 1数值 2）返回：M数值的相除的余数l．20（sin 角度）返回：角度的正旋值，角度值为弧度1．21（sqrt 数值）返回：数值的平方根二、检验与逻辑运算功能函数2．l（= 表达式1 表达式2）比较表达式1是否等于式2，适用数值及字符串2．2 （／= 表达式1 表达式2）比较表达式1是否大于等于表达式22．3（＜表达式1 表达式2) 比较表达式1是否＜小于表达式22．4（＜= 表达式1 表达式2）比较表达式1是否＜一小于等于表达式22．5（＞表达式1 表达式2）比较表达式1是否＞大于表达式22．6（＞= 表达式1 表达式2）比较表达式1是否大于等于表达式22．7 (～数值）返回：数值的位 not值，（1的补码）2．8 （and 表达式1 表达式2…）返回：逻辑and的结果2．9（boole 函数整数整数…）返回：位式布尔运算AutoLisp函数2/82．10(eq 表达式1 表达式2）比较表达式1与表达式2是否相同，适用列表比较（实际相同）2．11（equal 表达式 1表达式 2［差量］）比较表达式 1与表达式 2是否相同，差量可省略（内容相同）三、转换运算功能函数3．l（angtof 字符串［模式］）返回：角度值的字符串转成实数3．2（angtos 角度［模式［精度］］）返回：角度转成的字符串值3．3（atof 字符串）返回：字符串转成实数值3．4 （atoi 字符串）返回：字符串转成整数值3．5 （cvunit 数值原始单位转换单位）返回：数值转换单位后的值转换根据acad．nut 文件3．6（distof 字符串［模式］）返回：根据模式将字符串转成实数值3．7（itoa 整数）返回：整数转成字符串3．8（rtos 数值模式［精度］）返回：实数转成字符串3．9 （trans 点原位置新位置[位移]）返回：转换坐标系统值四、列表处理功能函数4．1 （append 列表列表……）结合所有列表成一个列表4．2（assoc 关键元素联合列表）根据关键元素找寻联合列表中关系信息4．3 (car 列表)返回列表中的第一个元素，通常用来求X坐标4．4（cadr 列表）返回列表中的第二个元素，通常用来求y坐标4．5（caddr 列表）返回列表中的第三个元素，通常用来求Z坐标4．6（cdr 列表）返回：除去第一个元素后的列表4．7（cons 新元素列表）返回：将新元素添加到列表4．8（foreach 名称列表表达式）返回：将列表的每一元素对应至名称再根据表达式执行响应4．9（length 列表）返回：列表内的元素数量4．10（list 元素元素…）返回：将所有元素合并为一列表4．11（listp 元素）返回：判断元素是否为一串4．12（mapcar函数列表1列表2…）返回：将列表1、列表2列表的元素配合函数，求得新列表4．13（member 关键元素列表）返回：根据关键元素（含似后的列表4．14（nth n 列表）返回：列表的第n个元素AutoLisp函数3/84．15（reverse 列表）返回：将列表元素根据顺序颠倒过来的列表4．16（subst 新项旧项列表）返回：替换新旧列表后的列表五、字符串、字符、文件处理函数5．l（ascii 字符串）返回：字符串第一个字符的“ASCII”码5．2 （chr 整数）返回：整数所对应的ASCII单一字符串5．3（close 文件名称）关闭文件5．4（open 文件名模式）返回：打开文件代码，准备读取或写入信息5．5（read 字符串）返回：列表中的字符串的第一组元素5．6（read－char［文件代码］）返回：通过键盘或文件中读取单一字符5．7（read－line ［文件代码］）返回：经由键盘或文件中读取一行字符串5．8（strcase 字符串［字样］）返回：转换字符串大小写5．9（strcat 字符串1字符串2…）返回：将各字符串合并为一个字符串5．10（strlen 字符串）返回：字符串构成的字符数（即字符串长度）5．11（substr 字符串起始长度）返回：取出于字符串‘5．12（wcmatch 字符串格式）返回：T或 nil，将字符串与通用字符进行比较5．13（write－char数值［文件代码］）返回：将一ASCII字符写到文件或屏幕 15．14（write－line字符串［文件代码］）返回：将字符串写到文件或屏幕上六、等待输入功能函数6．l （getangle ［基点］ [提示］）请求输入十进制角度数值，响应一个弧度值提示及参考点可有可无6．2（getcorner 基点［提示］）请求输入另一矩形框对角点坐标 6．3（getdist ［基点］［提示］）请求输入一段距离6．4（getint ［提示］）请求输入一个整数值6．5（getkword ［提示］请求输入“关键词”6．6（getorient ［基点］［提示］）请求输入十进制角度，响应一弧度值不受angbase、angdir 影响6．7（getPoint ［基点］［提示］）请求输入一个点的坐标6．8（getreal ［提示］请求输入一个实数6．9（getstring [提示］）请求输入一个字符串6．10（initget ［位］字符串）设定下次getxxx函数的有效输入七、几何运算功能函数7．l（angle 点1 点2）取得两点的角度弧度值7．2（distance 点1 点2）取得两点的距离7．3（inters 点1 点2 点3 点 4［模式］）取得两条线的交点7．4（osnap 点模式字符串）按照捕捉模式取得另一坐标点7．5（polar 基点弧度距离）按照极坐标法取得另一坐标点7.6（textbox 对象列表）取得文字字符串的两个对角点坐标八、对象处理功能函数8．l（entdel 对象名称）删除或取消删除对象8．2（entget 对象名称［应用程序列表］）取出对象名称的信息列表8．3 (entlast）取出图形信息中的最后一个对象8．4（entmake 对象列表）建立一个新的对象列表8．5（entmod 对象列表）根据更新的信息列表更新屏幕上元体8．6（entnext [对象名称]）找寻图面中的下一个对象8．7（entsel ［提示］）请求选取一个对象，响应包含对象名称及选点坐标的列表；8．8（entupd 对象名称）更新屏幕上复元体图形8．9（handent 图码）返回：图码的元体名称8．10（nentsel［提示］）返回：BLOCK所含副元体对象信息列表8．11（nentselp ［提示］［点］）返回：BLOCK所含副元体对象信息似4*4矩形表示）九、选择集、符号表处理函数9．l（ssadd [对象名称］［选择集］）将对象加入选择集或建立一新选择集9．2（ssdel 对象名称选择集）将对象自选择集中移出9．3（ssget ［模式］［点 1］［点 2］取得一个选择集9．4（ssget ”X” [过滤列表］）取得根据过滤列表所指定范围的选择集9．5（sslenth 选择集）计算选择集的对象个数9．6（ssmemb 对象名称选择集）响应对象名称是否包含于选择集内9．7（ssname 选择集索引值）根据索引值取出选择集中的对象名称9．8（tblnext 符号表名称［T］）检视符号表，有效的符号表：”LAYER”、”LTYPE”、”VIEW”、”STYLE”、”BLOCK”9．9（tblsearch 符号表名称符号）在符号表中搜寻符号十、AutoCAD相关查询、控制功能函数10．l（command ”AutoCAD命令”…）超重量级函数，调用执行 AutoCAD命令AutoLisp 函数5/810．2（findfile 文件名）返回：该文件名的路径及文件名10．3（getfiled 标题内定档名扩展名旗号）通过标准 AutoCAD文件对话 DCL对话框获得文件10．4（getenv ”环境变量”）取得该环境变量的设定值，以字符串表示10．5（getvar ”系统变量”）取得该系统变量的设定值，以字符串表示10．6（setvar ”系统变量”值）设定该系统变量的值10．7（regapp 应用类项）将目前的AutoCAD图形登记为一个应用程序名称十一、判断式、循环相关功能函数11．1（If ＜比较式＞＜表达式1＞ [表达式2] 检算比较式结果，如果为真，执行＜表达式1＞，否则执行＜表达式2＞11．2（ repeat 次数 [< 表达式＞＜表达式＞…］）重复执行 N次表达式11．3（While ＜比较式＞＜表达式＞…）当条件成立则执行表达式内容11．4（cond ＜比较式 1＞＜表达式 1＞多条件式的 if整合功能＜比较式2＞＜表达式2＞＜比较式3＞＜表达式3＞）11．5 （ prong 表达式1 表达式2…）连接其中的表达式为一组，常用于配合if、cond 等函数十二、函数处理、定义、追踪与错误处理功能函数12．l（*error* 字符串）程序错误时的警示信息12．2（alert 字符串）以对话框式显示出警告字符串12．3（apply 功能函数列表）将功能函数与列表结合后执行12．4（defun 名称自变量列表表达式＿．）自定函数或子程序12．5（eval 表达式）返回：表达式的执行结果12．6（exit）强制退出目前的应用程序12．7（lambda 自变量表达式）定义未命名的函数12．8（progn 表达式1 表达式2…）连接其内的表达式为一组，常用于配合if、cond等函数12．9（quit）强制退出目前的应用程序12．10（tablet 代码 [列1列2列3方向]）取用或建立对数字板的校调12．11（trace 函数…）对函数设定追踪标记，辅助检错12．12（untrace 函数…）对函数设定解除追踪标记AutoLisp函数6/8十三、显示、打印控制功能函数13．l（gfaphscr）作图环境切换到图形画面13．2（grclear）暂时清除模前的屏幕画面13．3（grdraw起点终点颜色[亮显］）暂时性的画出一条线13．4（grread［追踪］）由输入设备读取追踪值13．5（grtext位置字符串［亮显］）将字符串显示在状态列或屏幕菜单上13．6（grvecs向量列表［转置矩阵］）暂时性的画出多条线13．7（menucmd字符串）；提供在 AlltOLISP中调用各菜单13．8（Prinl［表达式［文件代码］］将表达式打印于命令区或已打开的文件句柄字符则以“\”为前缀展开13．9（pinc［表达式［文件代码］］除句柄字符则不以”＼”为前缀展外开其余同Prinl 13．10（print［表达式［文件代码］］除表达式会往下一新行列出，及空一格外其余同prinl13．11（prompt信息）将信息显示于屏幕的命令区，并随后响应一个nil信息13．12（redraw［对象名称［模式］］）重绘整张图或根据对象名称重绘该图形13．13（terpri）在屏幕上显示新列13．14（textscr）作图环境切换到文字画面13．15（textpage）清除文字画面文字类似 DOS的cls命令13．16（vports）返回：窗口组态列表十四、符号、元素、表达式处理功能函数14．l（atom元素）如果元素不是列表，响应T，否则为nil14．2（atoms－family格式闲号列表］）返回：一组己定义函数的符号列表14．3（boundp表达式）返回：T或 nil，响应表达式是否有值存在14．4（minusp元素）返回：T或n儿元素是否为负值14．5（not元素）返回：T或n儿判定元素是否为ni114．6（null元素）返回：T或nil判定元素是否被赋予nil值14．7（numberp元素）返回：T或nil，元素是否为整数或实数14．8（quote表达式）响应表达式未检算前状态，同“‘”功能14．9（set符号表达式）将表达式结果设定给带单引号’符号14．10（setq符号1 表达式1［符号2表达式2］…）设定表达式结果给各符号14．11（type元素）返回：元素的信息型态14．12（zerop元素）返回：T或nil，元素是否为0值十五、ADS、ARX、AutoLISP加载与卸载函数AutoLisp函数7/815．l（ads）返回：目前加载ADS程序列表15．2（arx）返回：目前加载 ARX程序列表15．3（arxload应用程序［出错处理］））返回：加载 ARX程序15．4（arxunload应用程序［出错处理］））返回：卸载 ARX程序15．5（ver）返回：目前 AutoLISP版本字符串15．6（load LSP文件名［加载失败］）加载 AutoLISP文件（*．lsp）15．7 （xload应用程序[错处理]）加载ADS应用程序15．8 （xunloa应用程序［出错处理］）卸载 ADS应用程序十六、内存空间管理函数16．l（alloc数值）以节点数值设定区段大小16．2（expand数值）以区段数值配置节点空间16．3（gc）强制收回废内存16．4（mem）显示目前的内存使用状态16．5（xdroom对象名称）返回对象扩展信息允许使用的内存空间16．6（xdsize列表）返回对象扩展信息所占用的内存空间十七、其它重要的功能函数17．l（acad_colordlg 颜色码旗号）显示出标准 AutoCAD颜色选择对话框17．2（acad_helpdlg 求助文件名主题）显示出标准 AutoCAD求助对话框17．3（acad_strlsort字符串列表）作字符串列表排序17．4（bherrs）取得 bhatch与 bpcly失败所产生的错误信息17．5（bhatch点［选择集[向量］］）根据 Pick point选点方式调用 bhatch命令，绘制选集区域的剖面线17．6（bpoly点［选择集[向量]］）根据Pick point选点方式调用bpoly命令并产生一定域Polyline17．7（cal计算式字符串）执行如 CAL计算功能十八、ADS、ARX外部定义的3D函数18.1（align自变量 1 自变量 2．．．．）执行如 ALIGN命令各选项顺序18．2（c：3dsin模式3DS文件名）导入3DS文件18．3（C：3dsout模式3DS文件名）输出3DS文件18．4（c：background模式［选项］）设定渲染背景18．5（C：fog模式［选项］）设定渲染的雾效果18．6（C：light模式［选项］）设定渲染的灯光控制18．7（c：lsedit模式【选项1】设定渲染的景物控制18．8（C：lslib模式［选项］）管理景物图库18．9（c：matilb模式材质材质库名）管理材质数据库18．10（c：mirror3d 自变量1 自变量2……）执行如MIRROR3D命令18．11（C：psdrap模式）根据模式设定值（0或1），传唤psdrap命令18．12（C：psfill对象名称图案名称［自变量1［自变量2］］）以POStSCript图案填满18．13（c：psin文件名位置比例）插入一个Postscript（*．eps）文件18．14（c：render［渲染文件］）执行渲染效果18．15（C：r格式自变量1 自变量2 自变量3…）设定执行渲染选项18．16（c：replay影像文件名影像类别［选项］）展示影像文件TGA、BMP、TIF18．17（C：rmat模式选项）控管材质建立、贴附、编辑、分离18．18（c：rotate3d自变量 1 自变量2…）执行如 ROTATE3D命令各选项顺序18．19（C：rpref模式选项［设定］）渲染环境设定18．20（c：saveimg影像文件名影像类别［选项］）储存图像文件TGA、BMP、TIF 18．21 （c：scene模式 [选项]） SCENE场景管理18．22（C：setuv模式选集自变量1 自变量2…）SETUV贴图模式管理18．23（C：showmat自变量1）显示对象的材质贴附信息18．24（C：solprof自变量 1 自变量工．．）建立 3D实体的轮廓影像18．25（C：StatS［渲染信息文件］）显示渲染信息统计信息十九、ADS、ARX 外部定义的数据库相关函数19．l（c：aseadmin自变量1 自变量2…）管理外部数据库19．2（c：aseexportt自变量1 自变量2…）输出信息19．3 （c：aselinks自变量1 自变量2…）连接对象与信息19．4（c：aserow自变量1 自变量2…）管理外部信息表格19．5（c：aseselect自变量1 自变量2…）建立外部信息与对象选集19．6 （c：asesqled自变量 1 自变量2…）执行SQL程序。
cad画缓和曲线lisp程序(1)
CAD中画缓和曲线，首先复制本文☆后面的源程序保存至cad安装目录的SUPPORT文件夹，保存类型为.lsp 可以随便复制一个SUPPORT文件夹内的lsp文件，然后替换本文的程序。
打开CAD后，输入appload回车，找到你保存的缓和曲线lsp程序，点击加载，然后就可以画缓和曲线了。
首先，要画出缓和曲线的两条直线，然后输入HH回车，按提示完成缓和曲线。
注：本程序，缓和曲线段拟合长度为，如需更改拟合长度，将程序的第8行(repeat (FIX(/ Ls )及9行(setq l (+ l (/ Ls (FIX(/ Ls )))中的修改即可。
☆;;多义线摹拟缓和曲线。
;;输入起止直线、半径、缓和曲线长或设计车速。
;;命令：HH(defun com_p()(setq l 0)(command "ucs" "o" (list (- 0 x1) 0 0))(command "pline" (list 0 0 0) "w" "0" ""(repeat (FIX(/ Ls )(setq l (+ l (/ Ls (FIX(/ Ls )))x (+ (- l (/ (* l l l l l) 40 C C)) (/ (* l l l l l l l l l) 3456 C C C C))y (* id__ (+ (- (/ (* l l l) 6 C) (/ (* l l l l l l l) 336 C C C)) (/ (* l l l l l l l l l l l) 42240 C C C C C))));setq(command (list x y 0)));repaet);command(setq pt5 (trans (list x y 0) 1 0)));com_p(defun ll_v()(setq V (getreal "\nGive Velocity:")Ls1 (* VLs2 (/ (* V V V) R)Ls (max Ls1 Ls2 (/ R 9))Ls (* (fix (/ Ls 10)));setq(if (> Ls R) (setq Ls R))(ll_d));ll_v(defun ll_d()(setq os (getvar "osmode"))(setvar "osmode" 0)(setq C (* Ls R)q (- (+ (- (/ Ls 2) (/ (* Ls Ls Ls) 240 R R)) (/ (* Ls Ls Ls Ls Ls) 34560 R R R R)) (/ (* Ls Ls Ls Ls Ls Ls Ls) 8386560 R R R R R R)) pt1 (cdr (assoc 10 (entget (car p1))))pt2 (cdr (assoc 11 (entget (car p1))))pt10(polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2))pt3 (cdr (assoc 10 (entget (car p2))))pt4 (cdr (assoc 11 (entget (car p2))))pt20(polar pt3 (angle pt3 pt4) (/ (distance pt3 pt4) 2))p (+ (- (/ (* Ls Ls) 24 R) (/ (* Ls Ls Ls Ls) 2688 R R R)) (/ (* Ls Ls Ls Ls Ls Ls) 506880 R R R R R))jd (inters pt1 pt2 pt3 pt4 nil)alf1(angle pt10 jd)alf2(angle pt20 jd)alf (- (angle jd pt20) alf1));setq(if (or (> alf pi) (and (< alf 0) (> alf (- 0 pi))))(progn(setq id__ -1)(if (> alf pi) (setq alf (- (+ pi pi) alf)) (setq alf (abs alf))));progn(progn(setq id__ 1)(if (<= alf (- 0 pi)) (setq alf (+ pi pi alf))));progn);if(setq x0 (/ (* (+ p R) (sin(/ alf )) (cos(/ alf ))x1 (+ x0 q)Cl (+ (* alf R) Ls)E (- (/ (+ R p) (cos(/ alf 2))) R));setq(command "ucs" "o" jd)(command "ucs" "z" (/ (* 180 alf1) pi))(com_p) (setq pt6 pt5)(setq ppt1 (list x1 0 0))(command "ucs" "")(command "ucs" "o" jd)(command "ucs" "z" (/ (* 180 alf2) pi))(setq id__ (- 0 id__)) (com_p)(setq ppt2 (list x1 0 0))(command "ucs" "")(if (> (abs(distance jd pt1)) (abs(distance jd pt2)))(setq ptt1 pt1)(setq ptt1 pt2));if(setq ptt2 (polar jd alf1 (- 0 x1)))(thh p1 ptt1 10)(thh p1 ptt2 11)(if (> (abs(distance jd pt3)) (abs(distance jd pt4)))(setq ptt3 pt3)(setq ptt3 pt4));if(setq ptt4 (polar jd alf2 (- 0 x1)))(thh p2 ptt3 10)(thh p2 ptt4 11)(if (= id__ 1) (command "arc" pt5 "e" pt6 "r" R) (command "arc" pt6 "e" pt5 "r" R))(setq alfd (angf alf))(setvar "osmode" os)(command "cmdecho" "1")(command "text" pause pause "" (strcat "偏角＝" alfd))(command "cmdecho" "0")(command "text" "" (strcat "半径＝" (rtos R 2 2)))(command "text" "" (strcat "切线长＝" (rtos x1 2 2)))(command "text" "" (strcat "曲线长＝" (rtos Cl 2 2)))(command "text" "" (strcat "外距＝" (rtos E 2 2)))(command "text" "" (strcat "缓曲长＝" (rtos Ls 2 2))));ll_d(defun angf (alf)(setq alff (angtos alf 1 4)n 1kk (strlen alff))(repeat kk(setq alfn (substr alff n 1))(if (= alfn "d")(setq nn n));if(setq n (+ n 1)));repeat(strcat (substr alff 1 (- nn 1)) "%%" (substr alff nn)));angf(defun c:hh(/ p1 p2 pt1 pt2 pt3 pt4 pt5 pt6 pt10 pt20 id__ R V Ls E p3r1 x y l x0 x1 C jd alf alf1 alf2 q p Cl Ls1 Ls2)(command "ucs" "")(setq p1 nil p2 nil)(while (= p1 nil) (setq p1 (entsel "\n拾取第一条直线:")))(redraw (car p1) 3)(while (= p2 nil) (setq p2 (entsel "\n拾取第二条直线:")))(redraw (car p2) 3)(initget 1)(setq R (getdist "\n请输入圆曲线半径R: "))(initget 1 "Ls V")(setq p3 (getdist "\n输入缓和曲线长度(Ls)或[设计速度(V)]： ")) (if (= p3 "V") (ll_v) (progn (setq ls p3) (ll_d)))(princ));eline(defun thh(len pt h)(setq en_data (entget (car len))old_data (assoc h en_data)new_data (cons h pt)en (subst new_data old_data en_data));setq(entmod en));thh。
自动生成图层 LISP程序
(command "layer" "n" "4" "c" "4" "4" "") ;去建层 4 把色 4(青色)付偶给 4 层 ) ;如有层 4 就不执行 (if (not (tblsearch "layer" "5")) ;;你图内无层 5
批注本地保存成功开通会员云端永久保存去开通
;加载线型 (if (not (tblobjname "ltype" "Center") ) (command "linetype" "l" "center" "" "")
) (if (not (tblobjname "ltype" "jis_09_15") ) (command "linetype" "l" "jis_09_15" "" "")
(command "layer" "n" "5" "c" "5" "5" "") ;去建层 5 把色 5(蓝色)付偶给 5 层 ) ;如有层 5 就不执行 (if (not (tblsearch "layer" "6")) ;;你图内无层 6
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
AutoCAD在测绘中的应用
2.AutoLISP语言程序示例 例1：下面定义的是一个用多义线画正方形的函数： (defun C:hzfx(/ pt1 pt2 pt3 pt4 len) (setq pt1(getpoint "Lower left corner：")) (setq len(getdist "Length of one side：")) (setq pt2(polar pt1 0.0 len)) (setq pt3(polar pt2(/ pi 2.0)len)) (setq pt4(polar pt3 pi len)) (command "pline" pt1 pt2 pt3 pt4 "C") ) 像这样的定义函数，在用load函数装载(load "hzfx") 后，就可以在Command：提示行只输入函数名的“hzfx”部分。
2018/10/4 8
AutoCAD在测绘中的应用
练习5:自定义一个求和函数（qh）， S=12+22+32+…n2
(defun c:qh( ) (setvar "cmdecho" 0);关闭中间结果显示 (setq n(getint "请输入一个正整数:")) (setq s 1) (setq j 1) (while(< j n) (setq s(+ s(*(+ j 1)(+ j 1)))) (setq j(1+ j)) ) (print s) )
2018/10/4 4
AutoCAD在测绘中的应用
练习2：定义输入矩形的对角点绘制矩形的命令函数。
p4
p1
p3
p2
(defun c:hzjx (/ p1 p2 p3 p4) (setq p1(getpoint "\n输入矩形的一个角点：")) (setq p3(getpoint "\n输入矩形的另一个角点：")) (setq p2(list (car p3)(cadr p1))) (setq p4(list (car p1)(cadr p3))) (command "pline" p1 p2 p3 p4 "c") )
2018/10/4
p3
p7
pc
p2
p4
7
p6
AutoCAD在测绘中的应用
练习4:自定义一个函数（ht），完成新建图层为“zy”，图层颜色为红色，在该 图层绘制符合下图尺寸和相关要 求的图形（见红色部分）要求执行此函数时使 用键盘输入第1个圆的圆心坐标。 (defun c:ht( ) (setvar "cmdecho" 0);在命令行不显示ht提示 (setq pt1(getpoint "frist dian")) 第2个圆 (setq r 10 len 20) (setq pt2(polar pt1 (/ pi 4) (+ r len r))) (setq pt3(polar pt1 (/ pi 4) r) ) (setq pt4(polar pt3 (/ pi 4) len) ) 第1个圆 (command "layer" "n" "zy" "") ;新建作业层 (command "layer" "c" "1" "zy" "");定义作业层颜色 (command "layer" "s" "zy" "") ;将作业层设为当前层 (setvar "osmode" 0);关闭对象捕捉 (command "circle" pt1 r "") (command "circle" pt2 r "") (command "line" pt3 pt4 "") )
AutoCAD在测绘中的应用
10.6 AutoLISP程序调试与编程实例
1.AutoLISP语言程序的调试方法 程序的调试过程就是程序运行中反复发现错误和修改错误， 直到满足设计要求的过程。其中最主要的是如何发现错误发生 的位置及其性质。AutoLISP程序是以解释方式执行的，运行出 错时，一般先终止程序运行，并显示出错信息。 （1）AutoLISP语言调试的一般方法 （2）设置断点打印变量值的方法 （3）分段调试法 （4）单步执行调试法
2018/10/4 9
AutoCAD在测绘中的应用
实验编码：G1201009 实验名称：AutoLISP语言上机练习 1、熟悉和了解AutoLISP的结构特点； 2、熟悉和了解AutoLISP语言各种函数； 3、简单lisp程序编制 ① 定义一个绘制矩形的函数，要求通过交互方式输入矩 形左下角点和右上角点坐标绘制矩形。 ② 见图，圆心位于正方形中心， 正方形边长20、圆半径5，正方形的左下角 点坐标通过交互方式输入，定义一LISP函数 绘制该图。
2018/10/4 5
AutoCAD在测绘中的应用
练习3：用AutoLISP语言编写一个名为“tuxing”的自定义命 令函数。要求执行此函数时使用键盘输入一个圆的圆心坐标 和半径值，然后自动绘出该圆、两条中心线和与该圆同心的 正方形（边长等于圆的直径）。
p8 p3 p7
p1
pc
p2
p5
2018/10/4
2018/10/4 2
AutoCAD在测绘中的应用
例2：下面是一个绘制路灯符号的lisp程序。
(defun C:hld(/ dwd r ) ;画路灯符号 (setq dwd(getpoint "inter dingweidian： ")) (setq r 0.5 ) (setq pt1(polar dwd (/ pi 2.0) 0.5)) (setq pt2(polar pt1(/ pi 2.0)3.0)) (setq pt3(polar pt2 0.0 1)) (setq pt4(polar pt2 pi 1)) (setq pt5(polar pt4 (-(/ pi 2)) 0.5)) (setq pt6(polar pt5 (-(/ pi 2)) 0.5)) 2.0 (setq pt7(polar pt3 (-(/ pi 2)) 0.5)) (setq pt8(polar pt7 (-(/ pi 2)) 0.5)) (command "circle" dwd r "") (command "circle" pt6 r "") (command "circle" pt8 r "") (command "line" pt1 pt2 pt3 pt7 "") (command "line" pt2 pt4 pt5 "") ) 2018/10/4
p4
p6
6
AutoCAD在测绘中的应用
(defun c:tuxing ( / pc r p1 p2 p3 p4 xc yc) (setq pc (getpoint "\n 输入圆心坐标点:")) (setq r (getreal "\n 输入圆的半径:")) (setq p1 (polar pc pi (+ r 3))) (setq p2 (polar pc 0 (+ r 3))) (setq p3 (polar pc (/ pi 2)(+ r 3))) (setq p4 (polar pc (/ (* pi 3) 2) (+ r 3))) (command "circle" pc r) p8 (command "line" p1 p2 "") (command "line" p3 p4 "") (setq xc (car pc) yc (cadr pc)) p1 (setq p5 (list (- xc r) (- yc r))) (setq p6 (list (+ xc r) (- yc r))) (setq p7 (list (+ xc r) (+ yc r))) (setq p8 (list (- xc r) (+ yc r))) p5 (command "line" p5 p6 p7 p8 "C") )
2018/10/4 10
根据《图式》
2.0 1.5 4.0
84.46
1.0
3
AutoCAD在测绘中的应用
练习1：写出在AotuCAD编辑状态中运行函数tu时，在 屏幕图形区和文本区的显示结果。
(defun C:tu ( / pc1 pc2 pc3 r ) (setq pc1 (list 50.0 50.0)) (setq r 20 ) pc2 (setq pc2 (polar pc1 (/ pi 2) (* r 2))) pc3 (setq pc3 (polar pc2 pi (* r 2))) (command "circle" pc1 r ) (command "circle" pc2 r ) (command "circle" pc3 r ) (command "line" pc1 pc2 pc3 "c" ) pc1 (princ pc1) (princ pc2) (princ pc3) (princ r) 文本区：(50.0 50.0) (50.0 90.0) (10.0 90.0) 20 )