连续COPY 和 ROTATE

冒个烟圈

下面这段程序挺好用的，但有个缺陷：选择完要复制的实体，在打开“正交”时选择第2个点无效（第2点仅在<复制基点>的垂直和水平方向），在关闭“正交”时就正常了，可以选到任意点。
请大师们指点：怎么解决“打开正交”时也能选到任意点

;;;引自龙龙仔的代码
(defun C:CR1 (/ HOLDOSMODE SS SS1 PT1 PT2 ROT MARK)
  (arxload "ACETUTIL.ARX" NIL)
  (defun RTD (ANG) (* ANG (/ 180 pi)))
  (setq HOLDOSMODE (getvar "osmode"))
  (if (setq SS1 (ssget))
    (progn
      (initget 1)
      (setq PT1 (getpoint "\n指定基准点: "))
      ;;acet-ss-drag-move缺点:
      ;;Normally returns the selected point, but will honor "initget"
      ;;settings and can return arbitrary text or keywords.
      ;;Returns nil if the dragging operation is aborted.
      (while (setq PT2 (acet-ss-drag-move
                         SS1
                         PT1
                         "\n指定位移的第二点: "
                         t
                       )
             )
        (setvar "osmode" 0)
        (setq MARK (entlast))
        (command "_.copy" SS1 "" PT1 PT2)
        (setq SS (ssadd))
        (while (setq MARK (entnext MARK))
          (ssadd MARK SS)
        )
        (setvar "osmode" HOLDOSMODE)
        (if (setq ROT (acet-ss-drag-rotate
                        SS
                        PT2
                        "\n指定旋转角度: "
                        t
                      )
            )
          (setq ROT (RTD ROT))
          (setq ROT 0.0)
        )
        (command "_.ROTATE" SS "" PT2 ROT)
      )
    )
  )
  (princ)
)


该贴已经同步到 冒个烟圈的微博

xyp1964

2. ;; tt(连续COPY和ROTATE)
   
3. (defun c:tt (/ ss1 p1 p2 ang s0 ss2)
   
4.   (defun rtd (ang) (* ang (/ 180 pi)))
   
5.   (if (and (setq ss1 (ssget))
   
6.            (setq p1 (getpoint "\n指定基准点: "))
   
7.       )
   
8.     (while (setq p2 (getpoint p1 "\n指定位移的第二点: "))
   
9.       (setq s0 (entlast))
   
10.       (command "_.copy" ss1 "" "non" p1 "non" p2)
    
11.       (setq ss2 (ssadd))
    
12.       (while (setq s0 (entnext s0))
    
13.         (ssadd s0 ss2)
    
14.       )
    
15.       (if (setq ang (getangle p2 "\n指定旋转角度: "))
    
16.         (setq ang (rtd ang))
    
17.         (setq ang 0.0)
    
18.       )
    
19.       (if (/= rpt 0)
    
20.         (command "_.rotate" ss2 "" "non" p2 ang)
    
21.       )
    
22.     )
    
23.   )
    
24.   (princ)
    
25. )

;; tt(连续COPY和ROTATE)<br /> (defun c:tt (/ ss1 p1 p2 ang s0 ss2)<br />   (defun rtd (ang) (* ang (/ 180 pi)))<br />   (if (and (setq ss1 (ssget))<br />            (setq p1 (getpoint "\n指定基准点: "))<br />       )<br />     (while (setq p2 (getpoint p1 "\n指定位移的第二点: "))<br />       (setq s0 (entlast))<br />       (command "_.copy" ss1 "" "non" p1 "non" p2)<br />       (setq ss2 (ssadd))<br />       (while (setq s0 (entnext s0))<br />         (ssadd s0 ss2)<br />       )<br />       (if (setq ang (getangle p2 "\n指定旋转角度: "))<br />         (setq ang (rtd ang))<br />         (setq ang 0.0)<br />       )<br />       (if (/= rpt 0)<br />         (command "_.rotate" ss2 "" "non" p2 ang)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

冒个烟圈

xyp1964 发表于 2015-7-12 12:24

谢谢院长亲自出手

cqu20104225

刚好需要这个东西，收下了，感谢分享
用的过程中发现一个问题，貌似对块使用这个命令的时候，连续复制的块，前一个块会跟着后一个块的旋转角度，一起旋转