0 Members and 1 Guest are viewing this topic.
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).
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 !
(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))