麻烦大神修改一下，实现连续的复制旋转，谢谢

shanjiwang · 发表于 2016-12-20 22:35:55

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

这个代码选择对象以后，只能复制旋转一次，同一对象在另外的基点复制旋转又要按空格键重启命令，麻烦大神修改一下，想选中一个对象后，实现连续的复制旋转
(princ "\n[carrot1983][7/3/09]★复制旋转命令: CR")
(defun C:CR (/ LAST_PT NEW_SSALL SS SSALL SSP)
  (princ "\n★选择对象复制旋转")
  (if (and (setq SSALL (ssget "X"))
         (setq SS (ssget))
   )
(progn
   (command "_.COPY" SS "")
   (while (= (getvar "CMDNAMES") "COPY")
      (command PAUSE)
   )
   (if (and (setq LAST_PT (getvar "LASTPOINT"))
            (setq NEW_SSALL (ssget "X"))
      )
      (progn
      (command "_.SELECT" NEW_SSALL "R" SSALL "")
      (setq SSP (ssget "P"))
      (command "_.ROTATE" SSP "" "_NON" LAST_PT)
      )
   )
)
  )
  (princ)
)

fangmin723 · 发表于 2016-12-21 07:56:02

CAD旋转自带复制功能，ro后，选择基点，再输入C，你在这个基础上优化一下即可！不用这么麻烦

iLisp · 发表于 2016-12-21 09:11:17

(princ "\n[carrot1983][7/3/09]★复制旋转命令: CR")
(defun C:CR (/ LAST_PT SS)
(while (and (princ "\n★选择对象复制旋转")
(setq SS (ssget))
)
(command "_.COPY" SS "" "_none" "0,0,0" "@")
(command "_.move" ss "")
(while (= (getvar "CMDNAMES") "MOVE")
(command PAUSE)
)
(if (setq LAST_PT (getvar "LASTPOINT"))
(progn
(command "_.ROTATE" ss "" "_NON" LAST_pT)
(while (= (getvar "CMDNAMES") "ROTATE")
(command PAUSE)
)
)
)
)
(princ)
)

shanjiwang · 发表于 2016-12-21 10:17:08

谢谢高手，能不能再帮忙优化一下，想同一对象选择后在多个位置进行复制旋转，不用每复制施转一次后，又要重新选择对象与基点，

sicky111 · 发表于 2016-12-21 11:42:48

shanjiwang 发表于 2016-12-21 10:17

你应该一次性把你的要求全部说清楚，别人也好帮你，不要像挤牙膏一样，一次一点点，浪费别人的时间。个人建议而已！

iLisp · 发表于 2016-12-21 11:55:01

(vl-load-com)
(defun C:CR (/ LAST_PT SS)
(while (and (princ "\n选择复制旋转实体....") (setq SS (ssget)))
(command "_.COPY" SS "" "_none" "0,0,0" "@")
(command "_.move" ss "")
(while (= (getvar "CMDNAMES") "MOVE") (command PAUSE))
(if (setq LAST_PT (getvar "LASTPOINT"))
(progn (command "_.ROTATE" ss "" "_NON" LAST_pT)
(while (= (getvar "CMDNAMES") "ROTATE") (command PAUSE))
)
)
(princ "\n*ESC 退出复制**")
(vl-catch-all-apply
'(lambda ()
(while t
(setq ent (entlast))
(command "_.copy" "m" ss "" "_none" LAST_PT)
(while (= (getvar "CMDNAMES") "COPY") (command PAUSE))
)
)
)
)
(princ)
)

zhangq_cai1 · 发表于 2016-12-21 12:02:54

学习一下~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

shanjiwang · 发表于 2016-12-21 12:53:11

啥也不说了，感谢楼主分享哇！感谢高手，也感谢楼上提出的意见，本人对代码不了解，表达也有问题，其实我要实现的功能是：选择对象--选择对象基点---选择插入点--旋转--选择插入点--旋转--选择插入点--旋转……（同一对象，选择基点后，多次进行复制旋转）

q3_2006 · 发表于 2016-12-21 21:12:41

shanjiwang 发表于 2016-12-21 12:53

(defun C:CR ( / p1 pt SS)
(while (and (princ "\n选择复制旋转实体....") (setq SS (ssget)))
(setq pt (getpoint "\n点取基点:"))
(while (setq p1 (getpoint pt "\n 点取放置点:"))
(command "_.COPY" SS "" pt pt)
(command "_.move" ss "" pt p1)
(command "_.ROTATE" ss "" p1)
(while (= (getvar "CMDNAMES") "ROTATE") (command PAUSE))
(setq pt p1)
)
)
)

shanjiwang · 发表于 2016-12-21 22:01:03

正是我要的效果，感谢大神，真是太感谢了

qht5566 · 发表于 2016-12-22 09:51:51

自由复制，与天正的类似
http://bbs.xdcad.net/thread-668990-1-1.html

iLisp · 发表于 2016-12-22 15:31:42

1 getafter 对有子实体的会出错，论坛有该函数，自行搜索
2 使用了 acet 函数，必须安装 Express Tools

(defun c:cr (/ getafter ss bp tf tp ss1 e)
(defun getafter (e / ss)
(setq ss (ssadd))
(while (setq e (entnext e))
(ssadd e ss)
)
(if (> (sslength ss) 0)
ss
nil
)
)
(if (and (setq ss (ssget))
(setq bp (getpoint "\nBase Point: "))
)
(progn
(setq tf t)
(while tf
(if (setq tp (acet-ss-drag-move ss bp 0))
(progn
(setq e (entlast))
(vl-cmdf ".copy" ss "" "_none" bp tp)
(setq ss1 (getafter e))
(if (and ss1 (setq ro (acet-ss-drag-rotate ss1 tp "\n旋转角度: " 0)))
(vl-cmdf ".rotate" ss1 "" tp (* 180 (/ ro pi)))
(setq tf nil)
)
)
(setq tf nil)
)
)
)
)
(princ)
)

(defun c:cr (/ getafter ss bp tf tp ss1 e) 
  (defun getafter (e / ss) 
    (setq ss (ssadd)) 
    (while (setq e (entnext e)) 
      (ssadd e ss) 
    ) 
    (if        (> (sslength ss) 0) 
      ss 
      nil 
    ) 
  ) 
  (if (and (setq ss (ssget)) 
           (setq bp (getpoint "\nBase Point: ")) 
      ) 
    (progn 
      (setq tf t) 
      (while tf 
        (if (setq tp (acet-ss-drag-move ss bp 0)) 
          (progn 
            (setq e (entlast)) 
            (vl-cmdf ".copy" ss "" "_none" bp tp) 
            (setq ss1 (getafter e))              
            (if        (and ss1 (setq ro (acet-ss-drag-rotate ss1 tp "\n旋转角度: " 0))) 
              (vl-cmdf ".rotate" ss1 "" tp (* 180 (/ ro pi))) 
              (setq tf nil) 
            ) 
          ) 
          (setq tf nil) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

9合彩 · 发表于 2019-2-22 14:10:56

@q3_2006:9#楼，弄1次就完了，怎么整呢？

账号		自动登录	找回密码
密码			立即注册

[求助] 麻烦大神修改一下，实现连续的复制旋转，谢谢

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。