Aller au contenu

Bouquet d\'étoiles


(gile)

Messages recommandés

Un petit bouquet pour finir l'année.

 

Charger le LISP dans un dessin vierge et taper bqt...

 

(defun c:bqt (/ star echo n r d pls)

 (defun star (cen br dist col / ind ang n lst1 lst2)
   (setq ind (fix (/ (- br 0.5) 2))
  ang (* (rng) pi)
  n   (* 2 br)
   )
   (repeat br
     (setq
lst1
 (cons
   (polar cen (+ ang (/ (* (setq n (- n 2)) pi) br)) dist)
   lst1
 )
     )
   )
   (repeat br
     (setq lst2
     (cons (inters (nth n lst1)
		   (nth (rem (+ n br (- ind)) br) lst1)
		   (nth (rem (+ n (1- ind)) br) lst1)
		   (nth (setq n (rem (+ n (1- br)) br)) lst1)
	   )
	   lst2
     )
     )
   )
   (entmake
     (append
(list '(0 . "LWPOLYLINE")
      '(100 . "AcDbEntity")
      (cons 62 col)
      '(100 . "AcDbPolyline")
      (cons 90 (* 2 br))
      '(70 . 1)
)
(mapcar
  '(lambda (pt)
     (cons 10 pt)
   )
  (apply 'append
	 (apply 'mapcar (cons 'list (list lst1 lst2)))
  )
)
     )
   )
 )

 (setq echo (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (command "_zoom" "_w" '(0 0) '(1600 1200))
 (setq	pls nil
d   50
 )
 (repeat 5
   (setq n 0
  r 1
   )
   (repeat 81
     (star (polar '(800 600)
	   (* n (/ pi 8))
	   (* n (/ 110 16))
    )
    (fix (+ 7 (* 8 (rng))))
    (* r (+ 4 (* (rng) 10)))
    (fix (+ 1 (* 6 (rng))))
     )
     (setq r	(* r 1.02)
    n	(1+ n)
    pls	(cons (entlast) pls)
     )
     (redraw)
     (command "_.delay" d)
   )
   (setq d (- d 5))
 )
 (mapcar 'entdel pls)
 (command "_.delay" 500)
 (redraw)
 (command "_.delay" 500)
 (repeat 5
   (setq n (fix (+ 1 (* 404 (rng)))))
   (entdel (nth n pls))
   (redraw)
   (command "_.delay" 200)
   (entdel (nth n pls))
   (redraw)
   (command "_.delay" 50)
 )
 (command "_.delay" 50)
 (setq pls (split-list pls 81))
 (repeat 10
   (setq n (fix (+ 1 (* 80 (rng)))))
   (mapcar '(lambda (l) (entdel (nth n l))) pls)
   (redraw)
   (command "_.delay" 300)
   (mapcar '(lambda (l) (entdel (nth n l))) pls)
   (redraw)
   (command "_.delay" 50)
 )
 (setq	n 80
d 100
 )
 (repeat 81
   (mapcar '(lambda (l) (entdel (nth n l))) pls)
   (redraw)
   (command "_.delay" d)
   (setq n (1- n)
  d (1- d)
   )
 )
 (setq n 0)
 (repeat 4
   (mapcar 'entdel (nth n pls))
   (redraw)
   (command "_.delay" 300)
   (setq n (1+ n))
   (mapcar '(lambda (l) (mapcar 'entdel l)) pls)
   (redraw)
   (command "_.delay" 300)
   (mapcar '(lambda (l) (mapcar 'entdel l)) pls)
   (redraw)
   (command "_.delay" 300)
 )
 (mapcar 'entdel (nth n pls))
 (redraw)
 (command "_.delay" 300)
 (mapcar '(lambda (l) (mapcar 'entdel l)) pls)
 (redraw)
 (command "_.delay" 300)
 (setq	n 0
d 100
 )
 (repeat 3
   (repeat 5
     (mapcar 'entdel (nth n pls))
     (redraw)
     (command "_.delay" 100)
     (setq n (1+ n))
   )
   (repeat 5
     (setq n (1- n))
     (mapcar 'entdel (nth n pls))
     (redraw)
     (command "_.delay" 100)
   )
   (command "_.delay" 100)
 )
 (command "_.delay" 200)
 (setq	n 0
d 100
 )
 (repeat 81
   (mapcar '(lambda (l) (entdel (nth n l))) pls)
   (redraw)
   (command "_.delay" d)
   (setq n (1+ n)
  d (1- d)
   )
 )
 (command "_.delay" 500)
 (setq	n 0
d 500
 )
 (repeat 5
   (mapcar 'entdel (nth n pls))
   (redraw)
   (command "_.delay" d)
   (setq n (1+ n)
  d (- d 100)
   )
 )
 (setvar "cmdecho" echo)
 (princ)
)


;;; SUBLIST Retourne une sous-liste
;;;
;;; Arguments
;;; lst : une liste
;;; start : l'index de départ de la sous liste (premier élément = 0)
;;; leng : la longueur (nombre d'éléments) de la sous-liste (ou nil)
;;;
;;; Exemples :
;;; (sublist '(1 2 3 4 5 6) 2 2) -> (3 4)
;;; (sublist '(1 2 3 4 5 6) 2 nil) -> (3 4 5 6)

(defun sublist (lst start leng / n r)
 (if (or (not leng) (    (setq leng (- (length lst) start))
 )
 (setq n (+ start leng))
 (repeat leng
   (setq r (cons (nth (setq n (1- n)) lst) r))
 )
)

;; SPLIT-LIST Retourne une liste de sous-listes
;; Arguments
;; - lst : la liste à fractionner
;; - num : un entier, le nombre d'éléments des sous listes
;; Exemples :
;; (split-list '(1 2 3 4 5 6 7 8) 2) -> ((1 2) (3 4) (5 6) (7 8))
;; (split-list '(1 2 3 4 5 6 7 8) 3) -> ((1 2 3) (4 5 6) (7 8))

(defun split-list (lst n)
 (if lst
   (cons (sublist lst 0 n)
  (split-list (sublist lst n nil) n)
   )
 )
)

;;; Retourne un nombre "pseudo-aléatoire" entre 0 et 1
(defun rng (/ modulus multiplier increment random)
 (or *seed* (setq *seed* (getvar "DATE")))
 (setq	modulus	   4294967296.0
multiplier 1664525
increment  1
*seed*	   (rem (+ (* multiplier *seed*) increment) modulus)
random	   (/ *seed* modulus)
 )
) 

[Edité le 25/12/2007 par (gile)]

 

[Edité le 26/12/2007 par (gile)]

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Lien vers le commentaire
Partager sur d’autres sites

coucou

 

loin de moi l'idée de me sentir aussi "étoilé"

que l'ami (Gile),

mais je me suis permis de remettre en téléchargement

la blagounette que j'avais fait pour 2003,

 

je sais bien que c'est du réchauffé, mais

de tous ceux qui animent le site aujourd'hui,

peu étaient là fin 2002.

 

je l'ai déposé dans :

les ressources > Telechargements membres > AutoCad > VBA.

 

pour les néophites,

copier le fichier sur le disque

lancer AutoCad

Menu : Outils > Macros VBA > Charger Projet

chercher le fichier téléchargé

ensuite : Ctrl+F8, surligner le fichier et Exécuter.

 

très amicalement

 

 

Lien vers le commentaire
Partager sur d’autres sites

Re,

 

les ressources > Telechargements membres > AutoCad > VBA.

 

didier, je suis allez faire un tour et je n'ai vu que 2 articles, mais pas le tien ?!

 

Ou bien me suis-je trompé d'adresse ?

 

En fait, je viens de le trouver dans le dossier "gratuiciel", je regarde ça de suite alors !

 

[Edité le 26/12/2007 par lili2006]

Civil 3D 2024 - COVADIS_18.2

https://www.linkedin...3%ABt-95313341/

Lien vers le commentaire
Partager sur d’autres sites

coucou

 

Effectivement, j'ai tapé par erreur Ctrl+F8

il faut bien sûr utiliser la combinaison[surligneur] Alt+F8 [/surligneur]

 

tu l'as testé ?

ça fonctionne ?

 

c'est une vue de l'esprit, on est d'accord ?

 

par contre je veux bien mettre un lien vers le téléchargement,

mais je ne l'ai pas trouvé sur le site...

 

je l'ai déposé à l'endroit cité dans le message précédent

ensuite, c'est Patrick qui décide...

 

amicalement

Lien vers le commentaire
Partager sur d’autres sites

coucou

 

Il eût fallu que je soit équipé d'une WebCam

pour que vous aperçussiez :

 

un : que je suis mal rasé

deux : que je suis rouge de confusion

 

en effet j'ai retourné vite fait le prog pour le mettre à jour pour 2008

et voilà que j'oublie les cases de dialogue...

 

le pôv garçon,

il a vraiment le cerveau pourri par ses clopes sans filtre

et son Jack Daniel's quotidien.

 

c'est bien vrai que ça fait pas pipi loin (hihihihi)

 

je vous présente mes excuses

 

amicalement

 

Lien vers le commentaire
Partager sur d’autres sites

coucou

 

Il eût fallu que je soit équipé d'une WebCam

pour que vous aperçussiez :

 

un : que je suis mal rasé

deux : que je suis rouge de confusion

 

en effet j'ai retourné vite fait le prog pour le mettre à jour pour 2008

et voilà que j'oublie les cases de dialogue...

 

le pôv garçon,

il a vraiment le cerveau pourri par ses clopes sans filtre

et son Jack Daniel's quotidien.

 

c'est bien vrai que ça fait pas pipi loin (hihihihi)

 

je vous présente mes excuses

 

amicalement

 

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité