cg-Cad

Lisp »Tips 'n Tricks »Bosc.lsp

ALBERO.DWG
Il blocco albero.dwg usato dal lisp BOSC



*versione 1.0
Il lisp inserisce in modo casuale il blocco ALBERO nel disegno generando un bosco all'interno di un profilo rettangolare o quadrato.
Per il corretto funzionamento del LISP si deve copiare il blocco albero.dwg nella cartella PICK/LISP (per chi usa PicK) o in una cartella a propria scelta, cambiando il percorso nel codice sorgente, la stringa di colore verde.
Si può sostituire il blocco fornito con un blocco personale; però il lisp è tarato su albero.dwg e quindi il tuo disegno deve rispettare le dimensioni del blocco originale.

BOSC impiega la funzione rn() (le stringhe colorate in blu nel codice sorgente). Rn() legge la variabile DATA di AutoCAD e dopo una serie di operazioni genera un numero casuale da 0 a 0.999: e così inserendo la funzione in alcuni punti del codice (stringhe rosse) si ottiene un bosco datato ma privo di scadenza.
Il Lisp chiede la densità del bosco (a grandi numeri corrisponde bassa densità valore massimo di ombrosità = 3), e 2 punti per delimitare l'area del bosco.

*versione 1.1
Disegna in scala 1:100 (inserisce il blocco albero.dwg) e in scala 1:200 (disegna 3 cerchi di raggio 3, 1.5 e 0.8).
In scala 1:200 il fattore di densità massimo è 4.
Unità di misura del disegno: metro.

*versione 1.2 la scala crea il fenomeno
Questa versione del lisp disegna un insieme di cerchi di raggio 1.5 cioè un bosco in scala 1:1000. L'algoritmo per disegnare gli alberi in modo casuale di Bosc non è adatto perché i cerchi non si devono intersecare, dato che adesso sono simboli e non alberi disegnati in modo figurativo (1:100) o astratto (1:200).
Una prima soluzione è nel classico lisp che disegna un vialetto da giardino tappezzato con piastrelle circolari, lisp presente nel manuale di personalizzazione di Autocad. Ho ritoccato qua e la il codice per adattarlo a Bosc, ho corretto due errori (di stampa) presenti nella versione cartacea e ho inserito la funzione rn(). Il nuovo codice è colorato in blu.

*versione 1.3 una finestra sul bosco
Per aggiungere una finestra di dialogo al nostro lisp si deve creare un file .dcl che contenga la descrizione in linguaggio DCL (Dialog Control Language) della nostra finestra sul bosco.
Come al solito le nuove righe di codice sono in blu.

BOSC.DCL



BOSC.LSP
[1] Bosco disegnato con fattore di densità 3.



BOSC.LSP
Particolare di [1]
Notare che gli alberi con un rapporto di scala inferiore a 0.5 vengono sostituiti da un cerchio.



BOSC.LSP
[2] Bosco disegnato con fattore di densità 10.



BOSC.LSP
[3] Bosco disegnato in scala 1:200 con fattore di densità 4.



BOSC.LSP
[4] Bosco-labirinto disegnato in scala 1:1000 con fattore di densità 3.




// BOSC.DCL
// Riquadro di dialogo del LISP  bosc.lsp
// (C)2004 by Claudio Piccini
// www.cg-cad.com

dcl_settings : default_dcl_settings { audit_level = 1; }

bosc : dialog {
   label = "Bosc 1.3";
   : boxed_radio_row {
      label = "Scala disegno";
      : radio_button {
         label = "1:100";
         key = "s100";
         value= "1";
      }
      : radio_button {
         label = "1:200";
         key = "s200";
      }
      : radio_button {
         label = "1:1000";
         key = "s1000";
      }
   }
   : edit_box {
      label = "Densita' del bosco";
      key = "dN";
      edit_width = 6;
   }
   spacer;
   ok_cancel;
}


;;;
;;;    Bosc.lsp (versione 1.3 - 24 Gennaio 2004)
;;;   
;;;    Copyright (C)2004 by Claudio Piccini.
;;;    http://www.cg-cad.com/
;;;
;;;    Disegna un bosco in scala 1:100,200,1000
;;;

