带记忆的连续复制

Free-Lancer · 发表于 2013-7-14 12:20:07

--@----- 发表于 6 分钟前

 登录/注册后可看大图

大侠你的代码：方向和上一次一样的时候才可以默认上次的距离，比如上次是竖直方向的连续复制，下次要是水平方向的连续复制就不行了。加油大侠，呵呵

方向是鼠标指示方向来自: Android客户端

--@----- · 发表于 2013-7-14 12:22:17

ysq101 发表于 2013-7-14 12:11
而且退出也不够人性化！！！要按E键

空格已经是继续复制了那也只能是按esc了不过我觉得按esc也是很方便的

--@----- · 发表于 2013-7-14 12:33:28

Free-Lancer 发表于 2013-7-14 12:20
方向是鼠标指示方向

是的要的就是鼠标指向方向的，st788796的代码，当和上次的方向指向不一样时，就不能记忆上次的距离了。

kwok · 发表于 2013-7-14 13:15:37

2014的copy后输入a就可以等距多重复制了，
其他版本没试，

--@----- · 发表于 2013-7-14 13:22:15

kwok 发表于 2013-7-14 13:15
2014的copy后输入a就可以等距多重复制了，
其他版本没试，

如果能增加的还有记忆来的功能就太好了比如批量的改某些东西

Free-Lancer · 发表于 2013-7-14 14:36:26

--@----- 发表于 1 小时前

 登录/注册后可看大图

如果能增加的还有记忆来的功能就太好了比如批量的改某些东西

虽然一直用2014但还没有注意这个功能，回头试试
lisp的机制也没法改变，响应事件，如果没有动作，软件也不知到你要干啥，st的程序第一次空格知道取上次默认距离了，可是方向不知道来自: Android客户端

--@----- · 发表于 2013-7-14 15:36:44

Free-Lancer 发表于 2013-7-14 14:36
虽然一直用2014但还没有注意这个功能，回头试试
lisp的机制也没法改变，响应事件，如果没有动作，软件也 ...

方向是鼠标拖动的方向（如果拖动不行的话，那就点击两点代表方向。其实操作中拖的是比较快的，哈哈点击是在拖动的时候还要在点击下）

st788796 · 发表于 2013-7-14 23:02:25

--@----- 发表于 2013-7-14 15:36
方向是鼠标拖动的方向（如果拖动不行的话，那就点击两点代表方向。其实操作中拖的是比较快的，哈哈点击 ...

getpoint 即可以输入距离同时鼠标位置指示了方向，但是第二次你要回车取距离，此时没有了方向，Grread可以获取光标点坐标，但是要加一次回车

st788796 · 发表于 2013-7-14 23:33:26

--@----- 发表于 2013-7-14 12:02
如果用这个命令出现这个对话框然后在去选择物体，就很麻烦了。所以网上很多人需要阵列的或者连续复制的 ...

在 lisp 是不会出现对话框的

(if (setq ss (ssget))
(vl-cmdf ".-array" ss "" "r" pause 1 pause pause)
)

--@----- · 发表于 2013-7-14 23:40:12

st788796 发表于 2013-7-14 23:02
getpoint 即可以输入距离同时鼠标位置指示了方向，但是第二次你要回车取距离，此时没有了方向，Grread可 ...

为啥不能拾取鼠标拖动的方向呢，CAD的COP复制过程就是拾取鼠标拖动的方向{:soso_e100:}

st788796 · 发表于 2013-7-15 00:20:22

本帖最后由 st788796 于 2013-7-15 00:25 编辑

--@----- 发表于 2013-7-14 23:40
为啥不能拾取鼠标拖动的方向呢，CAD的COP复制过程就是拾取鼠标拖动的方向

拾取的时候就不是上次的距离了, 机子上调试不出来获取生成的最后选择集，只好用 xdapi 写了，运行前加载 xdrxapi

