标注CR角程序
(defun c:wa(/)
(command "undo" "be")
(setq orig_cmd(getvar "cmdecho"))
(setq orig_osm(getvar "osmode"))
(setq orig_orth(getvar "orthomode"))
(setq orig_lay(getvar "clayer"))
(setq diml_f(getvar "dimlfac"))
(setvar "errno" 0)
(setq olderr *error*)
(defun *error* (msg)
(setq en_er (getvar "errno"))
(setq errmsg (strcat "ERRNO = " (itoa en_er) "\n错误:" msg))
(prompt errmsg)
(setq *error* olderr)
(command "undo" "e")
(command "undo" "")
(prompt "\n*取消*")
(princ)
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "orthomode" 0)
(setq cla(strcase orig_lay))
(prompt"\n-->选取要标注R角和C角的图元:")
(if (setq ss(ssget))
(progn
(setq ss_n(sslength ss)
n 0
ssa(ssadd)
ssl(ssadd)
ssp(ssadd))
(repeat ss_n
(setq en(ssname ss n)
en_type(cdr(assoc 0 (entget en))))
(cond ((= "ARC" en_type)(ssadd en ssa))
((= "LINE" en_type) (ssadd en ssl))
((= "LWPOLYLINE" en_type) (ssadd en ssp)))
(setq n(1+ n)))) )
(if(> (setq ssp_n(sslength ssp)) 0) (ex_pl) )
(setq ssa_n(sslength ssa)
ssl_n(sslength ssl))
(if (> ssa_n 0)
(progn
(setq list_r '() n 0)
(repeat ssa_n
(setq en(ssname ssa n)
en_r(cdr(assoc 40 (entget en))))
(if(= n 0)
(setq list_r(cons (rtos (* diml_f en_r) 2 3) list_r))
(progn
(if(null (setq chk_r(member (rtos (* diml_f en_r) 2 3) list_r)))
(setq list_r(cons (rtos (* diml_f en_r) 2 3) list_r))
)) )
(setq n(1+ n)))
(setq list_r_n(length list_r) n 0)
(repeat list_r_n
(setq te_r(nth n list_r) r_n 0 n1 0)
(repeat ssa_n
(setq en(ssname ssa n1)
en_r(cdr(assoc 40 (entget en))))
(if(= te_r (rtos (* diml_f en_r) 2 3))
(setq r_n(1+ r_n)
r_pt(cdr(assoc 10 (entget en)))) )
(setq n1(1+ n1)) )
(setq pt1(getpoint r_pt "\n-->选取文字起点:")
pt0(polar r_pt (angle r_pt pt1) (/ (atof te_r) diml_f)))
(if(= "." (substr te_r 1 1))
(setq te1 "R0")
(setq te1 "R") )
(if(= r_n 1)
(setq te(strcat te1 te_r))
(setq te(strcat (rtos r_n 2 0) "-" te1 te_r)) )
(if(> (car pt1) (car pt0))
(setq pt2(polar pt1 0 0.5))
(setq pt2(polar pt1 pi 0.5)))
(command "leader" pt0 pt1 "" te "")
(setq n(1+ n))) ))
(if(> ssl_n 0)
(progn
(setq ssc(ssadd)
list_c '()
n 0)
(repeat ssl_n
(setq en(ssname ssl n)
en_ps(cdr(assoc 10 (entget en)))
en_pe(cdr(assoc 11 (entget en)))
dx(abs(- (car en_ps) (car en_pe)))
dy(abs(- (cadr en_ps) (cadr en_pe))))
(if(equal dx dy 0.001)
(progn
(ssadd en ssc)
(if(null (setq chk_c(member (rtos (* diml_f dx) 2 1) list_c)))
(setq list_c(cons (rtos (* diml_f dx) 2 1) list_c))
)))
(setq n(1+ n)))
(if(> (setq list_c_n(length list_c)) 0)
(progn
(setq n 0)
(repeat list_c_n
(setq te_c(nth n list_c)
ssc_n(sslength ssc)
n1 0
c_n 0)
(repeat ssc_n
(setq en(ssname ssc n1)
en_ps(cdr(assoc 10 (entget en)))
en_pe(cdr(assoc 11 (entget en)))
dx(abs(- (car en_ps) (car en_pe))))
(if(= te_c (rtos (* diml_f dx) 2 1))
(setq c_n(1+ c_n)
c_pt(list (/ (+ (car en_ps) (car en_pe)) 2)
(/ (+ (cadr en_ps) (cadr en_pe)) 2))))
(setq n1(1+ n1)))
(setq pt1(getpoint c_pt "\n-->点选文字起点 :"))
(if(= "." (substr te_c 1 1))
(setq te1 "C0")
(setq te1 "C"))
(if(= c_n 1)
(setq te(strcat te1 te_c))
(setq te(strcat (rtos c_n 2 0) "-" te1 te_c)))
(if(> (car pt1) (car c_pt))
(setq pt2(polar pt1 0 0.5))
(setq pt2(polar pt1 pi 0.5)))
(command "leader" c_pt pt1 "" te "")
(setq n(1+ n)))))))
(if sst
(command "erase" sst ""))
(setq *error* olderr)
(command "undo" "e")
(setvar "cmdecho" orig_cmd)
(setvar "osmode" orig_osm)
(setvar "orthomode" orig_orth)
(setvar "clayer" orig_lay)
(prin1)
)
;;;(ex_pl)
(defun ex_pl(/ sst_n en en_type n)
(command "-layer" "m" "temp-user" "c" "47" "temp-user" "lt" "hidden" "temp-user" "")
(command "copy" ssp "" (list 0 0) (list 0 0))
(command "change" ssp "" "p" "la" "temp-user" "")
(command "explode" ssp)
(setq sst(ssget "x" '((8 . "TEMP-USER"))))
(setq sst_n(sslength sst)
n 0)
(repeat sst_n
(setq en(ssname sst n)
en_type(cdr(assoc 0 (entget en))))
(cond((= "ARC" en_type) (ssadd en ssa))
((= "LINE" en_type) (ssadd en ssl))
)
(setq n(1+ n))
)
(setvar "clayer" orig_lay)
(princ)
)
图一
图二
以上程序如何修改才能达到图二的效果，请高手指点，谢谢
确实好用，谢谢高手 确实好用，谢谢高手，:handshake 自己顶起来 谢谢楼主分享。我这里就是图2的效果啊，不知道为什么 669423907 发表于 2013-5-9 23:19 static/image/common/back.gif
谢谢楼主分享。我这里就是图2的效果啊，不知道为什么
有没有大师出来指点小弟一下，谢谢 是哪里出了问题 为什么会这样呢 我的 CAD 设置，你试试吧：
;环境变量
(defun c:q()
(command"blipmode""off" ;; 控制点标记关
"ucsicon""n" ;; 非原点
"ucsicon""off" ;; 不显示UCS图标
"ucs""w" ;; UCS的原点为视图(w)
"TSPACEFAC"0.8 ;; 多行文字行距
"tilemode"1 ;; 当前窗口为模型
"celtype" "bylayer" ;; 线型随层
"lweight" "bylayer" ;; 线宽随层
"color" "bylayer" ;; 颜色随层
"style" "Standard" "宋体" "0" "0.7" "0" "n" "n" );;字体为 宋体
(setvar"plinewid"0) ;; pl线宽
(setvar"pickstyle" 1) ;; 全选组
(setvar"DIMPOST" ".") ;; 标注无前缀
(setvar"acadlspasdoc"1) ;; 将acad.lsp加载到每一个打开的图形中
(setvar"reporterror"0) ;; 不发送错误报告到Autodesk
(setvar"textfill"1) ;; 打印时字体为实心，0为空心
(setvar"FILEDIA"1) ;; 显示保存对话框
(setvar"hpname""ANSI31") ;; 默认填充图案
(setvar"hpassoc"1) ;; 填充关联
(setvar"UCSFOLLOW"0) ;; UCS 不影响视图
(setvar"DYNMODE"0) ;; 动态输入关
(setvar"mirrtext"0) ;; 镜像时不反转文字
(setvar"pickfirst"1) ;; 先选择后执行
(setvar"qaflags"0) ;; 先选择后执行
(setvar"snapmode"0) ;; 捕捉模式关
(setvar"gridmode"0) ;; 栅格关
(setvar"autosnap"63) ;; 极轴开（正交55）
(setvar"osmode"6079) ;; 极轴开对象追踪开对象捕捉开（全部16383）
(setvar"lwdisplay"1) ;; 线宽开
(setvar"cursorsize"99) ;; 光标大小
(setenv "AutoSnapSize" "6") ;; 自动捕捉标记大小
(setvar"pickbox"8) ;; 靶框大小
(setvar"aperture"5) ;; 对象捕捉靶框高度
(setvar"gripcolor"5) ;; 未选定夹点的颜色（蓝） 悬停夹点绿
(setvar"griphover"3) ;; 光标停在夹点上时其夹点的填充颜色靶框开
(setvar"apbox"1) ;; 绘图时显示靶框
(setvar"snapang"0) ;; 光标角度0°
(setvar"clayer""0") ;; 当前层为0层
(setvar"lockui"13) ;; 锁定 浮动、固定的工具栏和浮动窗口
(princ)) 669423907 发表于 2013-5-10 21:33 static/image/common/back.gif
我的 CAD 设置，你试试吧：
;环境变量
谢谢您的指教 ;环境变量
(defun c:q()
(command"blipmode""off" ;; 控制点标记关
"ucsicon""n" ;; 非原点
环境变量的资料收下了:) 很好用谢谢了
页:
[1]
2