分享一个可以同时标注C角和R角的lsp,也请大师帮修改一下

灬丷灬

这个程序可以框选标注或单选多段线标注选中的所有C角和R角,并且统计相同C角和R角的数量很方便的.
唯一美中不足的是,标注出来的尺寸,文字和尺寸线是断开的,比如标注一个R角,要删除的话必须把文字和
尺寸线同时选中才能删掉,很不爽....小弟本身还不会写lisp,在此恳请大师帮我把这个程序修改一下,让标注
出来的效果是文字和尺寸线相连成一个整体,就像用CAD原装功能标注R角一样,谢谢了!以下是源码,也希望
能给为标注C角而烦恼的朋友带来帮助.
;;; 标示R角和C角..

(defun c:drc(/ orig_cmd orig_osm orig_orth olderr en_er errmsg diml_f ss ss_n n ssa ssl en
      en_type ssa_n ssl_n list_r en_r chk_r list_r_n te_r r_n n1 r_pt pt1 pt0 te pt2
      ssc list_c en_ps en_pe dx dy chk_c list_c_n te_c ssc_n c_n c_pt orig_lay sst ssp ssp_n cla)
  (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) "\nError: " msg))
    (prompt errmsg)
    (setq *error* olderr)
    (command "undo" "e")
    (command "undo" "")
    (prompt "\n============<<<<<<程式已取消执行!!>>>>>>")
    (prin1)
    )  
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (setvar "orthomode" 0)
  (setq cla(strcase orig_lay))
  (cond((or (= cla "-BB") (= cla "-BBDIM")) (command "-layer" "m" "-BBDIM" ""))
       ((or (= cla "-HH") (= cla "-HHDIM")) (command "-layer" "m" "-HHDIM" ""))
       ((or (= cla "-BP") (= cla "-BPDIM")) (command "-layer" "m" "-BPDIM" ""))
       ((or (= cla "-PP") (= cla "-PPDIM")) (command "-layer" "m" "-PPDIM" ""))
       ((or (= cla "-B") (= cla "-BDIM")) (command "-layer" "m" "-BDIM" ""))
       ((or (= cla "-SP") (= cla "-SPDIM")) (command "-layer" "m" "-SPDIM" ""))
       ((or (= cla "-SM") (= cla "-SMDIM")) (command "-layer" "m" "-SMDIM" ""))
       ((or (= cla "-D") (= cla "-DDIM")) (command "-layer" "m" "-DDIM" ""))
       ((or (= cla "-DM") (= cla "-DMDIM")) (command "-layer" "m" "-DMDIM" ""))
       ((or (= cla "-CB") (= cla "-CBDIM")) (command "-layer" "m" "-CBDIM" ""))
       ((or (= cla "-DD") (= cla "-DDDIM")) (command "-layer" "m" "-DDDIM" ""))
       ((or (= cla "UP") (= cla "UP-DIM")) (command "-layer" "m" "UP-DIM" ""))
       ((or (= cla "U-SET") (= cla "U-SET-DIM")) (command "-layer" "m" "U-SET-DIM" ""))
       ((or (= cla "UPL") (= cla "UPL-DIM")) (command "-layer" "m" "UPL-DIM" ""))
       ((or (= cla "PH") (= cla "PH-DIM")) (command "-layer" "m" "PH-DIM" ""))
       ((or (= cla "SPL") (= cla "SPL-DIM")) (command "-layer" "m" "SPL-DIM" ""))
       ((or (= cla "STR") (= cla "STR-DIM")) (command "-layer" "m" "STR-DIM" ""))
       ((or (= cla "STR2") (= cla "STR2-DIM")) (command "-layer" "m" "STR2-DIM" ""))
       ((or (= cla "L") (= cla "L-DIM")) (command "-layer" "m" "L-DIM" ""))
       ((or (= cla "DIE") (= cla "DIE-DIM")) (command "-layer" "m" "DIE-DIM" ""))
       ((or (= cla "DPL") (= cla "DPL-DIM")) (command "-layer" "m" "DPL-DIM" ""))
       ((or (= cla "D-SET") (= cla "D-SET-DIM")) (command "-layer" "m" "D-SET-DIM" ""))
       ((or (= cla "0000") (= cla "0000-DIM")) (command "-layer" "m" "0000-DIM" ""))
       (t (command "-layer" "m" "dim" ""))
       )
  (prompt(strcat "目前标注比例 = " (rtos (/ 1 diml_f) 2 3)))
  (if (setq diml_f(getreal"\n输入新的标注比例 :"))
    (setq diml_f(/ 1 diml_f))
    (setq diml_f(getvar "dimlfac"))
    )
  (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 pt2 "" 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 pt2 "" 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)
  (prin1)
  )
   
      
     

   
      
  

Lisphk

楼主，能截个图说明吗？

灬丷灬

不太会截图,试试行不行

灬丷灬

如上图,用这个功能标出来的尺寸,单选文字就只能删除文字,箭头尺寸线是不会被删掉这不是一个整体的.

st788796

写的太复杂了，楼主还是用DWG说明方便来自: Android客户端

灬丷灬

:L文字加图片还不够?我实在想不出更好的表达方式了

343347522

这句(command "leader" pt0 pt1 pt2 "" te "")
改成(command "leader" pt0 pt1  "" te "")试一下