[建议]：增加“自由复制”和“自由移动”

liuyj · 发表于 2004-10-24 19:04:40

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

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

×

天正和晓东工具里都有这两个功能，很好用。可是理正里没有，不能不说是个缺憾。尤其晓东工具for 2004里这两个功能会出错，QUN能不能增加一下？

Qun · 发表于 2004-10-24 20:05:57

能说一下两个命令的具体功能吗？

liuyj · 发表于 2004-10-25 08:45:00

在拷贝和移动的同时，可以对选择集进行旋转、对齐、X或Y轴的镜像，理正图库的插入图块功能的相应操作就是我想要的效果。

Qun · 发表于 2004-10-25 09:04:45

记下了，有时间会做，谢谢！

liuyj · 发表于 2004-10-25 12:16:08

最初由 Qun 发布
[B]记下了，有时间会做，谢谢！ [/B]

我先来一个“自由移动”，用理正的函数组合出来的，QUN不会禁止吧？:)
“自由复制”我就无能为力了。

[FONT=courier new]
(defun angtos1 (a)
(angtos a (getvar "aunits") 9)
)
(defun redrw (x ss / e n)
(setq n 0)
(while (setq e (ssname ss n))
(setq n (1+ n))
(redraw e x)
)
)
(defun drag_ss (ss p0 tfm / oth p1 a typ tf tfe tfdg klt x l st prm s tff)
(if (listp tfm)
(setq klt (cadr tfm)
tfm (car tfm)
)
(setq klt' ("A" "S"
"D" "R"
"T"
)
)
)
(setq tfe T
st (car klt)
)
(foreach x klt
(setq l (append
(list x (strcat x " "))
l
)
)
)
(foreach x (cdr klt)
(setq st (strcat st " " x))
)
(setq prm "\r请取插入点")
(foreach x klt
(setq s (cond
((= x "A")
"{A}90度旋转"
)
((= x "S")
"{S}X翻转"
)
((= x "D")
"{D}Y翻转"
)
((= x "R")
"{R}改插入角"
)
((= x "T")
"{T}改基点"
)
)
prm (strcat prm (if tff
"/"
"["
) s
)
tff T
)
)
(setq prm (strcat prm "] <退出>: "))
(redrw 2 ss)
(while tfe
(setq tfe (= tfm "1"))
(setosm 2815)
(print)
(apply'_namess_ l)
(while (and
p0
(progn
(initget 128 st)
(not (listp (setq p1 (_rdsld_ prm ss p0 tfdg))))
)
)
(setosm nil)
(cond
((= p1 "A")
(command ".rotate" ss "" p0 (angtos1 _pi2))
)
((= p1 "S")
(command ".mirror" ss "" p0 (mapcar'+ p0' (0 1e3)) "y")
)
((= p1 "D")
(command ".mirror" ss "" p0 (mapcar'+ p0' (1e3 0)) "y")
)
((or
(setq tf (= p1 "R"))
(= p1 "T")
)
(while (/= 5 (car (setq p1 (grread T)))))
(setq p1 (cadr p1)
p1 (cond
((osnap p1 "end,mid,cen,nod,qua,int,ins,per,nea,app"))
(p1)
)
)
(command ".move" ss "" p0 p1)
(setq p0 p1)
(if tf
(progn
(redrw 2 ss)
(setq oth (getvar "orthomode"))
(setosm 2815)
(setvar "orthomode" 0)
(initget 128)
(setq a (_axa_ "\n请给出新的插入角度 <0>: " ss p0)
typ (type a)
)
(setvar "orthomode" oth)
(setosm nil)
(cond
((= typ'REAL)
(setq a (angtos1 a))
)
((= typ'STR)
(setq typ (type (read a)))
(if (and
(/= typ'REAL)
(/= typ'INT)
)
(setq a nil)
)
)
(T
(setq a "0")
)
)
(if (and
a
(/= (atof a) 0.)
)
(command ".rotate" ss "" p0 a)
)
)
(setq p1 (_xdin_ "\n请给出新的插入基点 <返回>: ")
p0 (if p1
p1
p0
)
)
)
)
)
(setosm 2815)
(redrw 2 ss)
)
(_sortd_)
(setq tfdg T)
(setosm nil)
(if (and
p1
p0
)
(progn
(command ".move" ss "" p0 p1)
(setq p0 p1)
(setosm 2815)
)
(progn
(setq tfe nil)
(command ".erase" ss "")
(setq ss nil)
)
)
(_socas_)
(if tfe
(progn
(print)
(_drags_)
(command ".copy" ss "" "0,0,0" "")
)
)
)
ss
)
(defun c:xmove ()
(command ".undo" "be")
(drag_ss (ssget ":L") (getpoint "\n选择基点:") T)
(command ".undo" "e")
(princ)
)
[/FONT]

[FONT=courier new] 
(defun angtos1 (a) 
  (angtos a (getvar "aunits") 9) 
) 
 
(defun redrw (x ss / e n) 
  (setq n 0) 
  (while (setq e (ssname ss n)) 
    (setq n (1+ n)) 
    (redraw e x) 
  ) 
) 
 
(defun drag_ss (ss p0 tfm / oth p1 a typ tf tfe tfdg klt x l st prm s tff) 
  (if (listp tfm) 
    (setq klt (cadr tfm) 
          tfm (car tfm) 
    ) 
    (setq klt' ("A" "S" 
           "D" "R" 
           "T" 
          ) 
    ) 
  ) 
  (setq tfe T 
        st (car klt) 
  ) 
  (foreach x klt 
    (setq l (append 
              (list x (strcat x " ")) 
              l 
            ) 
    ) 
  ) 
  (foreach x (cdr klt) 
    (setq st (strcat st " " x)) 
  ) 
  (setq prm "\r请取插入点") 
  (foreach x klt 
    (setq s (cond 
              ((= x "A") 
                "{A}90度旋转" 
              ) 
              ((= x "S") 
                "{S}X翻转" 
              ) 
              ((= x "D") 
                "{D}Y翻转" 
              ) 
              ((= x "R") 
                "{R}改插入角" 
              ) 
              ((= x "T") 
                "{T}改基点" 
              ) 
            ) 
          prm (strcat prm (if tff 
                            "/" 
                            "[" 
                          ) s 
              ) 
          tff T 
    ) 
  ) 
  (setq prm (strcat prm "] <退出>: ")) 
  (redrw 2 ss) 
  (while tfe 
    (setq tfe (= tfm "1")) 
    (setosm 2815) 
    (print) 
    (apply'_namess_ l) 
    (while (and 
             p0 
             (progn 
               (initget 128 st) 
               (not (listp (setq p1 (_rdsld_ prm ss p0 tfdg)))) 
             ) 
           ) 
      (setosm nil) 
      (cond 
        ((= p1 "A") 
          (command ".rotate" ss "" p0 (angtos1 _pi2)) 
        ) 
        ((= p1 "S") 
          (command ".mirror" ss "" p0 (mapcar'+ p0' (0 1e3)) "y") 
        ) 
        ((= p1 "D") 
          (command ".mirror" ss "" p0 (mapcar'+ p0' (1e3 0)) "y") 
        ) 
        ((or 
           (setq tf (= p1 "R")) 
           (= p1 "T") 
         ) 
          (while (/= 5 (car (setq p1 (grread T))))) 
          (setq p1 (cadr p1) 
                p1 (cond 
                     ((osnap p1 "end,mid,cen,nod,qua,int,ins,per,nea,app")) 
                     (p1) 
                   ) 
          ) 
          (command ".move" ss "" p0 p1) 
          (setq p0 p1) 
          (if tf 
            (progn 
              (redrw 2 ss) 
              (setq oth (getvar "orthomode")) 
              (setosm 2815) 
              (setvar "orthomode" 0) 
              (initget 128) 
              (setq a (_axa_ "\n请给出新的插入角度 <0>: " ss p0) 
                    typ (type a) 
              ) 
              (setvar "orthomode" oth) 
              (setosm nil) 
              (cond 
                ((= typ'REAL) 
                  (setq a (angtos1 a)) 
                ) 
                ((= typ'STR) 
                  (setq typ (type (read a))) 
                  (if (and 
                        (/= typ'REAL) 
                        (/= typ'INT) 
                      ) 
                    (setq a nil) 
                  ) 
                ) 
                (T 
                  (setq a "0") 
                ) 
              ) 
              (if (and 
                    a 
                    (/= (atof a) 0.) 
                  ) 
                (command ".rotate" ss "" p0 a) 
              ) 
            ) 
            (setq p1 (_xdin_ "\n请给出新的插入基点 <返回>: ") 
                  p0 (if p1 
                       p1 
                       p0 
                     ) 
            ) 
          ) 
        ) 
      ) 
      (setosm 2815) 
      (redrw 2 ss) 
    ) 
    (_sortd_) 
    (setq tfdg T) 
    (setosm nil) 
    (if (and 
          p1 
          p0 
        ) 
      (progn 
        (command ".move" ss "" p0 p1) 
        (setq p0 p1) 
        (setosm 2815) 
      ) 
      (progn 
        (setq tfe nil) 
        (command ".erase" ss "") 
        (setq ss nil) 
      ) 
    ) 
    (_socas_) 
    (if tfe 
      (progn 
        (print) 
        (_drags_) 
        (command ".copy" ss "" "0,0,0" "") 
      ) 
    ) 
  ) 
  ss 
) 
 
(defun c:xmove () 
  (command ".undo" "be") 
  (drag_ss (ssget ":L") (getpoint "\n选择基点:") T) 
  (command ".undo" "e") 
  (princ) 
) 
  [/FONT]

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

[建议]：增加“自由复制”和“自由移动”

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

相关帖子