CADLISP程序

合集下载

CAD展点程序lisp

CAD展点程序lisp2009年02月17日星期二01:08 P.M.（1）依网上资源文件修改的：－－－－－－－－－－－－－－－－－－－－－－CAD展点程序把下文保存到文本文件中，扩展名改为.lsp,按数据格式要求准备好数据点文件。

在CAD中加载lsp文件。

运行命令：kszd－－－－－－－－－－－－－－－－－－－－－－;LISP展点程序;展1000点：在HP(AMD Athlon64 3000+ 256MB)电胶上仅耗时0.142秒；; 在金利(Geleron(R) CPU 2.40GHz 256MB)电胶上耗时0.882秒;数据文件格式为：每一点的数据（点号、X、Y、H）为一行，用逗号或空格作为分隔符，即;点号1 X1 Y1 H1 或者点号1, X1, Y1, H1;点号2 X2 Y2 H2 或者点号2, X2, Y2, H2;点号3 X3 Y3 H3 或者点号3, X3, Y3, H3;......;点号n Xn Yn Hn 或者点号n, Xn, Yn, Hn1(defun c:kszd()(setq ff (open (getfiled "请选择要展点的数据文件" "" "txt" 2) "r")fhb nil t0 (getvar "cdate")cm (getvar "cmdecho") os (getvar "osmode")tcm1 "高程注记" tcm2 "点记")(setvar "cmdecho" 0)(setvar "osmode" 0)(if (= (tblsearch "layer" tcm1) nil) (command "layer" "n" tcm1 ""))(if (= (tblsearch "layer" tcm2) nil) (command "layer" "n" tcm2 ""))(while (setq zb (read-line ff))(while (vl-string-search "," zb) (setq zb (vl-string-subst " " "," zb)))(setq zb (read (strcat "(" zb ")"))zb (list (list (nth 2 zb) (nth 1 zb)) (vl-princ-to-string (last zb)));注记高程;zb (list (list (nth 2 zb) (nth 1 zb)) (vl-princ-to-string (car zb)));提示：注记点号请用该行fhb (append fhb (list zb))))(setq t1 (getvar "cdate"))(close ff)(setq zb (vl-sort fhb '(lambda (e1 e2) (< (car (car e1)) (car (car e2))))) x0 (car (car (car zb))) x1 (car (car (last zb)))zb (vl-sort fhb '(lambda (e1 e2) (< (cadr (car e1)) (cadr (car e2))))) y0 (cadr (car (car zb))) y1 (cadr (car (last zb))))(command "zoom" "w" (list x0 y0) (list x1 y1))(setq t2 (getvar "cdate"))(foreach zb fhb(setq zfc (last zb);pt (mapcar '+ (car zb) '(1.5 -1.25));这行改为如下pt (car zb))(entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") '(62 . 3) '(40 . 2) '(50 . 0.0);(cons 8 tcm1) (cons 1 zfc) (cons 10 pt);这行改为如下(cons 8 tcm1) (cons 1 zfc) (cons 10 (mapcar '+ pt '(1.5 -1.25))) ) )(entmake (list '(0 . "OINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint")'(62 . 2)(cons 8 tcm2) (cons 10 pt))))(setq t3 (getvar "cdate")dt1 (* 1000000 (- t1 t0))dt2 (* 1000000 (- t3 t2)))(princ (strcat "读入数据共耗时：" (rtos dt1 2 3)"秒展点共耗时" (rtos dt2 2 3) "秒""展点数：" (itoa (length fhb))"个每展一点耗："(rtos (/ dt2 (length fhb)) 2 10) "秒"))(setvar "cmdecho" cm)(setvar "osmode" os)(princ))－－－－－－－－－－－－－－－－－－－－－－---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------修改上面的程序，以根据数据点的坐标加入自写的块，块名称这里为：inblock.dwg依情况自行修改程序相应位置，块文件应放在与待插入块的文件同一目录，即工作目录。

CAD LISP 程序教学内容

C AD L I S P程序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))(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)))(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)))(setq pp2 (list x2 y2 z2))))(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 pp1 pp2));;获取角度(if (> (* (/ ang pi) 180) 180) (setq ang (+ ang pi)))(command "text""j""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 命令,就可以删除红色的图元了.。

CAD二次开发Visual_LISP指南

CAD二次开发Visual_LISP指南CAD二次开发是指在CAD软件平台上进行个性化开发和定制化编程，以满足用户特定需求Visual LISP是AutoCAD软件的一种编程语言，通过使用Visual LISP语言可以对AutoCAD进行二次开发。

下面是CAD二次开发Visual LISP的指南，希望对开发人员有所帮助。

一、入门准备1.学习基础知识在开始进行CAD二次开发前，需要充分了解AutoCAD软件的基本功能和特点，熟悉CAD软件的界面、命令、对象模型以及常用API（应用程序接口）等。

2.掌握Visual LISP语言Visual LISP是CAD软件平台上的一种编程语言，与AutoLISP类似。

学习和掌握Visual LISP语言是进行CAD二次开发的基础。

可以通过学习书籍、在线教程和参考文档等途径来提高自己的编程能力。

3.安装开发工具需要安装CAD软件的开发工具，例如AutoCAD自带的AutoCAD Developer Tools或者Visual LISP IDE等。

这些工具提供了编写、调试和管理二次开发项目的必要环境。

二、开始二次开发1.确定需求在进行CAD二次开发前，需要明确开发的具体需求和目的。

这可以包括添加自定义命令、修改现有功能、创建用户界面等等。

确保清晰地定义需求和目标，以便更好地进行开发工作。

2.编写代码通过Visual LISP语言编写代码来实现二次开发的需求。

VisualLISP提供了一系列的函数和命令，可以对AutoCAD的对象模型进行访问和操作。

根据需求，编写相应的函数、宏和命令，实现具体的功能。

3.调试和测试在编写代码后，进行调试和测试是不可或缺的步骤。

通过运行调试器、打印日志、进行单元测试等方式来验证代码的正确性和稳定性。

及时修复和调整代码中的问题，确保其能够正常运行。

4.文档和发布完成开发工作后，建议对代码进行适当的文档整理和注释，方便后续的维护和管理。

CAD中加载lisp等应用程序的方法

CAD中加载lisp等应用程序的方法
时间:2011-07-26 15:51来源: 作者:懒人之家点击: 504 次
在CAD中加载lisp等应用程序的方法有下列几种方式：一、手动加载 1、依次点击菜单项的工具加载应用程序，打开加载/卸载应用程序对话框；或直接输入appload命令打开；见下图： 2、在打开的对话框中选择相应的lisp等应用程序后点击加载即可。

二、自动加载 1、
在CAD中加载lisp等应用程序的方法有下列几种方式：
一、手动加载
1、依次点击菜单项的“工具”→“加载应用程序”，打开加载/卸载应用程序对话框；或直接输入“appload”命令打
开；见下图：
2、在打开的对话框中选择相应的lisp等应用程序后点击“加载”即可。

二、自动加载
1、在上述手动加载的第1步打开的对话框中点击“内容”按钮；
2、在打开的启动组对话框中点击“添加”，从而将相应lisp等应用程序加入启动列表；
3、在每次打开CAD窗口时即可自动加载启动列表中的程序。

CAD中自动画管线图的LISP程序

(defun c:brel(/myosmode horv p p1 p2 p3)
(setq myosmode (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq p (getpoint "\nSelect point to break:"))
(initget 1P程序
画一些管路原理图时，当代表不同管路的直线在图中相交时，需将在交点处的某一直线断开，再用一半圆连接两断点，使用下面这个LISP编写的程序，只用键入"brel"的命令，其它的就由电脑去完成了。
程序中使用"break"命令截断需要被断开的管线，再用"arc"命令画一半圆连接两断点。变量p读取管线交点；p1、p2为点p的左右或上下两点；p3为连接p1、p2半圆的中点。由于使用"break"命令时若AUTOCAD环境处于对象捕捉方式（OSMODE≠0），则"break"命令截断的p1、p2两点可能为变为p1、p2附近的捕捉点。所以程序开始时用变量myosmode记录系统变量OSMODE，而后设置OSMODE为0，程序结束后再设置还原OSMODE。变量horn判断用户需要断开的是水平线还是垂直线。
(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)))

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

超经典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程序画剪力墙暗柱很实用。

五个实用的AutoCAD的lisp程序

五个实用的AutoCAD的lisp程序1、计算CAD图形中所有线段总长度(加载后只需框选所有线段便可得出这些线段的总长度)(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、标注CAD图形中所有线段(加载后只需框选所有线段便可得标注这些线段)(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))(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)))(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)))(setq pp2 (list x2 y2 z2))))(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 pp1 pp2));;获取角度(if (> (* (/ ang pi) 180) 180)(setq ang (+ ang pi)))(command "text""j""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、删除带颜色图元以下程序在别人的贴子里贴过.为了说明问题,今天再贴一次。

怎么在启动CAD时自动加载Lisp的工具和插件

怎么在启动CAD时自动加载Lisp的工具和插件网上有很多非常有用的CAD插件，能给绘图带来很多便利。

这些工具手动加载后就可以执行，但每次用的时候都要加载挺麻烦的，能不能在启动软件的时候把自己常用的插件加载进来？当然可以，而且方法还不止一种。

方法1：添加到启动组CAD的工具插件都可以通过appload(ap)命令来加载，在弹出的“加载\卸载应用程序”对话框中，可以找到“启动组”。

不同CAD 不一样，AutoCAD是在“启动组”下面有一个“内容”按钮，点击此按钮就可以需要启动时自动加载的程序加进去；浩辰CAD有一个“添加到启动组”按钮，可以将“历史记录列表”中加载过的程序添加到启动组中。

添加到启动组后，下次启动CAD的时候这些程序就会自动加载。

这种方式比较简单易行，任何操作起来都没有难度。

方法2：在启动的lisp文件加入LOAD语句。

无论是AutoCAD还是浩辰CAD等国产CAD，启动时都会有一个自动加载的LISP程序，AutoCAD加载的是acad.lsp或acadxxxx.lisp(xxxx为版本号)，acaddoc.lsp等（通常在AutoCAD 的support目录下），很多CAD病毒正是利用了这一点来加载从而影响CAD的应用；浩辰CAD等自动加载的LSP名为icadautoload.lsp，在安装的根目录下，浩辰CAD8以后的版本为SUPPORT目录下的gcad2013doc.lsp。

需要做的就是用记事本打开这些LSP，在里面加上类似下面的语句：(LOAD "x:\\xxxxx\\sp2pl.lsp")如果觉得写路径太麻烦，你就可以将程序复制刚才哪些自动加载LISP所在的路径。

关于CAD病毒因此如果遇到AutoCAD莫名奇妙出现不正常状态，你可以搜索所有acad*.lsp，看看在图纸所在目录是否有此类文件，是否有多个相同大小的此类LSP，如果有，删除掉后可以看看CAD是否恢复正常。

CAD创建Lisp程序步骤

使用Visual LISP创建简单的LISP应用程序作者：佚名点击数：1523 更新：2007-2-2 7:08:10 热★★★【字体：小大】a>本节通过一个简单的实例来讲述LISP程序的创建过程，介绍编制LISP程序的一些基本步骤，以及LISP程序在AutoCA D中的加载和运行的方法。

首先来创建一个最简单的LISP程序—-“Hello.lsp”，在AutoCAD 2002中加载并运行该程序，将会在命令行出现－“Hello, Visual LISP!”。

36.2.1 Visual LISP与AutoCAD的通信用户可以直接在AutoCAD命令行中键入AutoLISP表达式。

AutoCAD通过括号来确认AutoLISP表达式。

AutoCAD每当发现一个左括号，就确认为AutoLISP表达式，并由AutoLISP求表达式的值后返回AutoCAD，AutoCAD使用返回结果并继续进行其他工作。

注意在AutoLISP表达式中，左、右括号必须配对，否则AutoCAD将给出提示符n>，n表示右括号丢失数目。

此外，在AutoCAD中调用并执行AutoLISP程序。

在AutoLISP程序中采用COMMAND函数来与AutoCAD命令程序处理器通信，COMMAND从AutoLISP获得命令并将其传给AutoCAD。

36.2.2 实例1 最简单的LISP程序——“Hello.lsp”Step 1 创建新文件(1) 运行AutoCAD 2002系统，以“acadiso.dwt”为样板创建图形文件，并调用“vlisp”命令进入Visual LISP环境。

(2) 单击“Standard（标准）”工具栏中的按钮，新建一个LISP文件。

Step 2 输入代码并保存文件(1) 在编辑窗口中输入源文件“Hello.lsp”的代码，如图36-3所示。

程序清单如下：;;;* Hello.lsp –Visual LISP文件实例(prompt "Pick point:") ;指定运行时的提示信息(setq ipt (getpoint)) ;在屏幕上指定一点并将其坐标值赋予变量“ipt”(setq hgt 15) ;给变量“hgt”赋值(Command "_.TEXT" "_S" "STANDARD" ipt hgt 0 "Hello, Visual LISP!");调用“Commnad”函数与AutoCAD进行通信(2) 单击“Standard（标准）”工具栏中的按钮，以“Hello.lsp”为名保存该文件。

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”，并求和。

CAD画缓和曲线lisp程序

CAD中画缓和曲线，首先复制本文☆后面的源程序保存至cad安装目录的SUPPORT文件夹，保存类型为.lsp 可以随便复制一个SUPPORT文件夹内的lsp文件，然后替换本文的程序。

打开CAD后，输入appload回车，找到你保存的缓和曲线lsp程序，点击加载，然后就可以画缓和曲线了。

首先，要画出缓和曲线的两条直线，然后输入HH回车，按提示完成缓和曲线。

注：本程序，缓和曲线段拟合长度为0.4m，如需更改拟合长度，将程序的第8行(repeat (FIX(/ Ls 0.4))及9行(setq l (+ l (/ Ls (FIX(/ Ls 0.4))))中的0.4修改即可。

☆;;多义线摹拟缓和曲线。

;;输入起止直线、半径、缓和曲线长或设计车速。

;;命令：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 0.4))(setq l (+ l (/ Ls (FIX(/ Ls 0.4))))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 (* V 0.85)Ls2 (/ (* 0.0357 V V V) R)Ls (max Ls1 Ls2 (/ R 9))Ls (* (fix (/ Ls 10)) 10.0));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 2.0))) (cos(/ alf 2.0)))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。

