CAD LISP 程序

格式：docx
大小：17.16 KB
文档页数：10

可编辑文档

1/10

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")))) 可编辑文档

2/10 (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))

) 可编辑文档

3/10 (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)) 可编辑文档

4/10 (setq y2 (cadr p1))

(setq z2 (caddr p1))

)

(setq pp2 (list x2 y2 z2))

)

;;如果是其他种类线条

(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))

)

(setq

pp2 (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)) 可编辑文档

5/10 (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"

(* (/ ang pi) 180)

(strcat "" (rtos dd 2))

)

(setq i (1+ i))

)

(prin1)

)

(prompt "\n <>在图中直接写出长度")

(prin1)

3.连续打断程序

(defun c:br1 ()

(command "break" pause "f" pause "@")

)

可编辑文档

6/10 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程序

可编辑文档

7/10 (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)) ))

cad lisp编程的一些指令

构造线xline 指定点或 [水平(H)/垂直(V)/角度(A)/二等分(B)/偏移(O)]: h 指定通过点:

多段线pline 指定起点: 指定下一个点或 [圆弧(A)/半宽(H)/长度(L)/放弃(U)/宽度(W)]:

正多边形polygon 输入边的数目 <4>: 指定正多边形的中心点或 [边(E)]: 输入选项 [内接于圆(I)/外切于圆(C)] :

指定圆的半径:

矩形rectang 指定第一个角点或 [倒角(C)/标高(E)/圆角(F)/厚度(T)/宽度(W)]: 指定另一个角点或 [面积(A)/尺寸(D)/旋转(R)]:

圆弧arc 指定圆弧的起点或 [圆心(C)]: 指定圆弧的第二个点或 [圆心(C)/端点(E)]: 指定圆弧的端点:

圆circle 指定圆的圆心或 [三点(3P)/两点(2P)/切点、切点、半径(T)]: 指定圆的半径或 [直径(D)]:

修订云线Revcloud 最小弧长: 15最大弧长: 15样式: 普通指定起点或 [弧长(A)/对象(O)/样式(S)] : 沿云线路径引导十字光标...反转方向 [是(Y)/否(N)] :

样条曲线spline 指定第一个点或 [对象(O)]: 指定下一点: 指定下一点或 [闭合(C)/拟合公差(F)] :

指定起点切向: 指定端点切向:

椭圆ellipse 指定椭圆的轴端点或 [圆弧(A)/中心点(C)]: 指定轴的另一个端点: 指定另一条半轴长度或 [旋转(R)]:

椭圆弧ellipse 指定椭圆的轴端点或 [圆弧(A)/中心点(C)]: a 指定椭圆弧的轴端点或 [中心点(C)]: 指定轴的另一个端点: 指定另一条半轴长度或 [旋转(R)]: 指定起始角度或 [参数(P)]: 指定终止角度或 [参数(P)/包含角度(I)]:

插入块insert 块定义block 创建多个点对象point 图案填充hatch 渐变色gradient 面域region 表格table

AutoLISP开发方法

第一节AutoLISP基本知识

一、AutoLISP概论

AutoLISP属LISP程序设计语言的扩充。

二、AutoL LISP数据类型

1．表

表是AutoLISP的基本语法单元，也是最有特色、最灵活的数据类型。AutoLISP中表的

作用同C语言中的数组一样重要。

表是用圆括号“()”括起来的一组数据，可表示为： (元素1 元素2 „)

例：三维点(100.O 23.5 11.3)

2．符号与其它程序语言一样，AutoLISP也是用符号来代表函数名、常量或变量。

3．字符串字符串可以是任意长的。

4．整数整数即不带小数点的数。

5．实数实数是带有小数点的数，在?到十1之间的小数必须用零作为开始。

6．文件描述等

文件描述等用来指定AutoLISP要打开的文件，当AutoLISP函数需要读或写一个文件

时，可引用该文件描述符。

7．实体名实体名是分配给一个图中实体的数字标号。

8．选择集选择集是包含一个或多个实体的组。

9．程序和外部子程序

在本章中叙述的AutoLISP函数都是子程序，且都是内部子程序。子程序可以由defun

函数重新定义。

10．标点符号

(1)单引号单引号(’)表示AutoLIsP的Quote函数，例’ABC苟(Quote ABC)相同。

(2)括号数据表及函数通过括号而被定义并使彼此相隔开。例如：(十 1 2) (一 12 4)

