标注多义线长度的lisp程序 有问题 求分析
(defun C:d1 ( / )(cmd1)
(vl-load-com)
(tc)
(gd)
(setq s (ssadd))
(setq pt1 (entsel "\n选择需要标注线>>>:"))
(while pt1
(setq en1 (entlast))
(setq pt2 (car pt1)
s (ssadd pt2 s)
pt3 (cadr pt1)
pt4 (entget pt2)
os (cdr(assoc 8 pt4)))
(command "copy" en1 "" pt3 pt3)
(setq en2 (entlast))
(command "chprop" en2 "" "la" "LS" "")
(command "layer" "off" "LS" "")
(setq pt5 (cdr (assoc 0 (entget pt2))))
(cond
((= pt5 "LINE")
(progn
(setq px (cdr (assoc 10 pt4))
py (cdr (assoc 11 pt4)))
(setq ang (angle px py)
dd (distance px py))
(setq zd (polar px ang (/ dd 2)))
) ;|progn|;)
((= pt5 "ARC")
(progn
(setq ent_obj (vlax-ename->vla-object pt2))
(setq zd (vlax-curve-getpointatdist ent_obj (/
(vlax-curve-getdistatparam ent_obj(vlax-curve-getendparam ent_obj)) 2))); 中点坐标
(command "lengthen" pt2 "")
(setq dd (getvar "perimeter"))
) ;|progn|;)
((= pt5 "LWPOLYLINE")
(progn
(command ".explode" en1)
(setq ss (ssget pt3)
ss1 (ssname ss 0)
ss2 (entget ss1)
ss3 (cdr (assoc 0 ss2)))
(if (= ss3 "LINE")
(progn
(setq px (cdr (assoc 10 ss2))
py (cdr (assoc 11 ss2)))
(setq ang (angle px py)
dd (distance px py))
(setq zd (polar px ang (/ dd 2)))
); progn
);if
(if (= ss3 "ARC")
(progn
(setq ent_obj (vlax-ename->vla-object ss1))
(setq zd (vlax-curve-getpointatdist ent_obj
(/(vlax-curve-getdistatparam ent_obj(vlax-curve-getendparam ent_obj)) 2))); 中点坐标
(command "lengthen" ss1 "")
(setq dd (getvar "perimeter"))
) ; progn
); if
) ; progn
)
)
(setq pp1 (getpoint zd "\n>>>>长度放置于>>>:"))
(command "text" pp1 "" (rtos dd 2 2))
(setq box (textbox (entget (entlast))))
(setq pp01 (car box))
(setq pp03 (cadr box))
(setq pp02 (list (car pp01) (cadr pp03)))
(setq dd2 (distance pp02 pp03))
(setq p2 (polar (polar pp1 pi (* dd2 0.03)) (* pi 1.5) (* dd2 0.03)))
(command "pline" zd p2 (polar p2 0 dd2) "")
(setq pt1 (entsel "\n选择需要标注线>>>:"))
)
(command "chprop" en2 "" "la" (getvar "clayer") "")
(command "erase" ss1 s "")
(cmd2)
)
(defun tc ()
;(setq key (tblsearch "layer" "多线段长度"))
;(if (= key nil)
; (command "layer" "n" "多线段长度" "c" 3 "" "")
;)
(setq key1 (tblsearch "layer" "LS"))
(if (= key1 nil)
(command "layer" "n" "LS" "c" 7 "" "")
)
)
(defun gd ()
(setq txt (getvar "textsize"))
(setq txt_gd (getdist (strcat "\n文字高度为<" (rtos txt 2) ">:")))
(if (null txt_gd)
(setq txt_gd txt)
)
(command "style" "Standard" "txt" txt_gd "" "" "" "" "")
)
;;; 保存原有系统变量，设置程序运行时的系统变量
(Defun cmd1 ()
(Setq cho (Getvar "Cmdecho") ; 控制在 AutoLISP 的 command函数运行时 AutoCAD是否回显提示和输入：0.关闭回显1.打开回显
osm (Getvar "Osmode") ; 使用位码设置“对象捕捉”的运行模式
xl (getvar "dimzin") ; 控制是否对主单位值作消零处理
)
(Setvar "Cmdecho" 0)
(Setvar "osmode" 0)
(setvar "dimzin" 0)
)
;;; 恢复原有系统变量
(Defun cmd2 ()
(Setvar "Cmdecho" cho)
(Setvar "Osmode" osm)
(setvar "dimzin" xl)
(Terpri)
(Princ)
)
1，我在刚加载的cad图上第一遍这个程序就可以用在用第二遍的时候就不行了
2，我想把隐藏在LS图层的线还原到线的原来图层为什么还原不回去了
3，有的线为什么不能分解
那位大侠帮帮我吧
页:
[1]