Scatter in multiple polyline

[loudy000]

Hi all found this awesome lisp http://www.cadtutor.net/forum/showthread.php?68154-Scatter-blocks-inside-a-polyline-or-some-kind-of-spray-tool-for-ACAD-...

 

it's great but i want to make some modification.

 

1. set fix name block

2. can select multiple closed polylines

3. Set minimum distance between point because sometimes theyre too close.

 

 

Thanks in advance

[Emmanuel Delay]

Yes, that is a fun feature.

 

I rearranged the code a little. The polyline gets picked last, but in a while loop.

 

Now c:populate first asks for "blockname", "number", ...then you can pick multiple polylines, they will be populated with the same options.

 

I also made a function c:scatter, so you can pre set your options.

(defun c:scatter ( / )
 (while
   (populate "MYBLOCKNAME" 50 1.5 0.01)   ;; blockname, number, max-scale min-scale
 )
)

 

Happy with this?

 

Oh, haven't done point 3 of your request, I'll have to check if that's doable (not sure)

 

----

 

(defun rnd (/ modulus multiplier increment rand)
 (if (not seed)
   (setq seed (getvar "DATE"))
 )
 (setq modulus    65536
       multiplier 25173
       increment  13849
       seed  (rem (+ (* multiplier seed) increment) modulus)
       rand     (/ seed modulus)
 )
)

(defun GroupByNum ( lst n / r)
 (if lst
   (cons
     (reverse (repeat n (setq r (cons (car lst) r) lst (cdr lst)) r))
     (GroupByNum lst n)
   )
 )
)