(defun myerror (s)                 
 (if (/= s "Function cancelled")
  (princ (strcat "\nError: " s))
 )
 (ripVar)
 (princ)
)

(defun salVar ()
 (setq orto (getvar "orthomode"))                         
 (setq snapp (getvar "osmode"))
 (setq snm (getvar "snapmode"))
 (setq piano (getvar "clayer")) 
 (setq nomeDir (getvar "dwgprefix"))
)

(defun ripVar ()
 (command "_redraw")
 (setvar "cmdecho" 1)
 (setvar "osmode" snapp)
 (setvar "snapmode" snm)
 (setvar "orthomode" orto)
 (setvar "clayer" piano)
 (setq *error* olderr)
 (princ)
)

(defun defaults ()
 (setq dn 3) ; densita' del bosco
 (setq scala 1)
 (set_tile "dN" (rtos 3 2)) ; rtos ->converte un numero in stringa
 (cond
  ((= scala 1) (set_tile "s100"  "1"))
  ((= scala 2) (set_tile "s200"  "1"))
  ((= scala 3) (set_tile "s1000" "1"))
 )
)

(defun do_dn ()
 (setq dn (atoi (get_tile "dN"))) ; atoi ->converte una stringa in un numero intero
)

;|
  Random number generator, from 0.000 to 0.999
  Grass.lsp (C)1994 by Watson Kilbourne
  http://www.cg-cad.com/ttlisp17.htm
|;
(defun rn ()
 (if (not sd)
  (setq sd (getvar "DATE"))
 )
 (setq md 65536
       mx 25173
       nc 13849
       sd (rem (+ (* mx sd) nc) md)
 )
 (setq nx (/ sd md))
)

; converte angolo da gradi in radianti
(defun g2r (a)
 (* pi (/ a 180.0))
)

(defun drow (pd offset)
 (setq pfirst (polar sp pangle pd))
 (setq pctile (polar pfirst angp90 offset))
 (setq pltile pctile)
 (while (< (distance pfirst pltile) (- dY2 raggio))
  (if (> (rn) 0.5)
   (command "_circle" pltile raggio)
  )
  (setq pltile (polar pltile angp90 (+ dn raggio raggio)))
 )
 (setq pltile (polar pctile angm90 (+ dn raggio raggio)))
 (while (< (distance pfirst pltile) (- dY2 raggio))
  (if (> (rn) 0.5)
   (command "_circle" pltile raggio)
  )
  (setq pltile (polar pltile angm90 (+ dn raggio raggio)))
 )
)

(defun drawtiles ()
 (setq pdist (+ raggio dn))
 (setq off 0.0)
 (while (<= pdist (- plength raggio))
  (drow pdist off)
  (setq pdist
   (+ pdist (* (+ dn raggio raggio) (sin (g2r 60)))))
  (if (= off 0.0)
   (setq off (* (+ dn raggio raggio) (cos (g2r 60))))
   (setq off 0.0)
  )
 )
)