(3)句号句号被AutoLISP解释器使用的方式有两种。椫直硎臼凳惺菩∈悖?/P>

另一种被用来将所谓点对这种特殊类型的数据表中的数据项分隔开。

(4)双引号 AutoLISP将双引号括起的部分理解成字符串。

(5)分号用以说明AutoLISP程序中的注释行。

(6)空格及换行空格使表中各数据项彼此分开。换行符也视为空格。

(7)大写和小写在AutoLISP程序中，大写字符和小写字符可被互换使用。

CAD_XY坐标标注AUTO_LISP程序

CAD X,Y坐标坐标标注AUTO LISP程序

;; (DEFUN IDPT(/ p px py pxx pyy)

(DEFUN IDPT ()

(SETQ X T)

(WHILE X

(SETVAR "OSMODE" (+ 1 32 512))

(INITGET 1)

(SETQ PP (GETPOINT "\nPLEASE PICK THE POINT:"))

(SETVAR "OSMODE" 0)

(SETQ P (OSNAP PP "INT,END,CEN"))

(IF (= P NIL)

(PROMPT "\nINVALID POINT, PICK !")

(SETQ X NIL)

)

(SETQ PXX (CAR P)

PYY (CADR P)

PX (RTOS PXX 2 PRE1)

PY (RTOS PYY 2 PRE1)

)

;;(DEFUN MAX_XY(WI PX PY / L PXPX PYPY)

(DEFUN MAX_XY ()

(SETQ KKK "X")

(SETQ LLL "Y")

(SETQ LX (STRLEN PX)

LY (STRLEN PY)

)

(IF (> LX LY)

(PROGN

(SETQ W_NU (- LX LY))

(WHILE (> W_NU 0)

(SETQ PY (STRCAT " " PY))

(SETQ W_NU (- W_NU 1)) )

)

(IF (< LX LY)

(PROGN

(SETQ W_NU (- LY LX))

(WHILE (> W_NU 0)

(SETQ PX (STRCAT " " PX))

中望CAD+API接口应用之Lisp篇

CAD作为大众化的平台软件，基本已经覆盖了全部日常设计中需要的功能，有些时候为了简化一些绘图步骤、提高绘图效率就不得不依靠一些二次开发程序来完成。这里小编以绘制圆的中心线为例，介绍一些中望CAD+中提供的常见Lisp函数的调用方法。

中望CAD+API接口应用之Lisp篇

中心线在我们画图过程中用的非常广泛，我们如果只在CAD平台(不包含任何二次开发软件)中绘制需要好几个步骤才能完成，如果我们编写一个Lisp程序只需要一个命令就可以实现了。关于Lisp的介绍大家可以去网上查看，这里不做详解。强调一点Lisp编写可以十分随意，基本不需要编译环境，word、txt等都可以用来编写，编译完成将扩展名改为.lsp即可。一些基本的库函数我们可以通过中望CAD+帮助菜单的开发人员帮助里面查询。

这里声明一点，我不是搞软件开发的，只是一名普通设计工程师，Lisp编程方面本人是个初学者，如果下面内容有不对的地方还望大家多多指教。写这篇文章主要是想和大家交流经验，以便共同提高。

下面进入正题，我们就来看一下程序是如何实现一步绘制中心线的。

上图是这个程序的源代码，大家可以看到这里面有很多的括号，这就是Lisp的一个特点，这就是为什么也有人叫它括号语言的原因，这里面要特别注意的就是括号一定要匹配，多了或者少了程序都会报错。我简单解释一下上面代码的含义，如果有介绍不清楚的地方大家还是可以去上面提到的开发人员帮助里面查询。

首先第一行里面定义的是这个小程序的开始和命令名字，也就是说我在程序后只要输入ZXX就可以使用这个程序了。后面的一对括号是用来定义后面变量的类型用的，这个后面有机会再详解，这个对新手来说可以暂时不考虑。

第二行是赋值函数和选择函数的联用，将选择的圆赋值给temp(自定义的变量) 第三行获取圆的构成信息，例如图层、圆心、半径、颜色等等。

第四行、第五行得到圆心、半径，方便下一步画中心线。

下载提示

1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。

CAD LISP 程序

合集下载

cad lisp编程的一些指令

AutoLISP开发方法

CAD_XY坐标标注AUTO_LISP程序

中望CAD+API接口应用之Lisp篇

文档推荐

最新文档