[LISP程序]：一个按按指定弧长进行旋转复制的程序

正航

;;一个按按指定弧长进行旋转复制的小程序
;;原创

2. 
   
3. (defun c:copyarc (/ p1 p2 ang ss leng arcl sysbl)
   
4.   (princ "          *****   按弧长旋转复制实体   *****")
   
5.   (setq sysbl (getvar "dimlfac"))
   
6.   (setq p2 (getpoint "\n请选择按弧长复制的实体的基准点："))
   
7.   (princ "\n请选择按弧长复制的实体:")
   
8.   (setq ss (ssget))
   
9.   (setq p1 (getpoint "\n旋转复制的基准圆心："))
   
10.   (setq arcl (getreal "\n弧长值：<mm>"))
    
11.   (setq leng (distance p2 p1))
    
12.   (if (> arcl 0)
    
13.     (setq ang (/ (* (/ arcl sysbl) 360) (* (* 2 leng) pi)))
    
14.     (setq ang (- 0 (/ (* (/ arcl sysbl) 360) (* (* 2 leng) pi))))
    
15.   )
    
16.   (command ".copy" ss "" p2 p2)
    
17.   (command ".rotate" ss "" p1 ang)
    
18.   (princ)
    
19. )
    
20. 
    

<br /> (defun c:copyarc (/ p1 p2 ang ss leng arcl sysbl)<br />   (princ "          *****   按弧长旋转复制实体   *****")<br />   (setq sysbl (getvar "dimlfac"))<br />   (setq p2 (getpoint "\n请选择按弧长复制的实体的基准点："))<br />   (princ "\n请选择按弧长复制的实体:")<br />   (setq ss (ssget))<br />   (setq p1 (getpoint "\n旋转复制的基准圆心："))<br />   (setq arcl (getreal "\n弧长值：<mm>"))<br />   (setq leng (distance p2 p1))<br />   (if (> arcl 0)<br />     (setq ang (/ (* (/ arcl sysbl) 360) (* (* 2 leng) pi)))<br />     (setq ang (- 0 (/ (* (/ arcl sysbl) 360) (* (* 2 leng) pi))))<br />   )<br />   (command ".copy" ss "" p2 p2)<br />   (command ".rotate" ss "" p1 ang)<br />   (princ)<br /> )<br /> <br />