(defun c:bosc (/ ok_c scala p1 p2 dist12 ang dX dY
                 dn sc pE1 pOx pBlc1 pBlc2 
                 olderr snapp piano 
                 orto snm nomeDir
 )

 (setq olderr  *error*  *error* myerror)

 (setvar "cmdecho" 0)

 (salVar)

 (command "osnap" "_non")

 (setq p1 
  (getpoint "\nSeleziona il vertice sinistro in basso")
 )
 (setq p2 
  (getpoint "\nSeleziona il vertice destro in alto")
 )
 (setq dist12 (distance p1 p2))
 (setq ang (angle p1 p2))
 (setq dX (* dist12 (cos ang)))
 (princ "\nLunghezza (proiezione su X): ")
 (princ dX)
 (setq ang (angle p1 p2))
 (setq dY (* dist12 (sin ang)))
 (princ "  Altezza (proiezione su Y): ")
 (princ dY)

 ; se non esiste il layer SIMBOLI lo crea
 (if (not (tblsearch "LAYER" "SIMBOLI"))
  (progn
   (setq regen (getvar "REGENMODE"))
   (setvar "REGENMODE" 0)
   (command "_layer" "_m" "SIMBOLI")
   (command "_c" "2" "SIMBOLI")
   (command "")
   (setvar "REGENMODE" regen)
  )
 )
 ; rende attivo il layer SIMBOLI
 (command "_layer" "_s" "simboli" "")
 (command "_color" "BYLAYER")

 (setq ok_c 1)
 (if (< (setq dcl_id (load_dialog "c:/pick/lisp/bosc.dcl")) 0)(exit))
 (if (not (new_dialog "bosc" dcl_id))(exit))
 (defaults)
 (action_tile "s100"   "(setq scala 1)")
 (action_tile "s200"   "(setq scala 2)")
 (action_tile "s1000"  "(setq scala 3)")
 (action_tile "dN"     "(do_dn)")
 (action_tile "accept" "(done_dialog)")
 (action_tile "cancel" "(setq ok_c 0)")
 (start_dialog)
 (unload_dialog dcl_id)
 (if (= 1 ok_c)
  (progn
   (if (>= dn 3)
    (progn
     (cond 
      ((= scala 1) ; scala 1:100
       (setq pE1 (list (car p2) (cadr p1)))
       (setq pOx p1)
       (while (< (cadr p1) (cadr p2))
        (while (< (car p1) (car pE1))
         (setq pBlc1 (list (+ (car p1) dn) (cadr p1)))
         (setq pBlc2 (polar pBlc1 (* pi (rn)) (* (rn) dn)))
         (setq sc (rn))
         (if (< sc 0.5)
          (command "_circle" pBlc2 0.5)
          (command "_insert" "C:/PICK/LISP/ALBERO" pBlc2 sc sc "")
         )
         (setq p1 pBlc1)
        )
        (setq p1 (list (car pOx) (+ (cadr p1) dn)))
       )
      )
      ((= scala 2) ; scala 1:200
       (setq pE1 (list (car p2) (cadr p1)))
       (setq pOx p1)
       (while (< (cadr p1) (cadr p2))
        (while (< (car p1) (car pE1))
         (setq pBlc1 (list (+ (car p1) dn) (cadr p1)))
         (setq pBlc2 (polar pBlc1 (* pi (rn)) (* (rn) dn)))
         (setq sc (rn))
         (cond 
          ((and (>= sc 0.8)(<= sc 0.9))
           (command "_circle" pBlc2 3.0)
          )
          ((and (>= sc 0.4)(< sc 0.8))
           (command "_circle" pBlc2 1.5)
          )
          ((< sc 0.4)
           (command "_circle" pBlc2 0.8)
          )
         ) 
         (setq p1 pBlc1)
        )
        (setq p1 (list (car pOx) (+ (cadr p1) dn)))
       )
      )
      ((= scala 3) ; scala 1:1000
       (setq dY2 (/ dY 2)) ; mezza larghezza del bosco
       (setq raggio 1.5)   ; raggio del cerchio, simbolo dell'albero
       (setq sp (list (car p1) (+ (cadr p1) dY2)))
       (setq ep (list (car p2) (- (cadr p2) dY2)))
       (setq pangle (angle sp ep))
       (setq plength (distance sp ep))
       (setq angp90 (+ pangle (g2r 90)))
       (setq angm90 (- pangle (g2r 90)))
       (drawtiles)
      )
     )
    )    
    (alert "errore densita' bosco")
   )
   (ripVar)
  )
  (ripVar)
 )
)
;;;eof

;;;
;;;    Bosc.lsp (versione 1.2 - 22 Gennaio 2004)
;;;   
;;;    Copyright (C) 2004 by Claudio Piccini.
;;;    http://www.cg-cad.com/
;;;
;;;    Disegna un bosco in scala 1:100,200,1000
;;;

(defun myerror (s)                 
 (if (/= s "Function cancelled")
  (princ (strcat "\nError: " s))
 )
 (ripVar)
 (princ)
)

(defun salVar ()
 (setq orto (getvar "orthomode"))                         
 (setq snapp (getvar "osmode"))
 (setq snm (getvar "snapmode"))
 (setq piano (getvar "clayer")) 
 (setq nomeDir (getvar "dwgprefix"))
)

