edsion24 发表于 2011-3-11 09:47:02

求记忆复制

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

Gu_xl 发表于 2011-3-11 11:32:17

回复 edsion24 的帖子

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

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



x_s_s_1 发表于 2011-3-11 11:37:49

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

edsion24 发表于 2011-3-31 13:18:06

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

edsion24 发表于 2011-3-31 13:20:50

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

edsion24 发表于 2011-3-31 13:23:55

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

langjs 发表于 2011-3-31 16:04:12

本帖最后由 langjs 于 2011-3-31 18:22 编辑


;;; __________________________________________
;;; 连续复制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 发表于 2012-2-27 20:01:25

楼上的高人啊，非常崇拜

xiaxiang 发表于 2012-2-27 21:02:34

本帖最后由 xiaxiang 于 2012-2-27 21:03 编辑

edsion24 发表于 2011-3-31 13:20 http://bbs.mjtd.com/static/image/common/back.gif
(strcat "@" (rtos *distance* 2) "

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

edsion24 发表于 2012-4-23 12:58:55

谢谢各位大侠 呵呵
页: [1] 2
查看完整版本: 求记忆复制