CAD LISP 程序

  • 格式:docx
  • 大小:17.64 KB
  • 文档页数:7

下载文档原格式

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

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

)

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

(setq y (/ (+ y1 y2) 2))