(defun ptonline ( pt pt1 pt2 / vec12 vec1p d result )
 (setq vec12 (mapcar '- pt2 pt1))
 (setq vec12 (reverse (cdr (reverse vec12))))
 (setq vec1p (mapcar '- pt pt1))
 (setq vec1p (reverse (cdr (reverse vec1p))))
 (setq vec2p (mapcar '- pt2 pt))
 (setq vec2p (reverse (cdr (reverse vec2p))))
 (setq d (distance '(0.0 0.0) vec12) d1 (distance '(0.0 0.0) vec1p) d2 (distance '(0.0 0.0) vec2p))
 (if (equal d (+ d1 d2) 1e- (setq result T) (setq result nil))
 result
)

(defun ptinsideent ( pt ent / msp ptt xlin int k kk tst result )
 (vl-load-com)
 (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
 (setq ptt (vlax-curve-getclosestpointto ent pt))
 (setq xlin (vla-addxline msp (vlax-3d-point pt) (vlax-3d-point ptt)))
 (setq int (GroupByNum (vlax-invoke (if (eq (type ent) 'ENAME) (vlax-ename->vla-object ent)) 'intersectwith xlin acExtendBoth) 3))
 (setq int (vl-sort int '(lambda (a b) (< (vlax-curve-getparamatpoint xlin a) (vlax-curve-getparamatpoint xlin b)))))
 (setq k 0)
 (while (< (setq k (1+ k)) (length int))
   (if (and (eq (rem k 2) 1) (ptonline pt (nth (- k 1) int) (nth k int))) (setq tst (cons T tst)) (setq tst (cons nil tst)))
 )
 (setq tst (reverse tst))
 (setq k 0)
 (mapcar '(lambda (x) (setq k (1+ k)) (if (eq x T) (setq kk k))) tst)
 (vla-delete xlin)
 (if kk
   (if (eq (rem kk 2) 1) (setq result T) (setq result nil))
   (setq result nil)
 )
 result
)

(defun populate ( bname no scf scfmin /  DX DXX DY DYY ENT ENTA MAXPOINT MAXPT MINPOINT MINPT MSP PT SCFF result) (vl-load-com)
 (setq result nil)
 (setq ent (car (entsel "\nPick 2D closed entity")))
 (while (eq (cdr (assoc 70 (entget ent))) 0)
   (prompt "\nPicked entity is open, please pick closed one")
   (setq ent (car (entsel "\nPick 2D closed entity")))
 )
 (setq entA (vlax-ename->vla-object ent))
 (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
 (vla-getboundingbox entA 'minpoint 'maxpoint)
 (setq
  minpt (vlax-safearray->list minpoint)
  maxpt (vlax-safearray->list maxpoint)
 )
 (setq dx (- (car maxpt) (car minpt)))
 (setq dy (- (cadr maxpt) (cadr minpt)))
 (if (null scfmin) (setq scfmin 1.0))
 (while (> no 0)
   (setq dxx (* dx (rnd)))
   (setq dyy (* dy (rnd)))
   (setq pt (list (+ (car minpt) dxx) (+ (cadr minpt) dyy) 0.0))
   (if (and (eq scfmin 1.0) (eq scf 1.0)) (setq scff 1.0) (setq scff (+ scfmin (* (- scf scfmin) (rnd)))))
   (if (ptinsideent pt ent)
     (progn
       (setq no (1- no))    
       (setq result (vla-insertblock msp (vlax-3d-point pt) bname scff scff scff (* 2 pi (rnd))))
     )
   )
 )
 result
)

(defun c:populate ( / bname no)
 (setq bname "")
 (while (not (tblsearch "BLOCK" bname))
   (setq bname (getstring T "\nInput name of block to populate (CASE UNSENSITIVE) : "))
 )
 (initget 6)
 (setq no (getint "\nInput number of blocks to populate : "))
 (initget 6)
 (setq scf (getreal "\nInput max. scale factor for block insertion <1.0> : "))
 (if (null scf) (setq scf 1.0))
 (initget 6)
 (setq scfmin (getreal "\nInput min. scale factor for block insertion <1.0> : "))
 (while
   (populate bname no scf scfmin)
 )
 (princ)
)

(defun c:scatter ( / )
 (while
   (populate "MYBLOCKNAME" 50 1.5 0.01)
 )
)

[loudy000]

Awesome! Many thanks I’ll try this later.

[loudy000]

Hi did you get a chance to look if it’s possible to set minimum spacing? Thanks :)

[Emmanuel Delay]

I just tried something, I think it works pretty well. 

What the script did: it picks a point within a rectangle/box.  If that point is not inside the polyline (which can have a weird shape) that point is skipped. and the while-loop tries again.  Eventually a point will be found.

I added a "not_too_close" condition to the if (in the while).  The difference is: there is no guarantee that it's possible to find points that are not too close, you could get into an infinite loop.  So maximum 3000 rejected points; after that any point will be marked as okay.  You can  adapt that 3000 to whatever integer you wish. 

	;; example: block_name "b", 20 points, 1.5 max_scale, 0.01 min_scale,  minimum distance = 1000.0
	(defun c:scatter ( / )
  (while
    (populate "b" 20 1.5 0.01 1000.0)  ;;
  )
)
	

You can adapt at line 76, inside function populate: (setq max_tries 3000)

---

	(defun rnd (/ modulus multiplier increment rand)
  (if (not seed)
    (setq seed (getvar "DATE"))
  )
  (setq modulus    65536
        multiplier 25173
        increment  13849
        seed  (rem (+ (* multiplier seed) increment) modulus)
        rand     (/ seed modulus)
  )
)
	(defun GroupByNum ( lst n / r)
  (if lst
    (cons
      (reverse (repeat n (setq r (cons (car lst) r) lst (cdr lst)) r))
      (GroupByNum lst n)
    )
  )
)
	(defun ptonline ( pt pt1 pt2 / vec12 vec1p d result )
  (setq vec12 (mapcar '- pt2 pt1))
  (setq vec12 (reverse (cdr (reverse vec12))))
  (setq vec1p (mapcar '- pt pt1))
  (setq vec1p (reverse (cdr (reverse vec1p))))
  (setq vec2p (mapcar '- pt2 pt))
  (setq vec2p (reverse (cdr (reverse vec2p))))
  (setq d (distance '(0.0 0.0) vec12) d1 (distance '(0.0 0.0) vec1p) d2 (distance '(0.0 0.0) vec2p))
  (if (equal d (+ d1 d2) 1e-8) (setq result T) (setq result nil))
  result
)
	(defun ptinsideent ( pt ent / msp ptt xlin int k kk tst result )
  (vl-load-com)
  (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (setq ptt (vlax-curve-getclosestpointto ent pt))
  (setq xlin (vla-addxline msp (vlax-3d-point pt) (vlax-3d-point ptt)))
  (setq int (GroupByNum (vlax-invoke (if (eq (type ent) 'ENAME) (vlax-ename->vla-object ent)) 'intersectwith xlin acExtendBoth) 3))
  (setq int (vl-sort int '(lambda (a b) (< (vlax-curve-getparamatpoint xlin a) (vlax-curve-getparamatpoint xlin b)))))
  (setq k 0)
  (while (< (setq k (1+ k)) (length int))
    (if (and (eq (rem k 2) 1) (ptonline pt (nth (- k 1) int) (nth k int))) (setq tst (cons T tst)) (setq tst (cons nil tst)))
  )
  (setq tst (reverse tst))
  (setq k 0)
  (mapcar '(lambda (x) (setq k (1+ k)) (if (eq x T) (setq kk k))) tst)
  (vla-delete xlin)
  (if kk
    (if (eq (rem kk 2) 1) (setq result T) (setq result nil))
    (setq result nil)
  )
  result
)
	(setq max_tries 3000)
(defun not_too_close (pt allpoints min_dist / okay i)
  (setq okay T)
  (setq i 0)
  (if (> max_tries 0)
    (repeat (length allpoints)
      (if (< (distance pt (nth i allpoints) ) min_dist )
        (setq okay nil)
      )
      (setq max_tries (- max_tries 1))
      (setq i (+ i 1))
    )
  )
  okay
)
	(defun populate ( bname no scf scfmin min_dist /  DX DXX DY DYY ENT ENTA MAXPOINT MAXPT MINPOINT MINPT MSP PT SCFF result) (vl-load-com)
  (setq result nil)
 
  (setq allpoints (list))
  (setq max_tries 3000)  ;; 3000 attemps to reject a block that is too close to other blocks
 
  (setq ent (car (entsel "\nPick 2D closed entity")))
  (while (eq (cdr (assoc 70 (entget ent))) 0)
    (prompt "\nPicked entity is open, please pick closed one")
    (setq ent (car (entsel "\nPick 2D closed entity")))
  )
  (setq entA (vlax-ename->vla-object ent))
  (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (vla-getboundingbox entA 'minpoint 'maxpoint)
  (setq
   minpt (vlax-safearray->list minpoint)
   maxpt (vlax-safearray->list maxpoint)
  )
  (setq dx (- (car maxpt) (car minpt)))
  (setq dy (- (cadr maxpt) (cadr minpt)))
  (if (null scfmin) (setq scfmin 1.0))
  (while (> no 0)
    (setq dxx (* dx (rnd)))
    (setq dyy (* dy (rnd)))
    (setq pt (list (+ (car minpt) dxx) (+ (cadr minpt) dyy) 0.0))
    (if (and (eq scfmin 1.0) (eq scf 1.0)) (setq scff 1.0) (setq scff (+ scfmin (* (- scf scfmin) (rnd)))))
    (if (and (not_too_close pt allpoints min_dist) (ptinsideent pt ent))
      (progn
        (setq no (1- no))    
        (setq result (vla-insertblock msp (vlax-3d-point pt) bname scff scff scff (* 2 pi (rnd))))
    (setq allpoints (append allpoints (list pt)))
      )
    )
  )
  result
)
	(defun c:populate ( / bname no min_dist)
  (setq bname "")
  (while (not (tblsearch "BLOCK" bname))
    (setq bname (getstring T "\nInput name of block to populate (CASE UNSENSITIVE) : "))
  )
  (initget 6)
  (setq no (getint "\nInput number of blocks to populate : "))
  (initget 6)
  (setq scf (getreal "\nInput max. scale factor for block insertion <1.0> : "))
  (if (null scf) (setq scf 1.0))
  (initget 6)
  (setq scfmin (getreal "\nInput min. scale factor for block insertion <1.0> : "))
  (setq min_dist (getreal "\nMinimum distance: ") )
  (while
    (populate bname no scf scfmin min_dist)
  )
  (princ)
)
	(defun c:scatter ( / )
  (while
    (populate "b" 20 1.5 0.01 1000.0)
  )
)
	

 

Edited August 23, 2018 by Emmanuel Delay

[loudy000]

Awesome work! Many thanks!

[AndreasB]

Hi there! 

I'm trying to use this, but im having some problems unfortunately. Note that im very new at this Lisp, sorry. 

But whenever i'm trying to use it, it's not really doing anything inside the closed polyline? On the other hand it's actually putting everything outside 
in this kinda 'round' shape and wiiiidely spread. Do you have any idea, what's going on?