[LISP函数]：旋转块和注记的小程序

caddog

自编的一个小程序，见笑了

2. 
   
3.   [FONT=courier new]
   
4. ;;;--------------------------------------------------------
   
5. ;;;函数： c:RoBlock                               
   
6. ;;;--------------------------------------------------------
   
7. ;;;来源：           　作者：hj
   
8. ;;;编制时间：2006.5
   
9. ;;;功能......根据用户指定/选取的角度,设置多个块或文本的旋转角度
   
10. ;;;         
    
11. ;;;语法......RoBlock
    
12. ;;;参数......
    
13. ;;;返回值:   无
    
14. ;;;备注  :
    
15. ;;;--------------------------------------------------------
    
16. (DEFUN c:RoBlock (/ ss1 ss2 #pt1 #pt2 p obj1 pp n1 n2 ang1 nuVertex)
    
17.   (PRINC "\n 本程序只能旋转块和文本!")
    
18.   (SETQ ss1 (SSGET '((0 . "insert,text"))))
    
19.   (WHILE ss1
    
20.       (SETQ #pt1 (GETPOINT "选择第一个点<直接回车以多段线参照>："))
    
21.       (if (= #pt1 nil)
    
22.         (progn
    
23.           ;;若第一个点为空，则说明用户希望通过点取已有的多段线来确定方向
    
24.           (while (not ss2)
    
25.             (SETQ ss2 (ENTSEL "\n请选择多段线:"))
    
26.             )
    
27.             (SETQ e-Name (CAR ss2))
    
28.               (SETQ p (CAR (CDR ss2)))
    
29.             (setq ss2 nil)
    
30.               (SETQ obj1 (VLAX-ENAME->VLA-OBJECT e-Name))
    
31.             (IF (WCMATCH (VLA-GET-OBJECTNAME obj1) "LWPOLYLINE,AcDbPolyline") ;_ 结束wcmatch
    
32.               (progn
    
33.                        (SETQ pp (VLAX-CURVE-GETCLOSESTPOINTTO obj1 (TRANS p 1 0)))
    
34.                  ;;通过(VLAX-CURVE-GETPARAMATPOINT obj pp)取得的参数的值为小数
    
35.                  ;;如0.8579说明用户所点取的P位置在0到1号点之间，且0-P/0-1为0.8579，点位接近1点               
    
36.                   ;;(SETQ n (ATOI (RTOS (VLAX-CURVE-GETPARAMATPOINT obj pp) 2 0)))
    
37.                 (SETQ n1 (fix (VLAX-CURVE-GETPARAMATPOINT obj1 pp)))
    
38.                 (SETQ n2 (fix (+ (VLAX-CURVE-GETPARAMATPOINT obj1 pp) 1)))
    
39.                 ;;当用户点击的是一条用"C"封闭的多段线的最后一段时，下面的求n2坐标的语句会出错，因此要写一个判断，当N2>=最大顶点数时,N2＝0
    
40.                 ;;求算数组上下标,先求出Vertex的数目
    
41.                (SETQ nuVertex (+ (FIX (VLAX-CURVE-GETENDPARAM obj1)) 1))
    
42.                ;;若多段线为闭合的，通过上行语句求出的Vertex数目将会多一个
    
43.                ;;在下面的判断语句中减去
    
44.                (if (= (vla-get-Closed obj1) :vlax-true)
    
45.                  (setq nuVertex (- nuVertex 1))
    
46.                )
    
47.                 (IF (= n2 nuVertex)
    
48.                   (setq n2 0)
    
49.                   )
    
50.                 ;;确定了顶点，下面提取两个顶点的坐标
    
51.                 (SETQ #Pt1 (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE  (VLA-GET-COORDINATE obj1 n1))))
    
52.                 (SETQ #Pt2 (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE  (VLA-GET-COORDINATE obj1 n2))))
    
53.                 )
    
54. 
    
55.               ) ;_end if WCMATCH
    
56.          )
    
57.         ;;else
    
58.         (SETQ #pt2 (GETPOINT #PT1 "选择第二个点："))
    
59.         )
    
60.       ;;计算PT1 PT2的角度
    
61.     (setq ang1 (angle #pt1 #pt2))
    
62.     (if (and (< ang1 (* 1.5 pi)) (> ang1 (* 0.5 pi)))
    
63.       (setq ang1 (+ ang1 pi))
    
64.       )
    
65.     ;;开始旋转
    
66.     ;;求选择的块的个数
    
67.     (setq n-len (sslength ss1))
    
68.     (setq %ID 0)
    
69.     (repeat n-len
    
70.       (setq e-Name2 (ssname ss1 %ID))
    
71.       (SETQ obj2 (VLAX-ENAME->VLA-OBJECT e-Name2))
    
72.       (vla-put-Rotation obj2 ang1)
    
73.       (setq %ID (+ 1 %ID))
    
74.       )   
    
75.     (PRINC "\n 本程序只能旋转块和文本!")
    
76.     (SETQ ss1 (SSGET '((0 . "insert,text"))))
    
77.   ) ;_ 结束while
    
78. ) ;_ 结束defun
    
79.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;;--------------------------------------------------------<br /> ;;;函数： c:RoBlock                                <br /> ;;;--------------------------------------------------------<br /> ;;;来源：           　作者：hj<br /> ;;;编制时间：2006.5<br /> ;;;功能......根据用户指定/选取的角度,设置多个块或文本的旋转角度<br /> ;;;          <br /> ;;;语法......RoBlock<br /> ;;;参数......<br /> ;;;返回值:   无<br /> ;;;备注  :<br /> ;;;--------------------------------------------------------<br /> (DEFUN c:RoBlock (/ ss1 ss2 #pt1 #pt2 p obj1 pp n1 n2 ang1 nuVertex)<br />   (PRINC "\n 本程序只能旋转块和文本!")<br />   (SETQ ss1 (SSGET '((0 . "insert,text"))))<br />   (WHILE ss1<br />       (SETQ #pt1 (GETPOINT "选择第一个点<直接回车以多段线参照>："))<br />       (if (= #pt1 nil)<br />         (progn<br />           ;;若第一个点为空，则说明用户希望通过点取已有的多段线来确定方向<br />           (while (not ss2)<br />             (SETQ ss2 (ENTSEL "\n请选择多段线:"))<br />             )<br />             (SETQ e-Name (CAR ss2))<br />               (SETQ p (CAR (CDR ss2)))<br />             (setq ss2 nil)<br />               (SETQ obj1 (VLAX-ENAME->VLA-OBJECT e-Name))<br />             (IF (WCMATCH (VLA-GET-OBJECTNAME obj1) "LWPOLYLINE,AcDbPolyline") ;_ 结束wcmatch<br />               (progn<br />                        (SETQ pp (VLAX-CURVE-GETCLOSESTPOINTTO obj1 (TRANS p 1 0)))<br />                  ;;通过(VLAX-CURVE-GETPARAMATPOINT obj pp)取得的参数的值为小数<br />                  ;;如0.8579说明用户所点取的P位置在0到1号点之间，且0-P/0-1为0.8579，点位接近1点                <br />                   ;;(SETQ n (ATOI (RTOS (VLAX-CURVE-GETPARAMATPOINT obj pp) 2 0)))<br />                 (SETQ n1 (fix (VLAX-CURVE-GETPARAMATPOINT obj1 pp)))<br />                 (SETQ n2 (fix (+ (VLAX-CURVE-GETPARAMATPOINT obj1 pp) 1)))<br />                 ;;当用户点击的是一条用"C"封闭的多段线的最后一段时，下面的求n2坐标的语句会出错，因此要写一个判断，当N2>=最大顶点数时,N2＝0<br />                 ;;求算数组上下标,先求出Vertex的数目<br />                (SETQ nuVertex (+ (FIX (VLAX-CURVE-GETENDPARAM obj1)) 1))<br />                ;;若多段线为闭合的，通过上行语句求出的Vertex数目将会多一个<br />                ;;在下面的判断语句中减去<br />                (if (= (vla-get-Closed obj1) :vlax-true)<br />                  (setq nuVertex (- nuVertex 1))<br />                )<br />                 (IF (= n2 nuVertex)<br />                   (setq n2 0)<br />                   )<br />                 ;;确定了顶点，下面提取两个顶点的坐标<br />                 (SETQ #Pt1 (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE  (VLA-GET-COORDINATE obj1 n1))))<br />                 (SETQ #Pt2 (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE  (VLA-GET-COORDINATE obj1 n2))))<br />                 )<br /> <br />               ) ;_end if WCMATCH <br />          )<br />         ;;else <br />         (SETQ #pt2 (GETPOINT #PT1 "选择第二个点："))<br />         )<br />       ;;计算PT1 PT2的角度<br />     (setq ang1 (angle #pt1 #pt2))<br />     (if (and (< ang1 (* 1.5 pi)) (> ang1 (* 0.5 pi)))<br />       (setq ang1 (+ ang1 pi))<br />       )<br />     ;;开始旋转<br />     ;;求选择的块的个数<br />     (setq n-len (sslength ss1))<br />     (setq %ID 0)<br />     (repeat n-len<br />       (setq e-Name2 (ssname ss1 %ID))<br />       (SETQ obj2 (VLAX-ENAME->VLA-OBJECT e-Name2))<br />       (vla-put-Rotation obj2 ang1)<br />       (setq %ID (+ 1 %ID))<br />       )    <br />     (PRINC "\n 本程序只能旋转块和文本!")<br />     (SETQ ss1 (SSGET '((0 . "insert,text"))))<br />   ) ;_ 结束while<br /> ) ;_ 结束defun<br />   [/FONT]<br />

chengfana

试了一下,还不错.