求助帖：为什么我找到的这个LISP加载完不管用呢....
lisp吧
全部回复
仅看楼主
level 1
asuro_sun 楼主
标注所有线段(加载后只需框选所有线段便可得标注这些线段)：
(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))
)
(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))
(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 <<length>>在图中直接写出长度")
(prin1)
输入LLL导出命令时显示：
命令: lll
UCS
当前 UCS 名称: *世界*
指定 UCS 的原点或 [面(F)/命名(NA)/对象(OB)/上一个(P)/视图(V)/世界(W)/X/Y/Z/Z 轴(ZA)] <世界>:
命令: ; 错误: no function definition: VLAX-GET-ACAD-OBJECT
2013年02月19日 19点02分 1
level 13
Lisp少帥
等等楼下
2013年02月20日 00点02分 2
level 1
lxy_2080
(vl-load-com)
2014年05月16日 17点05分 3
intodv
感谢！
2017年07月14日 02点07分
level 1
我被烟头烫醒
同样问题，等等楼下
2016年02月16日 06点02分 4
level 1
冯婷306496123
同问，显示是未知命令，等楼下等得好捉急·······
2016年05月24日 09点05分 5
level 7
狙击手考拉
应该是3楼说的，你要先用vl-load-com加载autolisp组件。
在你的代码前先执行 (vl-load-com)
2016年06月07日 11点06分 6
千千巴味3o
小白求问，可以讲明白点吗？怎么执行vl-load-com呢？ 在CAD界面按什么按键一步步操作呢？
2016年06月11日 03点06分
狙击手考拉
@千千巴味3o 两种方式，A 在图形界面的命令区输入 (val-load-com) B 在CAD菜单栏->管理->Visual Lisp编辑器，在这里执行lisp脚本
2016年06月11日 12点06分
douj12
加载也不行啊
2017年11月01日 05点11分
level 1
邵亮亮sky
(vl-load-com)
;标注所有线段(加载后只需框选所有线段便可得标注这些线段)：
(defun c:LLL ()
(COMMAND "UCS" "")
(setvar "cmdecho" 1)
(setq os (getvar "OSMODE"))
(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))
(princ hh)
(while hh
(setvar "textsize" hh)
(setq hh nil)
)
;(princ "\n控制点集")
;;输入标注文字高度
;;循环开始
(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)))
(princ "\n p1为：")
(princ p1)
(princ "\n")
(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 0)
(setq pp1 (list x1 y1 z1))
(repeat (- (/ (length p1) 2) 1)
;;循环，寻找最后一个控制点
(setq p1 (cddr p1))
(setq x2 (car p1))
(setq y2 (cadr p1))
(setq z2 0)
)
(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))
(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))
)
(SETVAR "OSMODE" os)
(prin1)
)
2017年12月14日 14点12分 7
1