ramimann Posted December 15, 2020 Share 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 Link to comment Share on other sites More sharing options...
marko_ribar Posted December 15, 2020 Share 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 Link to comment Share on other sites More sharing options...
ramimann Posted December 16, 2020 Author Share Posted December 16, 2020 Thanks a lot That exactly what I wanted Quote Link to comment Share on other sites More sharing options...
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.