Jump to content
ramimann

Deploy objects inside an area

Recommended Posts

ramimann

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.

Share this post


Link to post
Share on other sites
marko_ribar

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 by marko_ribar

Share this post


Link to post
Share on other sites
ramimann

Thanks a lot

That exactly what I wanted😉

Share this post


Link to post
Share on other sites

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.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...