(defun ripVar ()
 (command "_redraw")
 (setvar "cmdecho" 1)
 (setvar "osmode" snapp)
 (setvar "snapmode" snm)
 (setvar "orthomode" orto)
 (setvar "clayer" piano)
 (setq *error* olderr)
 (princ)
)

;|
  Random number generator, from 0.000 to 0.999
  Grass.lsp (C)1994 by Watson Kilbourne
  http://www.cg-cad.com/ttlisp17.htm
|;
(defun rn ()
 (if (not sd)
  (setq sd (getvar "DATE"))
 )
 (setq md 65536
       mx 25173
       nc 13849
       sd (rem (+ (* mx sd) nc) md)
 )
 (setq nx (/ sd md))
)

; converte angolo da gradi in radianti
(defun g2r (a)
 (* pi (/ a 180.0))
)

(defun drow (pd offset)
 (setq pfirst (polar sp pangle pd))
 (setq pctile (polar pfirst angp90 offset))
 (setq pltile pctile)
 (while (< (distance pfirst pltile) (- dY2 raggio))
  (if (> (rn) 0.5)
   (command "_circle" pltile raggio)
  )
  (setq pltile (polar pltile angp90 (+ dn raggio raggio)))
 )
 (setq pltile (polar pctile angm90 (+ dn raggio raggio)))
 (while (< (distance pfirst pltile) (- dY2 raggio))
  (if (> (rn) 0.5)
   (command "_circle" pltile raggio)
  )
  (setq pltile (polar pltile angm90 (+ dn raggio raggio)))
 )
)

(defun drawtiles ()
 (setq pdist (+ raggio dn))
 (setq off 0.0)
 (while (<= pdist (- plength raggio))
  (drow pdist off)
  (setq pdist
   (+ pdist (* (+ dn raggio raggio) (sin (g2r 60)))))
  (if (= off 0.0)
   (setq off (* (+ dn raggio raggio) (cos (g2r 60))))
   (setq off 0.0)
  )
 )
)

(defun c:bosc (/ rs p1 p2 dist12 ang dX dY
                 dn sc pE1 pOx pBlc1 pBlc2 
                 olderr snapp piano 
                 orto snm nomeDir
 )

 (setq olderr  *error*  *error* myerror)

 (setvar "cmdecho" 0)

 (salVar)

 (command "osnap" "_non")

 ; se non esiste il layer SIMBOLI lo crea

 (if (not (tblsearch "LAYER" "SIMBOLI"))
  (progn
   (setq regen (getvar "REGENMODE"))
   (setvar "REGENMODE" 0)
   (command "_layer" "_m" "SIMBOLI")
   (command "_c" "2" "SIMBOLI")
   (command "")
   (setvar "REGENMODE" regen)
  )
 )

 ; rende attivo il layer SIMBOLI

 (command "_layer" "_s" "simboli" "")
 (command "_color" "BYLAYER")

 (initget "A a B b C c")
 (setq rs 
  (getkword "\n Scala [A]1:100, [B]1:200, [C]1:1000, : ")
 )
 (cond   
  ((or (= rs "A") (= rs "a") (= rs nil)) ;1:100         
   (setq rs "A")
  )
  ((or (= rs "B") (= rs "b"))  ;1:200
   (setq rs "B")
  )
  ((or (= rs "C") (= rs "c"))  ;1:1000
   (setq rs "C")
  )
 )

 (setq p1 
  (getpoint "\nSeleziona il vertice sinistro in basso")
 )
 (setq p2 
  (getpoint "\nSeleziona il vertice destro in alto")
 )
 (setq dist12 (distance p1 p2))
 (setq ang (angle p1 p2))
 (setq dX (* dist12 (cos ang)))
 (princ "\nLunghezza (proiezione su X): ")
 (princ dX)
 (setq ang (angle p1 p2))
 (setq dY (* dist12 (sin ang)))
 (princ "  Altezza (proiezione su Y): ")
 (princ dY)

 (cond 
  ((= rs "A") ; scala 1:100
   (initget (+ 2 4))
   (setq dn (getint "\nDensita' del bosco [>=3]: "))
   (if (or (< dn 3)(= dn nil) )
    (setq dn 3)
   )
   (setq pE1 (list (car p2) (cadr p1)))
   (setq pOx p1)
   (while (< (cadr p1) (cadr p2))
    (while (< (car p1) (car pE1))
     (setq pBlc1 (list (+ (car p1) dn) (cadr p1)))
     (setq pBlc2 (polar pBlc1 (* pi (rn)) (* (rn) dn)))
     (setq sc (rn))
     (if (< sc 0.5)
      (command "_circle" pBlc2 0.5)
      (command "_insert" "C:/PICK/LISP/ALBERO" pBlc2 sc sc "")
     )
     (setq p1 pBlc1)
    )
    (setq p1 (list (car pOx) (+ (cadr p1) dn)))
   )
  )
  ((= rs "B") ; scala 1:200
   (initget (+ 2 4))
   (setq dn (getint "\nDensita' del bosco [>=4]: "))
   (if (or (< dn 4)(= dn nil))
    (setq dn 4)
   )
   (setq pE1 (list (car p2) (cadr p1)))
   (setq pOx p1)
   (while (< (cadr p1) (cadr p2))
    (while (< (car p1) (car pE1))
     (setq pBlc1 (list (+ (car p1) dn) (cadr p1)))
     (setq pBlc2 (polar pBlc1 (* pi (rn)) (* (rn) dn)))
     (setq sc (rn))
     (cond 
      ((and (>= sc 0.8)(<= sc 0.9))
       (command "_circle" pBlc2 3.0)
      )
      ((and (>= sc 0.4)(< sc 0.8))
       (command "_circle" pBlc2 1.5)
      )
      ((< sc 0.4)
       (command "_circle" pBlc2 0.8)
      )
     ) 
     (setq p1 pBlc1)
    )
    (setq p1 (list (car pOx) (+ (cadr p1) dn)))
   )
  )
  ((= rs "C") ; scala 1:1000
   (initget (+ 2 4))
   (setq dn (getint "\nDensita' del bosco [>=3]: "))
   (if (or (< dn 3)(= dn nil))
    (setq dn 3)
   )
   (setq dY2 (/ dY 2)) ; mezza larghezza del bosco
   (setq raggio 1.5)   ; raggio del cerchio, simbolo dell'albero
   (setq sp (list (car p1) (+ (cadr p1) dY2)))
   (setq ep (list (car p2) (- (cadr p2) dY2)))
   (setq pangle (angle sp ep))
   (setq plength (distance sp ep))
   (setq angp90 (+ pangle (g2r 90)))
   (setq angm90 (- pangle (g2r 90)))
   (drawtiles)
  )
 )
 (ripVar)
)
;;;eof

;;;
;;;    Bosc.lsp (versione 1.1 - 20 Gennaio 2004)
;;;   
;;;    Copyright (C) 2004 by Claudio Piccini.
;;;    http://www.cg-cad.com/
;;;
;;;    Disegna un bosco in scala 1:100 e 1:200
;;;

(defun myerror (s)                 
 (if (/= s "Function cancelled")
  (princ (strcat "\nError: " s))
 )
 (ripVar)
 (princ)
)

(defun salVar ()
 (setq orto (getvar "orthomode"))                         
 (setq snapp (getvar "osmode"))
 (setq snm (getvar "snapmode"))
 (setq piano (getvar "clayer")) 
 (setq nomeDir (getvar "dwgprefix"))
)

(defun ripVar ()
 (command "_redraw")
 (setvar "cmdecho" 1)
 (setvar "osmode" snapp)
 (setvar "snapmode" snm)
 (setvar "orthomode" orto)
 (setvar "clayer" piano)
 (setq *error* olderr)
 (princ)
)

;|
  Random number generator, from 0.000 to 0.999
  Grass.lsp (C)1994 by Watson Kilbourne
  http://www.cg-cad.com/ttlisp17.htm
|;
(defun rn ()
 (if (not sd)
  (setq sd (getvar "DATE"))
 )
 (setq md 65536
       mx 25173
       nc 13849
       sd (rem (+ (* mx sd) nc) md)
 )
 (setq nx (/ sd md))
)


