求记忆复制

edsion24

哪位大侠有没有带记忆功能的复制  默认上一次的 距离 复制
像偏移那样
哪位大侠有这样的程序 哈哈？跪谢....

Gu_xl

回复 edsion24 的帖子

不太明白你的要求！光有距离可不行，还得有方向呢！
下面是默认0方向复制的代码！我觉得没什么用处！不知对你是否有用！

1. (defun c:copy1 (/ basept ss)
   
2.   (if (setq ss (ssget))
   
3.     (command "_.copy"
   
4.              ss
   
5.              ""
   
6.              (setq basept (getpoint "\n 基点："))
   
7.              (if *distance*
   
8.                (strcat "@" (rtos *distance* 2) "<0")
   
9.                (setq *distance*
   
10.                       (distance basept (getpoint basept "\n 目标点点："))
    
11.                ) ;_ setq
    
12.              ) ;_ if
    
13.     ) ;_ command
    
14.   ) ;_ while
    
15. ) ;_ defun
    
16. 
    

(defun c:copy1 (/ basept ss)<br />   (if (setq ss (ssget))<br />     (command "_.copy"<br />              ss<br />              ""<br />              (setq basept (getpoint "\n 基点："))<br />              (if *distance*<br />                (strcat "@" (rtos *distance* 2) "<0")<br />                (setq *distance*<br />                       (distance basept (getpoint basept "\n 目标点点："))<br />                ) ;_ setq<br />              ) ;_ if<br />     ) ;_ command<br />   ) ;_ while<br /> ) ;_ defun<br /> <br />

x_s_s_1

可参照本帖http://bbs.mjtd.com/thread-85492-1-6.html，只不过他是scale，你改成move就行了，版主说的方向问题也是一个问题

edsion24

谢谢GU大哥
但是怎么能判断方向呢。。。  我想要的复制就是跟CAD里的一样。。。
就是比他多个 自己 记忆上次 复制的距离 记忆功能
当你没有输入 新的距离 或在屏幕上指定新距离的时候 他能默认上一次的距离 至于方向 跟鼠标的拉线方向一致（与CAD基本命令中的方法一致）
等高手继续解答 哈哈

edsion24

(strcat "@" (rtos *distance* 2) "<0")还有这句能不能给做个注解 呵呵
@代表什么呢  最后加一个<0又有什么意识呢 呵呵

edsion24

对了 最好还能加上 多重复制的功能。。。

langjs

;;; __________________________________________
;;; 连续复制1     langjs 2009.4.29
;;; __________________________________________
(defun c:v (/ ennn hudu juli julibak oce p0 p1 ss ssbak)
  (setq oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq ss (ssget))
  (if (null ss)
    (exit)
  )
  (setq p0 (getpoint "\n指定基点:"))
  (if (null p0)
    (exit)
  )
  (princ "\n指定第二点, 或位移:")
  (while t
    (command ".UNDO" "BE")
    (setq ennn (entlast))
    (command ".copy" ss "" p0 pause)
    (setq ss (lt:ss-entnext ennn))
    (setq p1 (getvar "lastpoint"))
    (setq juli (distance p0 p1))
    (if (= 0 juli)
      (progn
(command ".erase" ss "")
(setq ss ssbak)
(setq p1 (list (+ (nth 0 p0) (* julibak (cos hudu))) (+ (nth 1 p0) (* julibak (sin hudu))) (nth 2 p0)))
(setq ennn (entlast))
(command ".copy" ss "" p0 p1)
(setq ss (lt:ss-entnext ennn))
(setq ssbak ss)
(setq p0 p1)
(princ (strcat "\n指定下一点, 或继续位移<" (rtos julibak) ">:"))
      )
      (progn
(setq ssbak ss)
(setq julibak juli)
(setq hudu (angle p0 p1))
(princ)
(setq p0 p1)
(princ (strcat "\n指定下一点, 或继续位移<" (rtos julibak) ">:"))
      )
    )
    (command ".UNDO" "E")
  )
  (princ)
)
;;; _____________________________________________________________
;;; ▓ (lt:ss-entnext en)
;;; [功能] 获取在图元 en 之后产生的图元的选择集
;;; [参数] en----图元名
;;; [返回] 选择集
;;; [测试]1.(setq en (entlast))
;;;         执行创建图元的命令，如 line,boundary
;;;         (setq ss (lt:ss-entnext en))
;;;       2.(setq ss (lt:ss-entnext (car(entsel))))
(defun lt:ss-entnext (en / ss)
  (if en
    (progn
      (setq ss (ssadd))
      (while (setq en (entnext en))
(if (not (member (cdr (assoc 0 (entget en))) '("ATTRIB" "VERTEX"
     "SEQEND"
    )
   )
     )
   (ssadd en ss)
)
      )
      (if (zerop (sslength ss))
(setq ss nil)
      )
      ss
    )
    (ssget "_x")
  )
)

longer1000

楼上的高人啊，非常崇拜

xiaxiang

edsion24 发表于 2011-3-31 13:20
(strcat "@" (rtos *distance* 2) "

极坐标表示法。
"@"：相对距离
"<0"：零代表角度
@10.0<0 代表距离当前点0度方向距离为10.0的另一个点。
其余看函数帮助。
可在copy命令要求输入基点后的下一点时输入@10.0<0测试

edsion24

谢谢各位大侠 呵呵