(defun c:fz (/ getlastss ss p1 p2 an dis tf p mat0 mat)
(if (and (setq ss (ssget))
(setq p1 (getpoint "\n起点："))
)
(progn
(setq
p2 (getpoint p1
(if $discopy
(strcat "\n第二点<" (rtos $discopy 2 2) ">:")
"\n第二点: "
)
)
)
(if (= p2 nil)
(setq p2 (cadr (grread t))
p2 (polar p1 (angle p1 p2) $discopy)
)
)
(setq an (angle p1 p2)
dis (distance p1 p2)
$discopy dis
s (entlast)
)
(setq mat0 (xdrx_matrix_identity 3)
mat (xdrx_matrix_settranslation mat0 (mapcar '- p2 p1))
)
(setq ss (xdrx_entity_transformedcopy ss mat)
tf t
p1 p2
)
(while tf
(setq
p (getstring (strcat "\n任意键退出/空格键继续[或输入距离]<"
(rtos dis 2 2)
">："
)
)
)
(cond
((= p "") (setq p dis))
((numberp (distof p))
(setq dis (distof p)
$discopy dis
)
)
(t
(setq dis nil
tf nil
)
)
)
(if dis
(progn
(setq p2 (polar p1 an dis)
mat (xdrx_matrix_settranslation mat0 (mapcar '- p2 p1))
)
(setq ss (xdrx_entity_transformedcopy ss mat)
p1 p2
)
)
)
)
)
)
(princ)
)

(defun c:fz (/ getlastss ss p1 p2 an dis tf p mat0 mat) 
  (if (and (setq ss (ssget)) 
    (setq p1 (getpoint "\n起点：")) 
      ) 
    (progn 
      (setq 
 p2 (getpoint p1 
       (if $discopy 
         (strcat "\n第二点<" (rtos $discopy 2 2) ">:") 
         "\n第二点: " 
       ) 
    ) 
      ) 
      (if (= p2 nil) 
 (setq p2 (cadr (grread t)) 
       p2 (polar p1 (angle p1 p2) $discopy) 
 ) 
      ) 
      (setq an      (angle p1 p2) 
     dis      (distance p1 p2) 
     $discopy dis 
     s      (entlast) 
      ) 
      (setq mat0 (xdrx_matrix_identity 3) 
     mat  (xdrx_matrix_settranslation mat0 (mapcar '- p2 p1)) 
      ) 
      (setq ss  (xdrx_entity_transformedcopy ss mat) 
     tf t 
     p1 p2 
      ) 
      (while tf 
 (setq 
   p (getstring (strcat "\n任意键退出/空格键继续[或输入距离]<" 
          (rtos dis 2 2) 
          ">：" 
         ) 
     ) 
 ) 
 (cond 
   ((= p "") (setq p dis)) 
   ((numberp (distof p)) 
    (setq dis (distof p) 
   $discopy dis 
    ) 
   ) 
   (t 
    (setq dis nil 
   tf  nil 
    ) 
   ) 
 ) 
 (if dis 
   (progn 
     (setq p2  (polar p1 an dis) 
    mat (xdrx_matrix_settranslation mat0 (mapcar '- p2 p1)) 
     ) 
     (setq ss (xdrx_entity_transformedcopy ss mat) 
      p1 p2 
     ) 
   ) 
 ) 
      ) 
    ) 
  ) 
  (princ) 
)

st788796 · 发表于 2013-7-15 12:01:36

在垂直模式打开情况下还有 Bug，需要有个判断修正 Grread 点

--@----- · 发表于 2013-7-15 12:50:50

st788796 发表于 2013-7-15 12:01
在垂直模式打开情况下还有 Bug，需要有个判断修正 Grread 点

看来这个难度很大哦

eachy · 发表于 2013-7-15 13:10:15

--@----- 发表于 2013-7-15 12:50
看来这个难度很大哦

简单，垂直打开时 an 是象限角，不是(angle p1 p2)

st788796 · 发表于 2013-7-16 00:04:02

--@----- 发表于 2013-7-15 12:50
看来这个难度很大哦

调整了下程序，适应第二次应用时直接回车打开 Ortho 模式情况，楼上的帖子保留，可以对比看看改了哪些

(defun c:fz (/ ss p1 p2 an dis tf p mat0 mat)
(if (and (setq ss (ssget))
(setq p1 (getpoint "\n起点："))
)
(progn
(setq
p2 (getpoint p1
(if $discopy
(strcat "\n第二点<" (rtos $discopy 2 2) ">:")
"\n第二点: "
)
)
)
(if (= p2 nil)
(progn
(setq p2 (cadr (grread t)))
(if (= (getvar "orthomode") 1)
(cond
((<= (* 0.25 pi) (angle p1 p2) (* 0.75 pi))
(setq an (/ pi 2))
)
((< (* 0.75 pi) (angle p1 p2) (* 1.25 pi))
(setq an pi)
)
((<= (* 1.25 pi) (angle p1 p2) (* 1.75 pi))
(setq an (* 1.5 pi))
)
(t (setq an 0.))
)
(setq an (angle p1 p2))
)
(setq p2 (polar p1 an $discopy))
)
)
(setq an (angle p1 p2)
dis (distance p1 p2)
$discopy dis
mat0 (xdrx_matrix_identity 3)
mat (xdrx_matrix_settranslation mat0 (mapcar '- p2 p1))
ss (xdrx_entity_transformedcopy ss mat)
tf t
p1 p2
)
(while tf
(setq
p
(getstring (strcat "\n任意键退出/空格键继续[或输入新距离]<"
(rtos dis 2 2)
">："
)
)
)
(cond
((= p "") (setq p dis))
((numberp (distof p))
(setq dis (distof p)
$discopy dis
)
)
(t
(setq dis nil
tf nil
)
)
)
(if dis
(setq p2 (polar p1 an dis)
mat (xdrx_matrix_settranslation mat0 (mapcar '- p2 p1))
ss (xdrx_entity_transformedcopy ss mat)
p1 p2
)
)
)
)
)
(princ)
)

(defun c:fz (/ ss p1 p2 an dis tf p mat0 mat) 
  (if (and (setq ss (ssget)) 
    (setq p1 (getpoint "\n起点：")) 
      ) 
    (progn 
      (setq 
 p2 (getpoint p1 
       (if $discopy 
         (strcat "\n第二点<" (rtos $discopy 2 2) ">:") 
         "\n第二点: " 
       ) 
    ) 
      ) 
      (if (= p2 nil) 
 (progn 
   (setq p2 (cadr (grread t))) 
   (if (= (getvar "orthomode") 1) 
     (cond 
       ((<= (* 0.25 pi) (angle p1 p2) (* 0.75 pi)) 
        (setq an (/ pi 2)) 
       ) 
       ((< (* 0.75 pi) (angle p1 p2) (* 1.25 pi)) 
        (setq an pi) 
       ) 
       ((<= (* 1.25 pi) (angle p1 p2) (* 1.75 pi)) 
        (setq an (* 1.5 pi)) 
       ) 
       (t (setq an 0.)) 
     ) 
     (setq an (angle p1 p2)) 
   ) 
   (setq p2 (polar p1 an $discopy)) 
 ) 
      ) 
      (setq an      (angle p1 p2) 
     dis      (distance p1 p2) 
     $discopy dis 
     mat0     (xdrx_matrix_identity 3) 
     mat      (xdrx_matrix_settranslation mat0 (mapcar '- p2 p1)) 
     ss      (xdrx_entity_transformedcopy ss mat) 
     tf      t 
     p1      p2 
      ) 
      (while tf 
 (setq 
   p 
    (getstring (strcat "\n任意键退出/空格键继续[或输入新距离]<" 
         (rtos dis 2 2) 
         ">：" 
        ) 
    ) 
 ) 
 (cond 
   ((= p "") (setq p dis)) 
   ((numberp (distof p)) 
    (setq dis (distof p) 
   $discopy dis 
    ) 
   ) 
   (t 
    (setq dis nil 
   tf  nil 
    ) 
   ) 
 ) 
 (if dis 
   (setq p2  (polar p1 an dis) 
  mat (xdrx_matrix_settranslation mat0 (mapcar '- p2 p1)) 
  ss  (xdrx_entity_transformedcopy ss mat) 
  p1  p2 
   ) 
 ) 
      ) 
    ) 
  ) 
  (princ) 
)

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

[求助] 带记忆的连续复制

点评

点评

点评

点评

点评

点评

点评

点评

点评