标注CR角程序

726613

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


          图一


                   图二

以上程序如何修改才能达到图二的效果，请高手指点，谢谢

2548572928

确实好用，谢谢高手

pchuangzmx

确实好用，谢谢高手，

726613

自己顶起来

669423907

谢谢楼主分享。我这里就是图2的效果啊，不知道为什么

726613

669423907 发表于 2013-5-9 23:19
谢谢楼主分享。我这里就是图2的效果啊，不知道为什么

有没有大师出来指点小弟一下，谢谢

726613

是哪里出了问题

726613

为什么会这样呢

669423907

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

726613

669423907 发表于 2013-5-10 21:33
我的 CAD 设置，你试试吧：

;环境变量

谢谢您的指教

crazylsp

;环境变量
(defun c:q()
(command"blipmode""off"     ;; 控制点标记关
"ucsicon""n"                ;; 非原点

环境变量的资料收下了:)

F4164789

很好用  谢谢了