[LISP程序]：弧长标注

LUCAS

;;;AUTOCAD 2000以上
;;;命令：dima
;;;功能：弧长标注
;;;说明：本程序中利用角度标注，将角度改为弧长值
;;;运行前请加载xdrx_api
;;;程序设计:赖云龙;;;
;;;---------------------;;;

2. 
   
3. (defun C:dima ( / acadent arcl dec)
   
4. (vl-load-com)
   
5. (setq acadent (xdrx_entsel "\n选择圆弧: " '((0 . "arc"))))
   
6. (if (= -1 (getvar "dimadec"))
   
7.     (setq DEC (getvar "dimdec"))
   
8.     (setq DEC (getvar "dimadec"))
   
9.   )
   
10. (setq arcl (rtos(vla-get-arclength (vlax-ename->vla-object (car acadent)))2 dec))
    
11. (command ".dimangular" (cadr acadent) "T" ARCL PAUSE)
    
12. (princ)
    
13. )
    

<br /> (defun C:dima ( / acadent arcl dec) <br /> (vl-load-com)<br /> (setq acadent (xdrx_entsel "\n选择圆弧: " '((0 . "arc"))))<br /> (if (= -1 (getvar "dimadec"))<br />     (setq DEC (getvar "dimdec"))<br />     (setq DEC (getvar "dimadec"))<br />   )<br /> (setq arcl (rtos(vla-get-arclength (vlax-ename->vla-object (car acadent)))2 dec))<br /> (command ".dimangular" (cadr acadent) "T" ARCL PAUSE)<br /> (princ) <br /> )<br />

;;;FOR R14

2. 
   
3. (defun C:DIMA (/ E ARCL A50 A51 A40 DEC)
   
4.   (while (= E NIL)
   
5.     (setq E (entsel "\n选择圆弧: "))
   
6.     (if        (/= "ARC" (cdr (assoc 0 (entget (car E)))))
   
7.       (setq E NIL)
   
8.     )
   
9.   )
   
10.   (setq A50 (cdr (assoc 50 (entget (car E)))))
    
11.   (setq A51 (cdr (assoc 51 (entget (car E)))))
    
12.   (setq A40 (cdr (assoc 40 (entget (car E)))))
    
13.   (if (= -1 (getvar "dimadec"))
    
14.     (setq DEC (getvar "dimdec"))
    
15.     (setq DEC (getvar "dimadec"))
    
16.   )
    
17.   (setq        ARCL (rtos (* 2 A40 pi (/ (- 360 (/ (* (abs (- A51 A50)) 180) pi)) 360) ) 2 DEC ) )
    
18.   (command ".dimangular" (cadr E) "T" ARCL PAUSE)
    
19.   (princ)
    
20. )
    

<br /> (defun C:DIMA (/ E ARCL A50 A51 A40 DEC)<br />   (while (= E NIL)<br />     (setq E (entsel "\n选择圆弧: "))<br />     (if        (/= "ARC" (cdr (assoc 0 (entget (car E)))))<br />       (setq E NIL)<br />     )<br />   )<br />   (setq A50 (cdr (assoc 50 (entget (car E)))))<br />   (setq A51 (cdr (assoc 51 (entget (car E)))))<br />   (setq A40 (cdr (assoc 40 (entget (car E)))))<br />   (if (= -1 (getvar "dimadec"))<br />     (setq DEC (getvar "dimdec"))<br />     (setq DEC (getvar "dimadec"))<br />   )<br />   (setq        ARCL (rtos (* 2 A40 pi (/ (- 360 (/ (* (abs (- A51 A50)) 180) pi)) 360) ) 2 DEC ) )<br />   (command ".dimangular" (cadr E) "T" ARCL PAUSE)<br />   (princ)<br /> )<br />

前生

呵呵，你好,另一个小程序,有些罗嗦，应该适合各种cad的版本

2. 
   
3. (defun C:Arcdim (/ nu en ent a1 a2 #r #len arcdim1 arcdim2)
   
4.   (defun arcdim1 (a1 a2 #r)
   
5.     (setq #len (* #r (abs (- a2 a1))))
   
6.   )
   
7. ;;;_____________________________________
   
8.   (defun arcdim2 (a1 a2 #r / a)
   
9.     (setq a (- (* 2 pi) a1))
   
10.     (setq #len (* #r (abs (+ a2 a))))
    
11.   )
    
12.   (gc)
    
13.   (grtext -1 "____已经进入圆弧长度标注程序 <金戈>_____ ")
    
14. ;  (SETLAY "DIM" 1 "CONTINUOUS")
    
15. ;;;_________________________________________________________________
    
16.   (if (Null
    
17.         (SETQ nu (GETint "\n 请输入标注尺寸的小数位数<缺省值=2>"))
    
18.       )
    
19.     (setq nu 2)
    
20.   )
    
21.   (while (SETQ en (entsel "\n 选择欲标注弧长的圆弧:.."))
    
22.     (setq ent (car en))
    
23.     (setq ed (entget ent))
    
24.     (setq a1 (cdr (assoc 50 ed))
    
25.           a2 (cdr (assoc 51 ed))
    
26.           #r (cdr (Assoc 40 ed))
    
27.     )
    
28.     (if        (< a1 a2)
    
29.       (setq #len (arcdim1 a1 a2 #r))
    
30.       (setq #len (arcdim2 a1 a2 #r))
    
31.     )
    
32.     (command "dim1"
    
33.              "ang"
    
34.              en
    
35.              pause
    
36.              (STRCAT "弧长" (rtos #len 2 nu))
    
37.              pause
    
38.     )
    
39.   )
    
40.   (grtext -1 "____圆弧长度标注程序结束 <金戈>_____ ")
    
41.   (PROMPT "\n 尺寸标注完毕 ！")
    
42.   (PRINC)
    
43. )
    

<br /> (defun C:Arcdim (/ nu en ent a1 a2 #r #len arcdim1 arcdim2)<br />   (defun arcdim1 (a1 a2 #r)<br />     (setq #len (* #r (abs (- a2 a1))))<br />   )<br /> ;;;_____________________________________<br />   (defun arcdim2 (a1 a2 #r / a)<br />     (setq a (- (* 2 pi) a1))<br />     (setq #len (* #r (abs (+ a2 a))))<br />   )<br />   (gc)<br />   (grtext -1 "____已经进入圆弧长度标注程序 <金戈>_____ ")<br /> ;  (SETLAY "DIM" 1 "CONTINUOUS")<br /> ;;;_________________________________________________________________<br />   (if (Null<br />         (SETQ nu (GETint "\n 请输入标注尺寸的小数位数<缺省值=2>"))<br />       )<br />     (setq nu 2)<br />   )<br />   (while (SETQ en (entsel "\n 选择欲标注弧长的圆弧:.."))<br />     (setq ent (car en))<br />     (setq ed (entget ent))<br />     (setq a1 (cdr (assoc 50 ed))<br />           a2 (cdr (assoc 51 ed))<br />           #r (cdr (Assoc 40 ed))<br />     )<br />     (if        (< a1 a2)<br />       (setq #len (arcdim1 a1 a2 #r))<br />       (setq #len (arcdim2 a1 a2 #r))<br />     )<br />     (command "dim1"<br />              "ang"<br />              en<br />              pause<br />              (STRCAT "弧长" (rtos #len 2 nu))<br />              pause<br />     )<br />   )<br />   (grtext -1 "____圆弧长度标注程序结束 <金戈>_____ ")<br />   (PROMPT "\n 尺寸标注完毕 ！")<br />   (PRINC)<br /> )<br />

blackspot

试了一下，两个程序标注都有问题。公式需修改。

blackspot

赖先生程序中关键一句似乎应改为 (setq ARCL (rtos (*  A40 (- A51 A50)) 2 DEC ))。

LUCAS

改这样吧!
(setq ARCL (strcat "弧长="(rtos (* A40 (-(* 2 pi)(abs(- A51 A50)))) 2 DEC )))

blackspot

不需(* 2 pi)，A50、A51本身就是rad格式，弧长=半径*弧度。

blackspot

恐怕要分几种情况：“上弦月”和“下弦月”。

blackspot

当A51>A50时，角度即是(- A51 A50)。
当A51<A50时，角度是(+ (* 2 pi) (- A51 A50))。
我已验证过。

blackspot

当A51<A50时，角度是(+ (* 2 pi)(- A51 A50))。

blackspot

当A51小于A50时，角度为(+ (* 2 pi) (- A51 A50))。

梦断江南

呵呵，我也试过编弧长标注，开始以为容易，但是分析下去……＃￥◎％×※％
到现在还没有写得另自己满意：o
其实弧线标注有两种，一种3点定角，一种两线＋点定区位。如果编弧线断开程序，编程时候是要考虑的
还有一个，就是数字的更新问题。
各位慢慢想吧，有结果别忘了告诉我啊

6分钟

既然是弧长标注，那该有标注对象，弧长数值可从该实体及两定位点获得。
至于数字需要自动实时更新，如果只用lisp那要反应器了。