ramimann Posted December 15, 2020 Posted December 15, 2020 Hello everyone I'm looking for a routine (or any way) to deploy objects (blocks or any other) inside an area.For example: deploy 50 circles within a closed polyline with equal distances from all sides. Quote
marko_ribar Posted December 15, 2020 Posted December 15, 2020 (edited) Here I've put something together for you : (defun c:populateclosedcurve ( / LM:Inside-p ent cur n ti ll ur llc urc ar d a1 m fac dn wn hn dw dh o c r oo pl k dnn ) (vl-load-com) ; Lee Mac Point Inside Curve or lies on Curve (defun LM:Inside-p ( pt ent / unit v^v _GroupByNum fd1 fd2 par lst nrm obj tmp ) (vl-load-com) (defun unit ( v / d ) (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-8)) (mapcar '(lambda ( x ) (/ x d)) v) ) ) (defun v^v ( u v ) (list (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v))) (- (* (caddr u) (car v)) (* (car u) (caddr v))) (- (* (car u) (cadr v)) (* (cadr u) (car v))) ) ) (defun _GroupByNum ( l n / r ) (if l (cons (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r)) (_GroupByNum l n)) ) ) (if (= (type ent) 'VLA-OBJECT) (setq obj ent ent (vlax-vla-object->ename ent)) (setq obj (vlax-ename->vla-object ent)) ) (if (vlax-curve-isplanar ent) (progn (setq fd1 (vlax-curve-getfirstderiv ent (setq par (vlax-curve-getstartparam ent)))) (while (or (equal fd1 (setq fd2 (vlax-curve-getfirstderiv ent (setq par (+ par 0.001)))) 1e-3) (null (setq nrm (unit (v^v fd1 fd2)))))) (setq lst (_GroupByNum (vlax-invoke (setq tmp (vlax-ename->vla-object (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") (cons 10 pt) (cons 11 (trans '(1. 0. 0.) nrm 0)) ) ) ) ) 'IntersectWith obj acextendnone ) 3 ) ) (vla-delete tmp) ;; gile: (and lst (or (vlax-curve-getparamatpoint ent pt) (= 1 (rem (length (vl-remove-if (function (lambda ( p / pa p- p+ p0 ) (setq pa (vlax-curve-getparamatpoint ent p)) (and (setq p- (cond ((setq p- (vlax-curve-getPointatParam ent (- pa 1e-8))) (trans p- 0 nrm) ) ((trans (vlax-curve-getPointatParam ent (- (vlax-curve-getEndParam ent) 1e-8)) 0 nrm) ) ) ) (setq p+ (cond ((setq p+ (vlax-curve-getPointatParam ent (+ pa 1e-8))) (trans p+ 0 nrm) ) ((trans (vlax-curve-getPointatParam ent (+ (vlax-curve-getStartParam ent) 1e-8)) 0 nrm) ) ) ) (setq p0 (trans pt 0 nrm)) (<= 0 (* (sin (angle p0 p-)) (sin (angle p0 p+)))) ;; LM Mod ) ) ) lst ) ) 2 ) ) ) ) ) (prompt "\nReference curve isn't planar...") ) ) (while (or (not (setq ent (car (entsel "\nPick unit entity for population...")))) (if ent (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget ent)))))))) ) ) (prompt "\nMissed or picked entity on locked layer...") ) (while (or (not (setq cur (car (entsel "\nPick closed curve entity as boundary for population...")))) (if cur (or (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list cur))) (not (vlax-curve-isclosed cur)) ) ) ) (prompt "\nMissed or picked entity not curve or picked curve not closed...") ) (initget 7) (setq n (getint "\nSpecify number of entities for population : ")) (setq ti (car (_vl-times))) (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur) (mapcar 'set '(ll ur) (mapcar 'safearray-value (list ll ur))) (vla-getboundingbox (vlax-ename->vla-object cur) 'llc 'urc) (mapcar 'set '(llc urc) (mapcar 'safearray-value (list llc urc))) (if (or (> (- (car ur) (car ll)) (- (car urc) (car llc))) (> (- (cadr ur) (cadr ll)) (- (cadr urc) (cadr llc)))) (progn (prompt "\nPicked unit entity bigger than picked closed curve... Quitting...") (exit) ) (progn (setq ar (vlax-curve-getarea cur)) (setq d (max (- (car ur) (car ll)) (- (cadr ur) (cadr ll)))) (setq a1 (* d d)) (if (> (* n a1) ar) (progn (prompt "\nSpecified number of population too big... Specify smaller number next time... Quitting...") (exit) ) (progn (setq m (/ ar a1)) (setq fac (/ m n)) (setq dn (sqrt (* fac a1))) (setq wn (fix (/ (- (car urc) (car llc)) dn))) (setq hn (fix (/ (- (cadr urc) (cadr llc)) dn))) (setq dw (/ (- (- (car urc) (car llc)) (* wn dn)) 2.0)) (setq dh (/ (- (- (cadr urc) (cadr llc)) (* hn dn)) 2.0)) (setq o (mapcar '+ llc (list dw dh))) (setq c -1) (repeat wn (setq c (1+ c)) (setq r -1) (repeat hn (setq r (1+ r)) (setq oo (mapcar '+ o (list (* c dn) (* r dn)))) (if (and (LM:Inside-p oo cur) (LM:Inside-p (mapcar '+ oo (list dn 0.0)) cur) (LM:Inside-p (mapcar '+ oo (list dn dn)) cur) (LM:Inside-p (mapcar '+ oo (list 0.0 dn)) cur)) (setq pl (cons (mapcar '+ oo (list (/ dn 2.0) (/ dn 2.0))) pl)) ) ) ) (setq k 0 dnn dn) (while (< (length pl) n) (setq pl nil) (setq dn (- dnn (* (/ (- dnn d) 100.0) (setq k (1+ k))))) (setq wn (fix (/ (- (car urc) (car llc)) dn))) (setq hn (fix (/ (- (cadr urc) (cadr llc)) dn))) (setq dw (/ (- (- (car urc) (car llc)) (* wn dn)) 2.0)) (setq dh (/ (- (- (cadr urc) (cadr llc)) (* hn dn)) 2.0)) (setq o (mapcar '+ llc (list dw dh))) (setq c -1) (repeat wn (setq c (1+ c)) (setq r -1) (repeat hn (setq r (1+ r)) (setq oo (mapcar '+ o (list (* c dn) (* r dn)))) (if (and (LM:Inside-p oo cur) (LM:Inside-p (mapcar '+ oo (list dn 0.0)) cur) (LM:Inside-p (mapcar '+ oo (list dn dn)) cur) (LM:Inside-p (mapcar '+ oo (list 0.0 dn)) cur)) (setq pl (cons (mapcar '+ oo (list (/ dn 2.0) (/ dn 2.0))) pl)) ) ) ) ) ) ) (foreach p pl (vla-move (vla-copy (vlax-ename->vla-object ent)) (vlax-3d-point (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ll ur)) (vlax-3d-point p)) ) (prompt "\nElapsed time : ") (princ (rtos (- (car (_vl-times)) ti) 2 20)) (prompt " milliseconds...") ) ) (princ) ) Edited December 16, 2020 by marko_ribar Quote
ramimann Posted December 16, 2020 Author Posted December 16, 2020 Thanks a lot That exactly what I wanted Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.