Jump to content

Scatter blocks inside a polyline or some kind of spray tool for ACAD ? ...


Recommended Posts

gashaglava

I need some kind of scatter tool or spray tool, that would spread some blocks/trees over an area, or closed polyline ...

 

I've seen there was once a routine or addon called Sketch++ or skpp, but it's not available for download anymore ... says "not free anymore" but I cant even find the commercial version of it

 

I want to use it to make some urban planning drawings more "alive" ... I'm working on a little settlement plan that's in the middle of a large forest, and would love to somehow "randomize" the trees, their position and scale ...

 

I know there are tons of plugins for 3dsmax for example, that spread or spray/paint selected 3d objects, with many options regarding distance, scale, density, ...

 

Is there somethig similar for Autocad, or could someone give it a try if its not too complicated ?

 

thanx in advance

 

 

Cheers,

 

Miroslav

ACAD Architecture 2012

Link to post
Share on other sites
  • Replies 20
  • Created
  • Last Reply

Top Posters In This Topic

  • marko_ribar

    5

  • rlx

    4

  • gashaglava

    2

  • cupax

    2

Top Posters In This Topic

Popular Posts

Check this program... (you have to be logged in...)   https://www.theswamp.org/index.php?topic=48113.msg531626#msg531626   Regards, M.R.

The original would have been 1e-8 since all occurrences of "8)" were removed from all code posts across the forum when the forum software was "upgraded".

Posted Images

marko_ribar

Here, try this :

 

(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 ptinsideent ( pt ent / msp ptt lin int a b tst result )
 (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
 (setq ptt (vlax-curve-getclosestpointto ent pt))
 (setq lin (vla-addline 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 lin acExtendBoth) 3))
 (setq a (angle pt ptt))
 (foreach p int
   (setq b (angle pt p))
   (if (equal a b 1e- (setq tst (cons T tst)) (setq tst (cons nil tst)))
 )
 (vla-delete lin)
 (if (eval (cons 'and tst)) (setq result nil) (setq result T))
 result
)

(defun c:populate ( / BNAME DX DXX DY DYY ENT ENTA MAXPOINT MAXPT MINPOINT MINPT MSP NO PT SCF SCFF SCFFMIN ) (vl-load-com)
 (setq ent (car (entsel "\nPick 2D closed entity without arcs")))
 (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 without arcs")))
 )
 (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)))
 (initget 6)
 (setq no (getint "\nInput number of blocks to populate : "))
 (setq bname "")
 (while (not (tblsearch "BLOCK" bname))
   (setq bname (getstring T "\nInput name of block to populate (CASE UNSENSITIVE) : "))
 )
 (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> : "))
 (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))    
       (vla-insertblock msp (vlax-3d-point pt) bname scff scff scff (* 2 pi (rnd)))
     )
   )
 )
 (princ)
)

M.R.

Hope this should help...

;)

Edited by marko_ribar
Link to post
Share on other sites
marko_ribar

Here is revision (changed ptinsideent sub-function)... Now routine can be applied and for closed 2D entities with arcs...

 

(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 ptinsideent ( pt ent / msp ptt lin int a b 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 lin (vla-addline 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 lin acExtendBoth) 3))
 (setq a (angle pt ptt))
 (setq b (angle pt (car (vl-remove ptt int))))
 (if (or (equal a b 1e- (> (length int) 2)) (setq tst (cons T tst)) (setq tst (cons nil tst)))
 (vla-delete lin)
 (if (eval (cons 'and tst)) (setq result nil) (setq result T))
 result
)

(defun c:populate ( / BNAME DX DXX DY DYY ENT ENTA MAXPOINT MAXPT MINPOINT MINPT MSP NO PT SCF SCFF SCFFMIN ) (vl-load-com)
 (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)))
 (initget 6)
 (setq no (getint "\nInput number of blocks to populate : "))
 (setq bname "")
 (while (not (tblsearch "BLOCK" bname))
   (setq bname (getstring T "\nInput name of block to populate (CASE UNSENSITIVE) : "))
 )
 (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> : "))
 (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))    
       (vla-insertblock msp (vlax-3d-point pt) bname scff scff scff (* 2 pi (rnd)))
     )
   )
 )
 (princ)
)

Regards, M.R.

:thumbsup:

Edited by marko_ribar
Link to post
Share on other sites
marko_ribar

Another slower version, but spreading is better...

 