(defun c:bosc (/ rs p1 p2 dist12 ang dX dY
                 dn sc pE1 pOx pBlc1 pBlc2 
                 olderr snapp piano 
                 orto snm nomeDir
 )

 (setq olderr  *error*  *error* myerror)

 (setvar "cmdecho" 0)

 (salVar)

 (command "osnap" "_non")

 ; se non esiste il layer SIMBOLI lo crea

 (if (not (tblsearch "LAYER" "SIMBOLI"))
  (progn
   (setq regen (getvar "REGENMODE"))
   (setvar "REGENMODE" 0)
   (command "_layer" "_m" "SIMBOLI")
   (command "_c" "2" "SIMBOLI")
   (command "")
   (setvar "REGENMODE" regen)
  )
 )

 ; rende attivo il layer SIMBOLI

 (command "_layer" "_s" "simboli" "")
 (command "_color" "BYLAYER")

 (initget "A a B b")
 (setq rs 
  (getkword "\nSeleziona la scala [A]1:100, [B]1:200, <A>: ")
 )
 (cond   
  ((or (= rs "A") (= rs "a") (= rs nil)) ;1:100         
   (setq rs "A")
  )
  ((or (= rs "B") (= rs "b"))  ;1:200
   (setq rs "B")
  )
 )

 ;|
   chiede gli estremi del bosco
   ricava la lunghezza del bosco dX e l'altezza dY
 |;
 
 (setq p1 
  (getpoint "\nSeleziona il vertice sinistro in basso")
 )
 (setq p2 
  (getpoint "\nSeleziona il vertice destro in alto")
 )
 (setq dist12 (distance p1 p2))
 (setq ang (angle p1 p2))
 (setq dX (* dist12 (cos ang)))
 (princ "\nLunghezza (proiezione su X): ")
 (princ dX)
 (setq ang (angle p1 p2))
 (setq dY (* dist12 (sin ang)))
 (princ "  Altezza (proiezione su Y): ")
 (princ dY)

 ;|
   chiede la "densità" del bosco: dn
   dn >= 3
   Più grande è il numero dn 
   minore è la densità del bosco
 |;

 (if (= rs "A") ;scala 1:100
  (progn
   (initget (+ 2 4))
   (setq dn (getint "\nDensita' del bosco [>=3]: "))
   (if (or (< dn 3)(= dn nil) )
    (setq dn 3)
   )
   (setq pE1 (list (car p2) (cadr p1)))
   (setq pOx p1)
   (while (< (cadr p1) (cadr p2))
    (while (< (car p1) (car pE1))
     (setq pBlc1 (list (+ (car p1) dn) (cadr p1)))
     (setq pBlc2 (polar pBlc1 (* pi (rn)) (* (rn) dn)))
     (setq sc (rn))
     (if (< sc 0.5)
      (command "_circle" pBlc2 0.5)
      (command "_insert" "C:/PICK/LISP/ALBERO" pBlc2 sc sc "")
     )
     (setq p1 pBlc1)
    )
    (setq p1 (list (car pOx) (+ (cadr p1) dn)))
   )
  )
  (progn ; scala 1:200
   (initget (+ 2 4))
   (setq dn (getint "\nDensita' del bosco [>=4]: "))
   (if (or (< dn 4)(= dn nil) )
    (setq dn 4)
   )
   (setq pE1 (list (car p2) (cadr p1)))
   (setq pOx p1)
   (while (< (cadr p1) (cadr p2))
    (while (< (car p1) (car pE1))
     (setq pBlc1 (list (+ (car p1) dn) (cadr p1)))
     (setq pBlc2 (polar pBlc1 (* pi (rn)) (* (rn) dn)))
     (setq sc (rn))
     (cond 
      ((and (>= sc 0.8)(<= sc 0.9))
       (command "_circle" pBlc2 3.0)
      )
      ((and (>= sc 0.4)(< sc 0.8))
       (command "_circle" pBlc2 1.5)
      )
      ((< sc 0.4)
       (command "_circle" pBlc2 0.8)
      )
     ) 
     (setq p1 pBlc1)
    )
    (setq p1 (list (car pOx) (+ (cadr p1) dn)))
   )
  )
 )
 (ripVar)
)
;;;eof

