社区 › AutoLISP/Visual LISP 编程技术 › 连续旋转复制

edrise 发表于 2018-4-9 16:40:13

ssyfeng 发表于 2018-4-9 15:13
看看是不是你要的效果：

非常棒，非常感谢！我写的那段我也想到了一些解决办法，还没付诸实施，兄台这个我就先笑纳了，嘿嘿~

ssyfeng 发表于 2018-4-9 23:31:54

能用就行。

LIULISHENG 发表于 2018-4-10 08:34:15

真的很不错

edrise 发表于 2018-4-10 13:55:52

本帖最后由 edrise 于 2018-4-10 17:14 编辑

经过测试，证实我结束循环的办法可行，算是解决了我目前的需求吧。更新一下代码(defun c:rtc (/ *error* pt1 pt2 ss a x y z)
(defun *error* (msg)
    (setvar "cmdecho" a)
    (command ".undo" "e")
    (princ "error: ")
    (princ msg)
    (princ)
    )
(setq a (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq ss (ssget) x nil y nil z t)
(setq pt1 (getpoint "选择基点"))
(setq pt2 (getpoint pt1 "\n选择第一角点"))
(while z
    (setq x (entget (entlast)))
    (command ".undo" "be")
    (command "rotate" ss "" pt1 "c" "r" pt1 pt2 pause)
    (command ".undo" "e")
    (setq y (entget (entlast)))
    (setq z (judge_coincide x y))
)
(command ".undo" "")
(setvar "cmdecho" a)
)

(defun judge_coincide(ls1 ls2 / a b)
(setq a (assoc 10 ls1))
(setq b (assoc 10 ls2))
(if (and
(= 0 (- (nth 1 a) (nth 1 b)))
(= 0 (- (nth 2 a) (nth 2 b)))
)
    nil
    t
    )
)

edrise 发表于 2018-4-10 14:10:52

本帖最后由 edrise 于 2018-4-10 16:18 编辑

发现bug，程序执行过程中如果按ESC键退出，如果想撤回复制操作，需要先执行(command ".undo" "e")命令才能撤回，尴尬......加入错误处理函数以解决，详上楼代码。

ssyfeng 发表于 2018-4-10 17:32:17

以基点A旋转多段线或直线，组码10的坐标相等，就会有问题。

edrise 发表于 2018-4-11 08:12:04

ssyfeng 发表于 2018-4-10 17:32
以基点A旋转多段线或直线，组码10的坐标相等，就会有问题。

0_0对的，这个bug是我这个方法目前无法解决的问题，只能另辟蹊径了。道友的代码要是能在复制过程中可以捕捉点就好了。因为学得还很浅，只能用一些简单的方法实现自己的目标，道友的代码现在我还看不懂，所以也没法自己改:'(

ssyfeng 发表于 2018-4-11 10:24:47

本帖最后由 ssyfeng 于 2018-4-11 10:26 编辑

我那个改就要用到带捕捉的grread函数，你先试试这个：
(defun c:rtc (/ *error* a pt1 pt2 ptlst1 ptlst2 ss x y z)
(defun *error* (msg)
(setvar "cmdecho" a)
(command ".undo" "e")
(princ "error: ")
(princ msg)
(princ)
)
(defun ent-getbox (ent / lst obj p1 p2 p3 p4)
(setq obj (vlax-ename->vla-object ent))
(vla-GetBoundingBox obj 'p1 'p3)
(setq p1 (vlax-safearray->list p1)
   p3 (vlax-safearray->list p3)
)
(if (= "SPLINE" (cdr (assoc 0 (entget ent))))
   (progn
    (setq lst
   (mapcar
      '(lambda (a b)
      (vlax-curve-getClosestPointToProjection ent a b t)
       )
      (list p1
       (list (car p1) (cadr p3) (caddr p1))
       p3
       (list (car p3) (cadr p1) (caddr p1))
      )
      '((1.0 0 0) (0 -1.0 0) (-1.0 0 0) (0 1.0 0))
   )
    )
    (setq
   p1 (apply 'mapcar (cons 'min lst))
   p3 (apply 'mapcar (cons 'max lst))
    )
   )
)
(list p1 p3)
)
(setq a (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq ss (ssget) x nil y nil z t)
(setq pt1 (getpoint "选择基点"))
(setq pt2 (getpoint pt1 "\n选择第一角点"))
(while z
(setq ptlst1 (ent-getbox (entlast))
   x (mapcar '(lambda (x) (/ x 2)) (mapcar '+ (car ptlst1) (cadr ptlst1)))
)
(command ".undo" "be")
(command "rotate" ss "" pt1 "c" "r" pt1 pt2 pause)
(command ".undo" "e")
(setq ptlst2 (ent-getbox (entlast))
   y (mapcar '(lambda (x) (/ x 2)) (mapcar '+ (car ptlst2) (cadr ptlst2)))
)
(setq z (null (equal x y 0.001)))
)
(command ".undo" "")
(setvar "cmdecho" a)
(princ)
)

yangchao2005090 发表于 2018-7-25 11:23:49

ssyfeng 发表于 2018-4-11 10:24
我那个改就要用到带捕捉的grread函数，你先试试这个：

好像不能用，输入命令时没法输入

taoyi0727 发表于 2018-7-25 12:57:41

ssyfeng 写的好

查看完整版本: 连续旋转复制