;;; Marko Ribar Dynamic ISOmetric Routine
;;; Saved from: https://www.theswamp.org/index.php?topic=52655.0
(defun c:3d ( / massoclst pol1 pol2 bl lst1 lst2 lil p gr pp v lst2n )

(defun massoclst ( key lst )
(if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst)))))
)

(setq pol1 (car (entsel "\nPick LWPOLYLINE...")))
(setq pol2 (entmakex (vl-remove-if (function (lambda ( x ) (vl-position (car x) '(-1 5 330)))) (entget pol1))))
(setq bl (massoclst 42 (entget pol2)))
(setq lst1 (mapcar 'cdr (massoclst 10 (entget pol1))))
(setq lst2 (mapcar 'cdr (massoclst 10 (entget pol2))))
(mapcar (function (lambda ( a b ) (setq lil (cons (entmakex (list '(0 . "LINE") (cons 10 a) (cons 11 b))) lil)))) lst1 lst2)
(setq lil (reverse lil))
(setq p (getpoint "\nPick or specify point : "))
(prompt "\nMove mouse and press \"+\" or \"-\" keys for scale and \"4\" or \"6\" for rotation... To finish left mouse click...")
(while (/= 3 (car (setq gr (grread t))))
(cond
( (and (= 2 (car gr)) (= 43 (cadr gr)))
(setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ pp (mapcar '* (mapcar '- x pp) (list (sqrt 2.0) (sqrt 2.0)))))) lst2n))
)
( (and (= 2 (car gr)) (= 45 (cadr gr)))
(setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ pp (mapcar '* (mapcar '- x pp) (list (/ (sqrt 2.0) 2.0) (/ (sqrt 2.0) 2.0)))))) lst2n))
)
( (and (= 2 (car gr)) (= 52 (cadr gr)))
(setq lst2n (mapcar (function (lambda ( x ) (polar pp (+ (angle pp x) (/ pi 4.0)) (distance pp x)))) lst2n))
)
( (and (= 2 (car gr)) (= 54 (cadr gr)))
(setq lst2n (mapcar (function (lambda ( x ) (polar pp (- (angle pp x) (/ pi 4.0)) (distance pp x)))) lst2n))
)
( t
(if (null pp)
(setq pp (cadr gr))
)
(setq v (mapcar '- pp p))
(if (null lst2n)
(setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ v x))) lst2))
(progn
(setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ (mapcar '- (cadr gr) pp) x))) lst2n))
(setq pp (cadr gr))
)
)
)
)
(entmod (append (vl-remove-if (function (lambda ( x ) (vl-position (car x) '(10 42)))) (entget pol2)) (apply 'append (mapcar (function (lambda ( a b ) (list (cons 10 a) b))) lst2n bl))))
(mapcar (function (lambda ( a x ) (entmod (subst (cons 11 a) (assoc 11 (entget x)) (entget x))))) lst2n lil)
(redraw)
)
(princ)
)

(c:3d)

Advertisements