【程序讨论】关于模仿天正自由复制的方法

wowan1314 · 发表于 2013-6-20 13:43:58

多年来一直有个想法。想去模仿并扩展天正的“自由复制”命令。使其完全取代COPY命令。

但由于自身水平有限，且GRREAD函数不支持捕捉，而模拟捕捉点又会捕捉自身。所以久久未能成行。
今XD上有“裸奔的花猫”网友提出用GRVECS模仿实体来解决捕捉自身问题，看到些许希望，但仍不甚满意。

特来求助于大家，看是否还有其他办法实现。

我先发个不带捕捉的自由复制程序演示，让大家先了解下该程序的功能。

(DEFUN C:T1 nil
(SETQ SS (SSGET ":L") PT (getpoint))
(setq size (* (getvar "viewsize") 2))
(command "_.copy" SS "" "0,0" "@")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)(setvar "cmdecho" 0)
(PRINC "\n 指定插入点或A旋转s上下镜像D左右镜像+放大一倍-缩小一倍T改基点")
(while PT
(setq BB (grread T 5 1))
(cond
((= (car BB) 5) (SETQ PT1 (CADR BB)) (redRaw)
(GRVECS
(LIST -1 PT (mapcar '+ (LIST size 0 0) PT)
-1 PT (mapcar '- PT(LIST size 0 0))
-1 PT (mapcar '- PT(LIST 0 size 0))
-1 PT (mapcar '+ (LIST 0 size 0) PT)
)
)
(COMMAND "MOVE" SS "" PT PT1)(SETQ PT PT1)
)
((= (car BB) 3) (SETQ PT NIL))
((member BB '((2 97)(2 65)))
(COMMAND "ROTATE" SS "" PT1 90)
)
((member BB '((2 115)(2 83)))
(COMMAND "mirror" SS "" PT1 (mapcar '- pt1 '(1 0)) "Y")
)
((member BB '((2 100)(2 68)))
(COMMAND "mirror" SS "" PT1 (mapcar '- pt1 '(0 1)) "Y")
)
((member BB '((2 43)(2 61)))
(COMMAND "scale" SS "" PT1 "2")
)
((member BB '((2 116)(2 84)))
(setvar "osmode" oldos)(redRaw)
(setq pt (getpoint))
(setvar "osmode" 0)
)
((equal BB '(2 45))
(COMMAND "scale" SS "" PT1 "0.5")
)
)
)
(setvar "osmode" oldos)(redRaw)(princ)
)

(DEFUN C:T1 nil 
  (SETQ SS (SSGET ":L") PT (getpoint)) 
  (setq size (* (getvar "viewsize") 2)) 
  (command "_.copy" SS "" "0,0" "@") 
  (setq oldos (getvar "osmode")) 
  (setvar "osmode" 0)(setvar "cmdecho" 0) 
  (PRINC "\n 指定插入点或A旋转s上下镜像D左右镜像+放大一倍-缩小一倍T改基点") 
  (while PT 
    (setq BB (grread T 5 1)) 
    (cond 
      ((= (car BB) 5) (SETQ PT1 (CADR BB))    (redRaw) 
         (GRVECS 
               (LIST -1 PT (mapcar '+ (LIST size 0 0) PT) 
                     -1 PT (mapcar '-  PT(LIST size 0 0)) 
                     -1 PT (mapcar '-  PT(LIST  0 size 0)) 
                     -1 PT (mapcar '+ (LIST  0 size 0) PT) 
               ) 
          ) 
         (COMMAND "MOVE" SS  "" PT PT1)(SETQ PT PT1) 
      ) 
      ((= (car BB) 3) (SETQ PT NIL)) 
      ((member BB '((2 97)(2 65))) 
       (COMMAND "ROTATE" SS "" PT1 90) 
      ) 
      ((member BB '((2 115)(2 83))) 
       (COMMAND "mirror" SS "" PT1 (mapcar '- pt1 '(1 0)) "Y") 
      ) 
      ((member BB '((2 100)(2 68))) 
       (COMMAND "mirror" SS "" PT1 (mapcar '- pt1 '(0 1)) "Y") 
      ) 
      ((member BB '((2 43)(2 61))) 
       (COMMAND "scale" SS "" PT1 "2") 
      ) 
      ((member BB '((2 116)(2 84))) 
       (setvar "osmode" oldos)(redRaw) 
       (setq pt (getpoint)) 
       (setvar "osmode" 0) 
      ) 
      ((equal BB '(2 45)) 
       (COMMAND "scale" SS "" PT1 "0.5") 
      ) 
    ) 
  ) 
 (setvar "osmode" oldos)(redRaw)(princ) 
)

wowan1314 · 发表于 2013-6-20 13:44:30

本帖最后由 wowan1314 于 2013-6-20 13:46 编辑

再来发个带捕捉的“山寨自由复制”。大家可看到模拟的捕捉会捕捉到自身而导致无法正确运行。

(DEFUN C:T2 nil
(SETQ SS (SSGET ":L") PT (getpoint))
(setq size (* (getvar "viewsize") 2))
(command "_.copy" SS "" "0,0" "@")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)(setvar "cmdecho" 0)
(PRINC "\n 指定插入点或A旋转s上下镜像D左右镜像+放大一倍-缩小一倍T改基点")
(while PT
(setq BB (grread T 5 1))
(cond
((= (car BB) 5) (SETQ PT1 (CADR BB)) (redRaw)
(if
(setq
nearpt (osnap PT1 "_END,_MID,INT")
) ; 取得最近的捕捉点
(PROGN
(setq g2 nearpt)
(setq h (/ (getvar "viewsize")
(cadr (getvar "screensize"))
)
d (getvar "pickbox")
lst (list (* d h) (* (- d 0.5) h) (* (+ d 0.5) h))
ptx (car g2)
pty (cadr g2)
)
(foreach x lst
(setq ptt1 (list (- ptx x) (- pty x))
ptt2 (list (+ ptx x) (- pty x))
ptt3 (list (+ ptx x) (+ pty x))
ptt4 (list (- ptx x) (+ pty x))
)
(grvecs (list 2 ptt1 ptt2 ptt2 ptt3 ptt3 ptt4 ptt4 ptt1))
)
)
)
(GRVECS
(LIST -1 PT (mapcar '+ (LIST size 0 0) PT)
-1 PT (mapcar '- PT(LIST size 0 0))
-1 PT (mapcar '- PT(LIST 0 size 0))
-1 PT (mapcar '+ (LIST 0 size 0) PT)
)
)
(COMMAND "MOVE" SS "" PT PT1)(SETQ PT PT1)
)
((= (car BB) 3) (SETQ PT NIL))
((member BB '((2 97)(2 65)))
(COMMAND "ROTATE" SS "" PT1 90)
)
((member BB '((2 115)(2 83)))
(COMMAND "mirror" SS "" PT1 (mapcar '- pt1 '(1 0)) "Y")
)
((member BB '((2 100)(2 68)))
(COMMAND "mirror" SS "" PT1 (mapcar '- pt1 '(0 1)) "Y")
)
((member BB '((2 43)(2 61)))
(COMMAND "scale" SS "" PT1 "2")
)
((member BB '((2 116)(2 84)))
(setvar "osmode" oldos)(redRaw)
(setq pt (getpoint))
(setvar "osmode" 0)
)
((equal BB '(2 45))
(COMMAND "scale" SS "" PT1 "0.5")
)
)
)
(setvar "osmode" oldos)(redRaw)(princ)
)

(DEFUN C:T2 nil 
  (SETQ SS (SSGET ":L") PT (getpoint)) 
  (setq size (* (getvar "viewsize") 2)) 
  (command "_.copy" SS "" "0,0" "@") 
  (setq oldos (getvar "osmode")) 
  (setvar "osmode" 0)(setvar "cmdecho" 0) 
  (PRINC "\n 指定插入点或A旋转s上下镜像D左右镜像+放大一倍-缩小一倍T改基点") 
  (while PT 
    (setq BB (grread T 5 1)) 
    (cond 
      ((= (car BB) 5) (SETQ PT1 (CADR BB))    (redRaw) 
     (if 
       (setq 
         nearpt (osnap PT1 "_END,_MID,INT") 
       )        ; 取得最近的捕捉点 
        (PROGN 
    (setq g2 nearpt) 
    (setq h    (/ (getvar "viewsize") 
           (cadr (getvar "screensize")) 
        ) 
          d    (getvar "pickbox") 
          lst (list (* d h) (* (- d 0.5) h) (* (+ d 0.5) h)) 
          ptx (car g2) 
          pty (cadr g2) 
    ) 
    (foreach x lst 
      (setq  ptt1 (list (- ptx x) (- pty x)) 
      ptt2 (list (+ ptx x) (- pty x)) 
      ptt3 (list (+ ptx x) (+ pty x)) 
      ptt4 (list (- ptx x) (+ pty x)) 
      ) 
      (grvecs (list 2 ptt1 ptt2 ptt2 ptt3 ptt3 ptt4 ptt4 ptt1)) 
    ) 
        ) 
     ) 
         (GRVECS 
               (LIST -1 PT (mapcar '+ (LIST size 0 0) PT) 
                     -1 PT (mapcar '-  PT(LIST size 0 0)) 
                     -1 PT (mapcar '-  PT(LIST  0 size 0)) 
                     -1 PT (mapcar '+ (LIST  0 size 0) PT) 
               ) 
          ) 
         (COMMAND "MOVE" SS  "" PT PT1)(SETQ PT PT1) 
      ) 
      ((= (car BB) 3) (SETQ PT NIL)) 
      ((member BB '((2 97)(2 65))) 
       (COMMAND "ROTATE" SS "" PT1 90) 
      ) 
      ((member BB '((2 115)(2 83))) 
       (COMMAND "mirror" SS "" PT1 (mapcar '- pt1 '(1 0)) "Y") 
      ) 
      ((member BB '((2 100)(2 68))) 
       (COMMAND "mirror" SS "" PT1 (mapcar '- pt1 '(0 1)) "Y") 
      ) 
      ((member BB '((2 43)(2 61))) 
       (COMMAND "scale" SS "" PT1 "2") 
      ) 
      ((member BB '((2 116)(2 84))) 
       (setvar "osmode" oldos)(redRaw) 
       (setq pt (getpoint)) 
       (setvar "osmode" 0) 
      ) 
      ((equal BB '(2 45)) 
       (COMMAND "scale" SS "" PT1 "0.5") 
      ) 
    ) 
  ) 
 (setvar "osmode" oldos)(redRaw)(princ) 
)

wowan1314 · 发表于 2013-6-20 13:48:18

本帖最后由 wowan1314 于 2013-6-20 13:52 编辑

如何让模拟的捕捉，不去捕捉我要复制的实体呢？

我开始想到的是方案1、(模拟捕捉的时候同时选择实体，如果选择到的实体是要复制的实体中的一部分则不去模拟捕捉)
此方案估计不行，因为通过点获取实体，如果基点选到复制的实体上，那么估计就选不到其他实体了。也就无法捕捉了。

Gu_xl · 发表于 2013-6-20 14:02:26

wowan1314 发表于 2013-6-20 13:48
如何让模拟的捕捉，不去捕捉我要复制的实体呢？

我开始想到的是方案1、(模拟捕捉的时候同时选择实体，如 ...

【Gu_xl】【源码分享】自定义带捕捉的grread函数

wowan1314 · 发表于 2013-6-20 14:30:18

本帖最后由 wowan1314 于 2013-6-20 14:42 编辑

Gu_xl 发表于 2013-6-20 14:02
【Gu_xl】【源码分享】自定义带捕捉的grread函数

大意了！一直没细看G版的这个帖子，想当然的以为就是模拟了捕捉而已。

原来也考虑了这方面的问题。。。。。

很好的方法！直接利用函数太卡了。我试着融入进我的代码中看看。

Casa小宝 · 发表于 2013-7-5 17:10:27

想不捕捉到自己，只要将复制的选择集在计算捕捉的时候隐藏就行了，但是确实会很卡，可考虑用.net的jig。天正的自由复制是很好的，我编出来之后还是选择用回天正的了

，只是天正这个对于物体对齐还不是很方便

doro · 发表于 2014-11-19 15:19:22

好东西就是一直在闪还不支持极轴

依然小小鸟 · 发表于 2018-9-21 23:27:27

这么多年了希望大师能优化出来

xinxirong · 发表于 2018-9-22 08:59:53

高飞鸟的jig函数

依然小小鸟 · 发表于 2018-9-22 10:16:35

xinxirong 发表于 2018-9-22 08:59
高飞鸟的jig函数

大神能整合一下吗

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

[讨论] 【程序讨论】关于模仿天正自由复制的方法

本帖子中包含更多资源

点评

相关帖子

本帖子中包含更多资源

评分

浏览过的版块