几个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 命令,就可以删除红色的图元了.。
- 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 )