[LISP函数]：好用的弧长标注程序（免费）

nihaogemen

;;;;;
;;因使用本论坛的关于圆弧标注的程序《直击－弧长标注》后
;;;发现有严重缺点
;;; 无法判断所标圆弧是优弧还是劣弧，特别是180°左右的圆弧
;;;起始点不同，标出来的弧长就有可能不同。
;;优弧还是劣其实也不用判断，DXF 码中有现成的，不信请看。
;;;
;;;
(defun c:dimarc(/ n ent entL rad ptcen roop pts pte ans ane ang arcL)
(princ "\ndimarc  圆弧连续标注")
(setq n (getint "\n标注文字小数点后位数<2>:"))
(if (not n) (setq n 2))
(setq ent (car(entsel "\n选择圆弧:"))
      entL (entget ent)
      rad (cdr (assoc 40 entL))
      ptcen (cdr (assoc 10 entL))
      roop "true"     
)
(getarcL)
(command "dim" "an" "" ptcen pts pte pause "" "")
(ang2len)
(while roop
(getarcL)
(if (not pte)
     (setq roop nil)
     (progn
      (command "co" pte)
      (ang2len)     
     );end progn
)
);;end while
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun getarcL()
  (if (not pts) (setq pts (getpoint "\n标注起点:")) )
  (if pte (setq pts pte))
  (setq  pte (getpoint "\n标注终点:  <右键结束圆弧标注>") )
  (if (= pte nil) (command "dim" "e"))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ang2len()
(setq entL (entget(entLast))            
            ang (cdr (assoc 42 entL))
            arcL (rtos (* rad ang) 2 n)
            arcL (strcat "%%o" arcL)
            entL (subst (cons 1 arcL) (assoc 1 entL) entL)
      )
      (entmod entL)
)

xzzhuyu

怎么用？

ouy-930

标注出来的明明就是角度嘛

无为

骗爱心比啊

flowerson

不好用，标注不会和弧平行。

maplesu

关于弧长的标注可以看这个帖子
http://www.xdcad.net/forum/showt ... d=933969#post933969

mr cool

(defun c:yh()
  (setq en (entsel "对象: "))
  (setq pt (getpoint "选点: "))
  (command "dimangular" en pt)
  (setq len_data (entget (entlast)))
  (setq old_hc (assoc 1 len_data))
  (command "lengthen" (car en) "")
  (setq l (getvar "perimeter"))  
  (setq new_hc (cons 1 (rtos l 2 2)))
  (setq len_data (subst new_hc old_hc len_data))
  (entmod len_data)
  )
试试这个很好用的我在以前发表过。

maplesu

呵呵，感谢楼上的了，到处宣传我的这个lsp
不过看了我推荐的帖子里就知道
这个是一个不符合机械制图的要求
没有弧长标记。

JOSDENNIS

阿 Mr cool 的代碼精簡. 呵呵,

Michael_66

看了很多弧长标注程序，好像没有符合标准的

maplesu

同意楼上的，我不是学机械的
所以以前没有想到这一点，
其实就是那个弧长符号没有办法标
如果字体中可以写出也就好了，直接在标注中用/P分开就会上下叠着了。
可惜我没有找到。

myrooms

没有弧长符号，楼主只是一个上划线

pandon

是LISP的的吗？可直接加载吗

david96007

（assoc 42 entL）只能在2000以上版本中应用，在14下没有组码42！
不知道list命令显示出的弧长是怎么计算的？！

弧长是根据弧的半径和角度计算出来的，试着判断了优弧劣弧问题，可以在14下运行！没有用（assoc 42 entL）！

2. 
   
3. 
   
4. 
   
5. (defun set_ini ()
   
6.   (setq cmdsave (getvar "cmdecho"))
   
7.   (setq os (getvar "OSMODE"))
   
8.   (setvar "cmdecho" 0)
   
9.   (setvar "OSMODE" 0)
   
10. ) ;_ end of defun
    
11. 
    
12. (defun err_new (msg) (princ msg) (set_close)) ;_ end of defun
    
13. 
    
14. (defun set_close ()
    
15.   (setvar "OSMODE" os)
    
16.   (setvar "cmdecho" cmdsave)
    
17.   (setq *error* err_old)
    
18. ) ;_ end of defun
    
19. 
    
20. 
    
