连续旋转复制

edrise

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

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

ssyfeng

能用就行。

LIULISHENG

真的很不错

edrise

经过测试，证实我结束循环的办法可行，算是解决了我目前的需求吧。更新一下代码

1. (defun c:rtc (/ *error* pt1 pt2 ss a x y z)
   
2.   (defun *error* (msg)
   
3.     (setvar "cmdecho" a)
   
4.     (command ".undo" "e")
   
5.     (princ "error: ")
   
6.     (princ msg)
   
7.     (princ)
   
8.     )
   
9.   (setq a (getvar "cmdecho"))
   
10.   (setvar "cmdecho" 0)
    
11.   (setq ss (ssget) x nil y nil z t)
    
12.   (setq pt1 (getpoint "选择基点"))
    
13.   (setq pt2 (getpoint pt1 "\n选择第一角点"))
    
14.   (while z
    
15.     (setq x (entget (entlast)))
    
16.     (command ".undo" "be")
    
17.     (command "rotate" ss "" pt1 "c" "r" pt1 pt2 pause)
    
18.     (command ".undo" "e")
    
19.     (setq y (entget (entlast)))
    
20.     (setq z (judge_coincide x y))
    
21.   )
    
22.   (command ".undo" "")
    
23.   (setvar "cmdecho" a)
    
24. )
    
25. 
    
26. (defun judge_coincide(ls1 ls2 / a b)
    
27.   (setq a (assoc 10 ls1))
    
28.   (setq b (assoc 10 ls2))
    
29.   (if (and
    
30.   (= 0 (- (nth 1 a) (nth 1 b)))
    
31.   (= 0 (- (nth 2 a) (nth 2 b)))
    
32.   )
    
33.     nil
    
34.     t
    
35.     )
    
36.   )

(defun c:rtc (/ *error* pt1 pt2 ss a x y z)<br />   (defun *error* (msg)<br />     (setvar "cmdecho" a)<br />     (command ".undo" "e")<br />     (princ "error: ")<br />     (princ msg)<br />     (princ)<br />     )<br />   (setq a (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (setq ss (ssget) x nil y nil z t)<br />   (setq pt1 (getpoint "选择基点"))<br />   (setq pt2 (getpoint pt1 "\n选择第一角点"))<br />   (while z<br />     (setq x (entget (entlast)))<br />     (command ".undo" "be")<br />     (command "rotate" ss "" pt1 "c" "r" pt1 pt2 pause)<br />     (command ".undo" "e")<br />     (setq y (entget (entlast)))<br />     (setq z (judge_coincide x y))<br />   )<br />   (command ".undo" "")<br />   (setvar "cmdecho" a)<br /> )<br /> <br /> (defun judge_coincide(ls1 ls2 / a b)<br />   (setq a (assoc 10 ls1))<br />   (setq b (assoc 10 ls2))<br />   (if (and<br />   (= 0 (- (nth 1 a) (nth 1 b)))<br />   (= 0 (- (nth 2 a) (nth 2 b)))<br />   )<br />     nil<br />     t<br />     )<br />   )

edrise

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

ssyfeng

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

edrise

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

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

ssyfeng

我那个改就要用到带捕捉的grread函数，你先试试这个：

1. (defun c:rtc (/ *error* a pt1 pt2 ptlst1 ptlst2 ss x y z)
   
2. (defun *error* (msg)
   
3.   (setvar "cmdecho" a)
   
4.   (command ".undo" "e")
   
5.   (princ "error: ")
   
6.   (princ msg)
   
7.   (princ)
   
8. )
   
9. (defun ent-getbox (ent / lst obj p1 p2 p3 p4)
   
10.   (setq obj (vlax-ename->vla-object ent))
    
11.   (vla-GetBoundingBox obj 'p1 'p3)
    
12.   (setq p1 (vlax-safearray->list p1)
    
13.    p3 (vlax-safearray->list p3)
    
14.   )
    
15.   (if (= "SPLINE" (cdr (assoc 0 (entget ent))))
    
16.    (progn
    
17.     (setq lst
    
18.      (mapcar
    
19.       '(lambda (a b)
    
20.         (vlax-curve-getClosestPointToProjection ent a b t)
    
21.        )
    
22.       (list p1
    
23.        (list (car p1) (cadr p3) (caddr p1))
    
24.        p3
    
25.        (list (car p3) (cadr p1) (caddr p1))
    
26.       )
    
27.       '((1.0 0 0) (0 -1.0 0) (-1.0 0 0) (0 1.0 0))
    
28.      )
    
29.     )
    
30.     (setq
    
31.      p1 (apply 'mapcar (cons 'min lst))
    
32.      p3 (apply 'mapcar (cons 'max lst))
    
33.     )
    
34.    )
    
35.   )
    
36.   (list p1 p3)
    
37. )
    
38. (setq a (getvar "cmdecho"))
    
39. (setvar "cmdecho" 0)
    
40. (setq ss (ssget) x nil y nil z t)
    
41. (setq pt1 (getpoint "选择基点"))
    
42. (setq pt2 (getpoint pt1 "\n选择第一角点"))
    
43. (while z
    
44.   (setq ptlst1 (ent-getbox (entlast))
    
45.    x (mapcar '(lambda (x) (/ x 2)) (mapcar '+ (car ptlst1) (cadr ptlst1)))
    
46.   )
    
47.   (command ".undo" "be")
    
48.   (command "rotate" ss "" pt1 "c" "r" pt1 pt2 pause)
    
49.   (command ".undo" "e")
    
50.   (setq ptlst2 (ent-getbox (entlast))
    
51.    y (mapcar '(lambda (x) (/ x 2)) (mapcar '+ (car ptlst2) (cadr ptlst2)))
    
52.   )
    
53.   (setq z (null (equal x y 0.001)))
    
54. )
    
55. (command ".undo" "")
    
56. (setvar "cmdecho" a)
    
57. (princ)
    
58. )
    

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

yangchao2005090

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

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

taoyi0727

ssyfeng 写的好