TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: chlh_jd on September 13, 2011, 04:48:23 PM
-
Hi all , to avoid 2 collision convex-polygon in any angle , we supose : first polygon is collision wiht second polygon , and we just move the 2nd polygon to avoid 1st polygon, here's your codes ...
-
Could you perhaps provide a diagram of the desired result?
-
sorry for offten less . like the picture .
-
if we up the deep , we can add min-distance (tor) , such as 1st distance to 2nd by tor or 2nd distance to 1st by tor .
-
Would the user specify the 'move angle'?
-
You're right Lee .
The angle is often by user , but it's any angle .
-
Here's mine , I believe it can be simplied .
(defun c:test (/ foo l1 l2 ang new ss oldm ent i)
;;by GSLS(SS)
(defun foo
(l1 l2 ang / l3 dis ip1)
(setq l3 (mapcar (function (lambda (x)
(polar x ang 1e10)
)
)
l2
)
)
(setq dis 1e99)
(foreach a l3
(if (setq ip1 (l_int_pl a (polar a ang -1e20) l1))
(setq dis (min dis (distance a (mindis-pt ip1 a))))
)
)
(foreach a l1
(if (setq ip1 (l_int_pl a (polar a ang 1e20) l3))
(setq dis (min dis (distance a (mindis-pt ip1 a))))
)
)
(mapcar (function (lambda (x)
(polar x ang (- dis))
)
)
l3
)
)
(setq oldm (getvar "modemacro"))
(setvar "modemacro" "Select Lines for angle:")
(setq l1 (ss-assoc 10
(entget (car (entsel "\nSelect 1st Polygon:")))
)
l2 (ss-assoc 10
(entget (car (entsel "\nSelect 2nd Polygon:")))
)
ss (ssget)
i 1
)
(if (and l1 l2 ss)
(foreach en (ss2lst ss nil)
(setq
ang (angle (dxf 10 (setq ent (entget en)))
(dxf 11 ent)
)
)
(if (setq new (foo l1 l2 ang))
(progn(draw-pl (list new (cons 62 i)))
(setq i (1+ i)))
(princ (strcat "angle = " (angtos ang) " error."))
)
)
)
(setvar "modemacro" oldm)
(princ)
)
;;
(defun dxf (co en)
(if (eq (type en) (quote ENAME))
(setq en (entget en (quote ("*"))))
)
(if (vl-consp co)
(mapcar (function (lambda (x) (cdr (assoc x en)))) co)
(cdr (assoc co en))
)
)
;;
(defun ss-assoc (a lst / b res)
(while (setq b (assoc a lst))
(setq lst (cdr (member b lst))
res (cons (cdr b) res)
)
)
(reverse res)
)
;;
(defun ss2lst (ss vla / a e i)
(if (= (type ss) (quote PICKSET))
(progn
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(if vla
(setq e (vlax-ename->vla-object e))
nil
)
(setq a (cons e a))
)
)
nil
)
)
;;
(defun draw-pl (lst)
(entmake
(append
(list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length (car lst)))
)
(mapcar (function (lambda (x) (cons 10 x))) (car lst))
(list (cons 70 1))
(cdr lst)
)
)
)
;;
(defun mindis-pt (lst pt)
(car
(vl-sort lst
(function (lambda (e1 e2)
(< (distance e1 pt) (distance e2 pt))
)
)
)
)
)
;;
(defun L_INT_PL (p1 p2 l / p3 p4 p res)
(setq l (cons (last l) l))
(while (cadr l)
(setq p3 (car l)
p4 (cadr l)
l (cdr l)
)
(setq p (inters p1 p2 p3 p4))
(if p
(setq res (cons p res))
)
)
res
)
-
(defun c:test ( / an o1 o2 o3 o4 p1 p2 p3 p4 )
(if
(and
(setq o1 (car (entsel "\nObject 1: ")))
(setq o2 (car (entsel "\nObject 2: ")))
(setq an (getangle "\nMove Angle: "))
)
(progn
(setq o1 (vlax-ename->vla-object o1)
o2 (vlax-ename->vla-object o2)
)
(vla-rotate (setq o3 (vla-copy o1)) (vlax-3D-point '(0. 0.)) (- an))
(vla-rotate (setq o4 (vla-copy o2)) (vlax-3D-point '(0. 0.)) (- an))
(vla-getboundingbox o3 'p1 'p2)
(vla-getboundingbox o4 'p3 'p4)
(vla-move o1
(vlax-3D-point '(0. 0.))
(vlax-3D-point
(polar '(0. 0.) an
(- (car (vlax-safearray->list p4))
(car (vlax-safearray->list p1))
)
)
)
)
(vla-delete o3) (vla-delete o4)
)
)
(princ)
)
-
Lee's code can quickly move the objects to avoid collide, and maybe chlh_jd 's code is to find the min distance at the given angle~
-
Your program only for convex polygons?
-
:) The following is my solution
Only for pline consist of line
by can deal with not only convex pline , but also concave pline.
The Algorithm is as in the gif
(I am not sure whether chlh_jd has the same algorithm, because I see 1e20 :-))
OK, It is late to go to bed, byebye~~
;;;; get the vertex of the polyline
(defun q:ent:lwpolyline:vertex (ent / pt_list)
(foreach x ent
(if (= (car x) 10)
(setq pt_list (append(list (cdr x))pt_list))))
pt_list
)
;;;; To deal the intersection of each two set
(defun q:q1:deal1(plst1 plst2 ang / a b)
(setq a (q:q1:deal2 plst1 plst2 ang))
(setq b (q:q1:deal2 plst2 plst1 (+ ang 3.1415926535897)))
(if (< (cadr a) (cadr b)) (setq a b))
a
)
;;;;
(defun q:q1:deal2(lst1 lst2 ang / dis dis1 i lst1a p res x x1 y)
(setq lst1a (reverse (cons (car lst1) (reverse (cdr lst1)))))
(foreach x lst2
(setq x1 (polar x ang 1e7) i 0)
(foreach y lst1
(if (setq p (inters x x1 y (nth i lst1a)))
(if (> (setq dis1 (distance p x)) dis) (setq res p dis dis1))
)
(setq i (1+ i))
)
)
(list res dis)
)
;;;;; Main function
(defun c:tt( / a ang lst1 lst2 o1 o2 res)
(setq o1 (car (entsel "\nObject 1: "))
o2 (car (entsel "\nObject 2: "))
ang (getangle "\nMove Angle: ")
lst1 (q:ent:lwpolyline:vertex (entget o1))
lst2 (q:ent:lwpolyline:vertex (entget o2))
res (q:q1:deal1 lst1 lst2 ang))
(princ "\n res = ") (princ res);Erase_DV
(if (setq a (car res))
(vla-move (vlax-ename->vla-object o2)
(vlax-3D-point a)
(vlax-3D-point (polar a ang (cadr res)))
))
(princ)
)
(princ "\n By qjchen")
-
Your program only for convex polygons?
Yes, it was only a very simple solution 8-)
-
The following is my solution
Great algorithm Chen! 8-)
Here is my version using your algorithm, I hope you don't mind :-)
(defun c:test ( / a b c )
(if
(and
(setq a (car (entsel "\nObject 1: ")))
(setq b (car (entsel "\nObject 2: ")))
(setq c (getangle "\nMove Angle: "))
)
(vla-move (vlax-ename->vla-object b) (vlax-3D-point '(0. 0. 0.))
(vlax-3D-point
(polar '(0. 0. 0.) c
(apply 'max
(apply 'append
(apply 'mapcar
(cons
(function
(lambda ( a b ) (setq c (+ c pi))
(apply 'append
(mapcar
(function
(lambda ( a )
(apply 'append
(mapcar
(function
(lambda ( x y )
(if (setq z (inters a (polar a c 1e8) x y))
(list (distance z a))
)
)
)
b (cons (last b) b)
)
)
)
)
a
)
)
)
)
( (lambda ( a ) (list a (reverse a)))
(mapcar
(function
(lambda ( a )
(apply 'append
(mapcar
(function
(lambda ( a ) (if (= 10 (car a)) (list (cdr a))))
)
(entget a)
)
)
)
)
(list a b)
)
)
)
)
)
)
)
)
)
)
(princ)
)
-
The following is my solution
Great algorithm Chen! 8-)
Here is my version using your algorithm, I hope you don't mind :-)
Thanks Lee, I am very glad that you like this algorithm~~.
And I like your concise code and beautiful code style (Evgeniy use the same style~, it make me feel dizzy, but I like it very much).
I will try to shorten my code~.
-
The 2nd LM's code make me feel dizziness ^^. But i think the 1st code can be improved to use with more Objects type :)
-
Great solution Chen !
Thank you Lee for nice 'Test !
-
In my codes in 6th-F, I use the method 'Move back from infinity' , it can be use all polygons but contains-arcs ; It alos can be use in move 2nd polygon from distant location to 1st polygon and they are not collided .
-
If the 2 polygons is not collided , Using Chen's method and my way will get deffrent results .
See the following picture .
-
Thanks Lee, I am very glad that you like this algorithm~~.
And I like your concise code and beautiful code style (Evgeniy use the same style~, it make me feel dizzy, but I like it very much).
Thanks Chen :-) This code style is maybe a little obfuscated for main-stream applications which will need to be maintained, but I enjoy using it for these challenges :-)
The 2nd LM's code make me feel dizziness ^^. But i think the 1st code can be improved to use with more Objects type :)
Great solution Chen !
Thank you Lee for nice 'Test !
Thanks guys 8-)
-
Have bug?Hope can better improve。
-
Not 100% sure, but try this...
(defun c:MM ( / lw1 lw2 lst1 lst2 a rayintpolygon rtn lstm bb d )
(vl-load-com)
(setq lw1 (car (entsel "\nPick first POLYGON...")))
(setq lw2 (car (entsel "\nPick second POLYGON which is about to move to first one...")))
(setq lst1 (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lw1))))
(setq lst2 (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lw2))))
(setq a (getangle "\nPick or specify angle : "))
(defun rayintpolygon ( p a lst / ip rtn )
(foreach li (mapcar '(lambda ( a b ) (list a b)) lst (cdr (reverse (cons (car lst) (reverse lst)))))
(if (setq ip (inters p (polar p a 1e+20) (car li) (cadr li)))
(setq rtn (cons (list (mapcar '+ '(0 0) ip) (distance ip p)) rtn))
(cond
( (equal a (angle p (car li)) 1e-6)
(setq rtn (cons (list (car li) (distance (car li) p)) rtn))
)
( (equal a (angle p (cadr li)) 1e-6)
(setq rtn (cons (list (cadr li) (distance (cadr li) p)) rtn))
)
)
)
)
rtn
)
(foreach p lst2
(setq rtn (append (rayintpolygon p a lst1) rtn))
)
(foreach p lst1
(setq rtn (append (rayintpolygon p (+ a pi) lst2) rtn))
)
(foreach r (vl-sort rtn '(lambda ( a b ) (> (cadr a) (cadr b))))
(setq lstm (cons (mapcar '(lambda ( p ) (polar p a (cadr r))) lst2) lstm))
)
(foreach lst lstm
(foreach li (mapcar '(lambda ( a b ) (list a b)) lst (cdr (reverse (cons (car lst) (reverse lst)))))
(if (vl-some '(lambda ( li1 / ip ) (and (setq ip (inters (car li) (cadr li) (car li1) (cadr li1))) (setq ip (mapcar '+ '(0 0) ip)) (not (or (equal ip (car li) 1e-6) (equal ip (cadr li) 1e-6) (equal ip (car li1) 1e-6) (equal ip (cadr li1) 1e-6))))) (mapcar '(lambda ( a b ) (list a b)) lst1 (cdr (reverse (cons (car lst1) (reverse lst1))))))
(setq lstm (vl-remove lst lstm))
)
)
)
(defun bb ( lst / minp maxp )
(setq minp (apply 'mapcar (cons 'min lst)))
(setq maxp (apply 'mapcar (cons 'max lst)))
(* (abs (- (car maxp) (car minp))) (abs (- (cadr maxp) (cadr minp))))
)
(setq lstm (vl-sort lstm '(lambda ( a b ) (< (bb (append a lst1)) (bb (append b lst1))))))
(setq d (distance (car lst2) (caar lstm)))
(vla-move (vlax-ename->vla-object lw2) (vlax-3d-point '(0 0)) (vlax-3d-point (polar '(0 0) a d)))
(princ)
)
M.R.