21. (defun c:dimarc        (/ n key os cmdsave err_old)
    
22.   (setq        err_old        *error*
    
23.         *error*        err_new
    
24.   ) ;_ end of setq
    
25. 
    
26.   (set_ini)
    
27.   (initget 128 "S C")
    
28.   (setq key (getkword "\n[单段圆弧标注(S)/圆弧连续标注(C)]< S >: "))   (if (/= key nil)
    
29.     (setq key (strcase key))
    
30.   ) ;_ end of if
    
31.   (if (or (= key "S") (= key nil))
    
32.     (dimarc_s)
    
33.     (if        (= key "C")
    
34.       (dimarc_C)
    
35.     )
    
36.   )
    
37.   (set_close)
    
38.   (gc)
    
39.   (princ)
    
40. )
    
41. 
    
42. (defun dimarc_s        (/ ent entl rad ans ane ptcen pts pte)
    
43.   (setq n (getint "\n标注文字小数点后位数<2>:"))
    
44.   (if (not n)
    
45.     (setq n 2)
    
46.   )
    
47.   (setq        ent   (car (entsel "\n选择圆弧:"))
    
48.         entl  (entget ent)
    
49.         rad   (cdr (assoc 40 entl))
    
50.         ans   (cdr (assoc 50 entl))
    
51.         ane   (cdr (assoc 51 entl))
    
52.         ptcen (cdr (assoc 10 entl))
    
53.         pts   (polar ptcen ans rad)
    
54.         pte   (polar ptcen ane rad)
    
55.   )
    
56.   (command "dim" "an" "" ptcen pts pte pause "" "" "e")
    
57.   (ang2len)
    
58.   (princ)
    
59. )
    
60. ;;=============================================================
    
61. 
    
62. (defun dimarc_c        (/ ent entL rad ptcen roop pts pte)
    
63.   (setq n (getint "\n标注文字小数点后位数<2>:"))
    
64.   (if (not n)
    
65.     (setq n 2)
    
66.   )
    
67.   (setq        ent   (car (entsel "\n选择圆弧:"))
    
68.         entL  (entget ent)
    
69.         rad   (cdr (assoc 40 entL))
    
70.         ptcen (cdr (assoc 10 entL))
    
71.         roop  "true"
    
72.   )
    
73.   (getarcL)
    
74.   (command "dim" "an" "" ptcen pts pte pause "" "")
    
75.   (ang2len)
    
76.   (while roop
    
77.     (getarcL)
    
78.     (if        (not pte)
    
79.       (setq roop nil)
    
80.       (progn (command "co" pte) (ang2len)) ;end progn
    
81.     )
    
82.   )
    
83.   ;;end while
    
84.   (princ)
    
85. )
    
86. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
87. (defun getarcL ()
    
88.   (setvar "OSMODE" 33)
    
89.   (if (not pts)
    
90.     (setq pts (getpoint "\n标注起点:"))
    
91.   )
    
92.   (if pte
    
93.     (setq pts pte)
    
94.   )
    
95.   (setq pte (getpoint "\n标注终点: <右键结束圆弧标注>"))
    
96.   (if (= pte nil)
    
97.     (command "dim" "e")
    
98.   )
    
99. )
    
100. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
101. (defun ang2len (/ entL ang arcL        ptcen pts pte ptp ang01        ang02 ang03
     
102.                 ang21 ang31)
     
103.   (setq        entL  (entget (entLast))
     
104.         ptcen (cdr (assoc 15 entL))
     
105.         pts   (cdr (assoc 13 entL))
     
106.         pte   (cdr (assoc 14 entL))
     
107.         ptp   (cdr (assoc 10 entL))
     
108.         ang01 (angle ptcen pts)
     
109.         ang02 (angle ptcen pte)
     
110.         ang03 (angle ptcen ptp)
     
111.         ang21 (- ang02 ang01)
     
112.         ang31 (- ang03 ang01)
     
113.   )
     
114.   (if (<= ang21 0)
     
115.     (if        (< ang31 ang21)
     
116.       (setq ang (+ (* pi 2) ang21))
     
117.       (if (> ang31 0)
     
118.         (setq ang (+ (* pi 2) ang21))
     
119.         (setq ang (- ang21))
     
120.       )
     
121.     )
     
122.     (if        (< ang31 ang21)
     
123.       (if (< ang31 0)
     
124.         (setq ang (- (* pi 2) ang21))
     
125.         (setq ang ang21)
     
126.       )
     
127.       (setq ang (- (* pi 2) ang21))
     
128.     )
     
129.   )
     
130.   (setq        arcL (rtos (* rad ang) 2 n)
     
131.         arcL (strcat "%%o" arcL)
     
132.         entL (subst (cons 1 arcL) (assoc 1 entL) entL)
     
133.   )
     
134.   (entmod entL)
     
135. )
     
136. 
     