;;;
;;;    Bosc.lsp (versione 1.0 - 19 Gennaio 2004)
;;;   
;;;    Copyright (C) 2004 by Claudio Piccini.
;;;    http://www.cg-cad.com/
;;;
;;;    Disegna un bosco
;;;

(defun myerror (s)                 
 (if (/= s "Function cancelled")
  (princ (strcat "\nError: " s))
 )
 (ripVar)
 (princ)
)

(defun salVar ()
 (setq orto (getvar "orthomode"))                         
 (setq snapp (getvar "osmode"))
 (setq snm (getvar "snapmode"))
 (setq piano (getvar "clayer")) 
 (setq nomeDir (getvar "dwgprefix"))
)

(defun ripVar ()
 (command "_redraw")
 (setvar "cmdecho" 1)
 (setvar "osmode" snapp)
 (setvar "snapmode" snm)
 (setvar "orthomode" orto)
 (setvar "clayer" piano)
 (setq *error* olderr)
 (princ)
)

;|
  Random number generator, from 0.000 to 0.999
  Grass.lsp (C)1994 by Watson Kilbourne
  http://www.cg-cad.com/ttlisp17.htm
|;
(defun rn ()
 (if (not sd)
  (setq sd (getvar "DATE"))
 )
 (setq md 65536
       mx 25173
       nc 13849
       sd (rem (+ (* mx sd) nc) md)
 )
 (setq nx (/ sd md))
)


(defun c:bosc (/ p1 p2 dist12 ang dX dY
                 dn sc pE1 pOx pBlc1 pBlc2 
                 olderr snapp piano 
                 orto snm nomeDir
 )

 (setq olderr  *error*  *error* myerror)

 (setvar "cmdecho" 0)

 (salVar)

 (command "osnap" "_non")

 ; se non esiste il layer SIMBOLI lo crea

 (if (not (tblsearch "LAYER" "SIMBOLI"))
  (progn
   (setq regen (getvar "REGENMODE"))
   (setvar "REGENMODE" 0)
   (command "_layer" "_m" "SIMBOLI")
   (command "_c" "2" "SIMBOLI")
   (command "")
   (setvar "REGENMODE" regen)
  )
 )

 ; rende attivo il layer SIMBOLI

 (command "_layer" "_s" "simboli" "")
 (command "_color" "BYLAYER")

 ;|
   chiede gli estremi del bosco
   ricava la lunghezza del bosco dX e l'altezza dY
 |;
 
 (setq p1 
  (getpoint "\nSeleziona il vertice sinistro in basso")
 )
 (setq p2 
  (getpoint "\nSeleziona il vertice destro in alto")
 )
 (setq dist12 (distance p1 p2))
 (setq ang (angle p1 p2))
 (setq dX (* dist12 (cos ang)))
 (princ "\nLunghezza (proiezione su X): ")
 (princ dX)
 (setq ang (angle p1 p2))
 (setq dY (* dist12 (sin ang)))
 (princ "  Altezza (proiezione su Y): ")
 (princ dY)

 ;|
   chiede la "densità" del bosco: dn
   dn >= 3
   Più grande è il numero dn 
   minore è la densità del bosco
 |;

 (initget (+ 2 4))
 (setq dn (getint "\nDensita' del bosco [>=3]: "))
 (if (or (< dn 3)(= dn nil) )
   (setq dn 3)
 )
 (setq pE1 (list (car p2) (cadr p1)))
 (setq pOx p1)
 (while (< (cadr p1) (cadr p2))
  (while (< (car p1) (car pE1))
   (setq pBlc1 (list (+ (car p1) dn) (cadr p1)))
   (setq pBlc2 (polar pBlc1 (* pi (rn)) (* (rn) dn)))
   (setq sc (rn))
   (if (< sc 0.5)
    (command "_circle" pBlc2 0.5)
    (command "_insert" "C:/PICK/LISP/ALBERO" pBlc2 sc sc "")
   )
   (setq p1 pBlc1)
  )
  (setq p1 (list (car pOx) (+ (cadr p1) dn)))
 )
 (ripVar)
)
;;;eof

Lisp »Tips 'n Tricks