CAD中LISP程序使用方法

CAD中LISP程序使用方法2007-08-06 19:13:32| 分类: 学习园地 |字号订阅1. 对于提供附件下载的，把附件下载就可以了2. 对于提供的源LISP代码，把代码拷贝、粘贴到一个文件，自己起个名或者若程序里面注释推荐了文件名，就用推荐的，然后保存成扩展名是LSP的文件即可了。

LISP程序使用方法:加载LISP1. 可以使用APPLOAD命令，然后去找到要加载的LISP文件，加载即可。

2. 可以自己从文件管理器把LISP文件拖动到ACAD的图形窗口，也可以加载3. 在命令行后用，(load "c:\\temp\\xxx.lsp")也可以加载，路径名请输入实际的路径。

另:对于一个LSP程序，(defun 后面的既是命令或者函数，一般程序应该有提示，若没有，标志符c:后面的单词是可以在ACAD下使用的命令，既可以在COMMAND:后面直接输入，即可执行。

CAD快速切换图层LISP代码(方法2)给楼主发一个图层更改的lisp程序，按对应数字键就可以切换到相应的图层。

很方便。

0————01————OBJ2————6t3————SCETR。

8————BORDER如果这些不是你想要的图层，将lisp用笔记本打开，把里边的OBJ，6t等图层名改为你想要的就可以了。

以后要切换图层时，按相应的数字键即可。

(defun YH_chlayer (YH_layer / YH_S)(if (null (tblsearch "LAYER" YH_layer))(entmake (list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")(cons 2 YH_layer) ;图层名称'(70 . 0) ;图层状态'(62 . 7) ;图层颜色'(6 . "bylayer") ;图层线型 )))(setq YH_S (cadr (ssgetfirst))) (if YH_S(command "CHPROP" YH_S "" "la" YH_layer "c" "bylayer" "")(setvar "clayer" YH_layer))(princ))(defun c:0 ()(YH_chlayer "0"))(defun c:1 ()(YH_chlayer "OBJ"))(defun c:2 ()(YH_chlayer "6t"))(defun c:3 ()(YH_chlayer "SCETR"))(defun c:4 ()(YH_chlayer "HIDD"))(defun c:5 ()(YH_chlayer "DIM"))(defun c:6 ()(YH_chlayer "DASH"))(defun c:7 ()(YH_chlayer "TEXT"))(defun c:8 ()(YH_chlayer "BORDER") ) #Cad到上面一行为址，保存为lsp格式。

CAD二次开发(LISP)

第5行：（defun C: triang1() 本行中，defun为一个AutoLISP函数，它定义了函数TRIANG1。TRIANG1 为该函数的函数名。由于此函数名前带有Ｃ：，因此该函数可以像AutoCAD 命令一样被执行。若没有Ｃ：, TRIANG1命令只能置于圆括号中执行（TRIANG1）。此函数带有三个全局变量（ P1,P2，P3）。第一次编写AutoLISP程序时，保持变量为全局变量是个好习惯。这是因为装入并运行程序后，可以通过在AutoCAD命令提示行中输人感叹号（！）并在其后输入变量名来检查变量的值（Command：！P1）。一旦程序通过测试并运行正常，就应该使它们成为局部变量(defun ｃ：TRIANG1（／P1 P2 P3）第6行：（setq P1（getpoint“\ｎ Enter first Point ｏｆ triangle："））本行中，getpoint函数暂停程序的运行，允许用户输入三角形的第一个点。提示信息Enter first Point of triangle显示在屏幕的提示区内。可以通过键盘输入该点的坐标，也可以用屏幕光标选择该点。随后setq函数将这些坐标赋予变量P1。＼ｎ的作用是回车，其后的表达式将被打印在下一行上（“ｎ”代表“ｎｅｗｌｉｎｅ"）
说明
1 2 3 4 5 6 7 8 9
10

第1－3行前三行为注释行，用于描述程序中的函数。这几行很重要因为有它们，编辑程序会变得简单一些。可以在任何必要的时候使用注释。所有的注释行都必须以分号（；）开头，当程序装入时这些行会被忽略。第4行：行为空行，用于分隔程序与注释部分。空行还可以用来分隔程序的不同模块。这样便于区分程序的不同部分。空行对程序没有影响。再 Nhomakorabea加几个函数

cad画缓和曲线lisp程序(1)

打开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。

cad_lisp基础教程

e.g. (SETQ OCCUPATION NIL) 要显示变量所储存的数据,可以使用内建函数 PRINC(可用于绘图模式的指令行或 AutoLISP 程序),其语法如下 :
(PRINC 变量名称 ) e.g. COMMAND : (PRINC NAME) Result : David"David" 在绘图模式中,亦可于指令行中使用感叹号 ! 来显示变量内容,或作为指令选项的输入值;语法如下 : !变量名称 e.g. COMMAND : !NAME Result : "David" 在 Visual LISP 的主控台窗口中,于提示符号 _$ 后键入要显示的变量名称 _$变量名称 e.g. _$NAME
1
函数可有一个或多个参数(也可能没有参数),视该函数而定. 函数名称不分大小写,即大小写字母视为相同.
第3节 --------------------------------------------------------------------------------
数据型态 (Data Type) 整数 (INT) 没有小数字的数值,32 位有号数,范围从+2,147,483,647 到-2,147,483,648 实数 (REAL) 带小数字的数值,以倍精度浮点格式储存(最少 14 位小数) e.g. 12.5 当数值在 1 与-1 之间时,必须加上前导零 e.g. 0.05 可以科学记号表示 : 在 E 或 e 后加上次方值 e.g. 4.1e-6
字符串 (STR) 一般文字,其前后必须加上双引号 " e.g. "AutoCAD" 控制字符或脱逸码必须为小写,且须在字符前加上反斜线 \ e.g.
"\AutoCAD"

CAD中添加LISP

CAD技巧：中望CAD中加载LISP程序1、首先请加载lisp程序，加载方法如下：在菜单栏选择工具——加载应用程序——添加，选择lisp程序然后加载，然后选择添加到启动组。

(其他lisp使加载方式相同)2、然后是添加自定义栏以及图标，方法如下（以坐标标注为例，其余操作相同）：在软件右上方空白区右键选择自定义——工具栏——新建——（修改名称）确定（以下操作均是在不关闭自定义前提下的操作）。

此时在左侧图层工具栏下面会出现一个空白工具栏，然后在命令里面，随便找一个图标（例如新建、打开等等以下以新建为例）拖放入新建的空白工具栏里，右键点击拖放在空白工具栏里的图标，选修改。

在弹出对话框里有名称、命令、说明三项可以修改。

其中将命令“^C^C_new”修改为“^C^C_zbbz”，将名称修改为“坐标标注”，然后确定。

再次右键点击此图标，选择编辑按钮图像，工具一栏最后一个命令图标Import From File。

选择坐标标注所对应的图标打开然后确定。

3、在使用了自定义工具栏后可能需要将这些工具栏导出给其他同事使用，这是就需要将工具栏导出，导出和导入方法如下：导出:在自定义完工具栏后，选择工具——自定义——工具栏然后导出，在选项框里将刚才自定义的勾选，其他象不选择，否则会出现重复，然后确定，选择XML工具条文件（xml）格式保存。

导入：加载工具栏文件：选择工具——自定义——工具栏，选择导入，文件类型选择XML工具条文件（xml），选择然后打开。

要注意的地方是：其他命令操作与以上相用，所加载的lisp程序与图片所在文件夹为固定文件夹，不可修改，否则不能调用其命令，加载lisp程序后一定要选择“添加到启动组”，否则软件启动后不能自己加载此lisp程序。

以上是在中望 CAD中加载LISP程序的具体挂接方法，除开LISP，中望 CAD还提供了VBA、SDS以及DRX（类ARX）接口，用户可以针对自己的使用要求，优化、改善软件使用功能、方式，中望CAD2009的推出，让中望 CAD的扩展接口特别是DRX接口更加完善，并已成功应用到与天河软件、清华斯维尔建筑、鸿业暖通给排水等二次开发的合作中去。