<br /> <br /> <br /> (defun set_ini ()<br />   (setq cmdsave (getvar "cmdecho"))<br />   (setq os (getvar "OSMODE"))<br />   (setvar "cmdecho" 0)<br />   (setvar "OSMODE" 0)<br /> ) ;_ end of defun<br /> <br /> (defun err_new (msg) (princ msg) (set_close)) ;_ end of defun<br /> <br /> (defun set_close ()<br />   (setvar "OSMODE" os)<br />   (setvar "cmdecho" cmdsave)<br />   (setq *error* err_old)<br /> ) ;_ end of defun<br /> <br /> <br /> (defun c:dimarc        (/ n key os cmdsave err_old)<br />   (setq        err_old        *error*<br />         *error*        err_new<br />   ) ;_ end of setq<br /> <br />   (set_ini)<br />   (initget 128 "S C")<br />   (setq key (getkword "\n[单段圆弧标注(S)/圆弧连续标注(C)]< S >: "))   (if (/= key nil)<br />     (setq key (strcase key))<br />   ) ;_ end of if<br />   (if (or (= key "S") (= key nil))<br />     (dimarc_s)<br />     (if        (= key "C")<br />       (dimarc_C)<br />     )<br />   )<br />   (set_close)<br />   (gc)<br />   (princ)<br /> )<br /> <br /> (defun dimarc_s        (/ ent entl rad ans ane ptcen pts pte)<br />   (setq n (getint "\n标注文字小数点后位数<2>:"))<br />   (if (not n)<br />     (setq n 2)<br />   )<br />   (setq        ent   (car (entsel "\n选择圆弧:"))<br />         entl  (entget ent)<br />         rad   (cdr (assoc 40 entl))<br />         ans   (cdr (assoc 50 entl))<br />         ane   (cdr (assoc 51 entl))<br />         ptcen (cdr (assoc 10 entl))<br />         pts   (polar ptcen ans rad)<br />         pte   (polar ptcen ane rad)<br />   )<br />   (command "dim" "an" "" ptcen pts pte pause "" "" "e")<br />   (ang2len)<br />   (princ)<br /> )<br /> ;;=============================================================<br /> <br /> (defun dimarc_c        (/ ent entL rad ptcen roop pts pte)<br />   (setq n (getint "\n标注文字小数点后位数<2>:"))<br />   (if (not n)<br />     (setq n 2)<br />   )<br />   (setq        ent   (car (entsel "\n选择圆弧:"))<br />         entL  (entget ent)<br />         rad   (cdr (assoc 40 entL))<br />         ptcen (cdr (assoc 10 entL))<br />         roop  "true"<br />   )<br />   (getarcL)<br />   (command "dim" "an" "" ptcen pts pte pause "" "")<br />   (ang2len)<br />   (while roop<br />     (getarcL)<br />     (if        (not pte)<br />       (setq roop nil)<br />       (progn (command "co" pte) (ang2len)) ;end progn<br />     )<br />   )<br />   ;;end while<br />   (princ)<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun getarcL ()<br />   (setvar "OSMODE" 33)<br />   (if (not pts)<br />     (setq pts (getpoint "\n标注起点:"))<br />   )<br />   (if pte<br />     (setq pts pte)<br />   )<br />   (setq pte (getpoint "\n标注终点: <右键结束圆弧标注>"))<br />   (if (= pte nil)<br />     (command "dim" "e")<br />   )<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun ang2len (/ entL ang arcL        ptcen pts pte ptp ang01        ang02 ang03<br />                 ang21 ang31)<br />   (setq        entL  (entget (entLast))<br />         ptcen (cdr (assoc 15 entL))<br />         pts   (cdr (assoc 13 entL))<br />         pte   (cdr (assoc 14 entL))<br />         ptp   (cdr (assoc 10 entL))<br />         ang01 (angle ptcen pts)<br />         ang02 (angle ptcen pte)<br />         ang03 (angle ptcen ptp)<br />         ang21 (- ang02 ang01)<br />         ang31 (- ang03 ang01)<br />   )<br />   (if (<= ang21 0)<br />     (if        (< ang31 ang21)<br />       (setq ang (+ (* pi 2) ang21))<br />       (if (> ang31 0)<br />         (setq ang (+ (* pi 2) ang21))<br />         (setq ang (- ang21))<br />       )<br />     )<br />     (if        (< ang31 ang21)<br />       (if (< ang31 0)<br />         (setq ang (- (* pi 2) ang21))<br />         (setq ang ang21)<br />       )<br />       (setq ang (- (* pi 2) ang21))<br />     )<br />   )<br />   (setq        arcL (rtos (* rad ang) 2 n)<br />         arcL (strcat "%%o" arcL)<br />         entL (subst (cons 1 arcL) (assoc 1 entL) entL)<br />   )<br />   (entmod entL)<br /> )<br /> <br />

cable2004

源码是好东西