(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 ptinsideent ( pt ent / ss result )
 (setq ss (ssget "_X"))
 (vl-cmdf "_.-boundary" "a" "b" "n" ent "" "" pt "")
 (if (> (sslength (ssget "_X")) (sslength ss)) (progn (setq result T) (entdel (entlast))) (setq result nil))
 result
)

(defun c:populate ( / BNAME DX DXX DY DYY ENT ENTA MAXPOINT MAXPT MINPOINT MINPT MSP NO PT SCF SCFF SCFFMIN ) (vl-load-com)
 (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)))
 (initget 6)
 (setq no (getint "\nInput number of blocks to populate : "))
 (setq bname "")
 (while (not (tblsearch "BLOCK" bname))
   (setq bname (getstring T "\nInput name of block to populate (CASE UNSENSITIVE) : "))
 )
 (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> : "))
 (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))    
       (vla-insertblock msp (vlax-3d-point pt) bname scff scff scff (* 2 pi (rnd)))
     )
   )
 )
 (princ)
)

 

Regards, M.R.

8)

Link to post
Share on other sites
marko_ribar

FINAL VERSION

 

(CAN BE APPLIED ON ENTITY WITH ARCS - MUCH FASTER THAN -BOUNDARY VERSION)

 

(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 c:populate ( / BNAME DX DXX DY DYY ENT ENTA MAXPOINT MAXPT MINPOINT MINPT MSP NO PT SCF SCFF SCFFMIN ) (vl-load-com)
 (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)))
 (initget 6)
 (setq no (getint "\nInput number of blocks to populate : "))
 (setq bname "")
 (while (not (tblsearch "BLOCK" bname))
   (setq bname (getstring T "\nInput name of block to populate (CASE UNSENSITIVE) : "))
 )
 (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> : "))
 (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))    
       (vla-insertblock msp (vlax-3d-point pt) bname scff scff scff (* 2 pi (rnd)))
     )
   )
 )
 (princ)
)

 

All the best, M.R.

8)8)8)

Link to post
Share on other sites
  • 5 years later...

Hello Marko,

I am aware, that this thread is 5 years old now :) This lisp does good job. So, I'd like to ask for more :)

1. Is it possible to adopt it so it accepts input name of the block to populate, or admit selection by pick or window sellection?

2. Could it populate more than one block at one time?

3. And for the last, could it populate blocks and other objects inside polyline?

 

Best regads, and Merry Christmas!

Link to post
Share on other sites
  • 1 year later...

this error message is usually caused by a missing ) or ( so maybe you cut-copy-pasted to much? Maybe download file again from original link.

Link to post
Share on other sites
13 hours ago, cupax said:

Hello.

The script is not working anymore on Autocad 2020. On LSP load I get: "error: malformed list on input".

Add this:

image.thumb.png.c83cb20552256ea64ad61cfbaab22c0d.png

 

Edited by ronjonp
Link to post
Share on other sites

You mean after the 1e- ?

(if (equal d (+ d1 d2) 1e-) (setq result T) (setq result nil))

 

(I tested the version from the link provided by marko_ribar)

Link to post
Share on other sites
pkenewell
17 minutes ago, rlx said:

You mean after the 1e- ?

 


(if (equal d (+ d1 d2) 1e-) (setq result T) (setq result nil))

 

 

(I tested the version from the link provided by marko_ribar)

Note - you also need to change the "-" in "1e-" to a number of decimal places like "1e6". Otherwise it does not work.

Edited by pkenewell
Link to post
Share on other sites

oops... you're right pkenewell ... not sure how accurate it should be though , 1e-4 , 1e-8 or 1e-14... guess just a matter of trial and error. But good catch from both you and ronjonp 😀🧐

 

(if (equal d (+ d1 d2) 1e-4) (setq result T) (setq result nil))
Link to post
Share on other sites

The original would have been 1e-8 since all occurrences of "8)" were removed from all code posts across the forum when the forum software was "upgraded".

  • Like 1
Link to post
Share on other sites
3 hours ago, rlx said:

You mean after the 1e- ?

 


(if (equal d (+ d1 d2) 1e-) (setq result T) (setq result nil))

 

 

(I tested the version from the link provided by marko_ribar)

That is correct .. I posted in haste 😳. I'll correct above.

Link to post
Share on other sites

Thanks guys, now it works.

If I may suggest an enhancement: the script is missing the "awareness" of where it already placed an instance of the block. So if you are doing a tree forest, you are going to get too much trees overlapping - placed one above another. Not a very natural distribution.

There should be an option to define the invisible clearance circle around each instance.

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.   Restore formatting

  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...