Flocon

(gile) · le 25 avril 2007

Dans la série "Ça ne sert à rien du tout mais c'est joli et amusant", après les étoiles "aléatoires" de Constel, voici Flocon : pour s'ammuser avec une fractale simple et la récursivité.

Dans un dessin vierge, charger le LISP, entrer Flocon et faire Entrée, Entrée, Entrée... ou Echap pour sortir.

(defun c:flocon	(/ split fract unfract pl pts loop cnt col gr n)

 (defun split (lst)
   (if	lst
     (cons (list (car lst) (cadr lst))
    (split (cddr lst))
     )
   )
 )

 (defun fract (lst / p1)
   (if	(cadr lst)
     (cons
(car lst)
(cons
  (setq	p1
	 (polar	(car lst)
		(angle (car lst) (cadr lst))
		(/ (distance (car lst) (cadr lst)) 3)
	 )
  )
  (cons
    (polar p1
	   (+ (angle (car lst) p1) (/ pi 3))
	   (distance (car lst) p1)
    )
    (cons
      (polar p1
	     (angle (car lst) (cadr lst))
	     (/ (distance (car lst) (cadr lst)) 3)
      )
      (fract (cdr lst))
    )
  )
)
     )
     (list (car lst))
   )
 )

 (defun unfract (lst)
   (if	(cdr lst)
     (cons (car lst) (unfract (cddddr lst)))
     (list (car lst))
   )
 )

 (setq	space (vla-get-ModelSpace
       (vla-get-ActiveDocument (vlax-get-acad-object))
     )
pl (vlax-Invoke
     space
     'addLightWeightPolyline
     (list 0.0
	   0.0
	   1.0
	   0.0
	   1.5
	   (/ (sqrt 3) 2)
	   1.0
	   (sqrt 3)
	   0.0
	   (sqrt 3)
	   -0.5
	   (/ (sqrt 3) 2)
	   0.0
	   0.0
     )
   )
 )
 (vla-ZoomWindow
   (vlax-get-acad-object)
   (vlax-3d-point '(-2.0 -0.5 0.0))
   (vlax-3d-point '(3.0 2.3 0.0))
 )
 (prompt "\nEntrée pour continuer, Echap pour sortir: ")
 (setq	cnt 0
col 0
 )
 (while (setq gr (grread))
   (if	(= (cadr gr) 13)
     (progn
(setq pts (split (vlax-get pl 'Coordinates)))
(vla-delete pl)
(if (	  (progn
    (setq pl (vlax-Invoke
	       space
	       'addLightWeightPolyline
	       (apply
		 'append
		 (fract pts)
	       )
	     )
    )
    (vla-put-Color pl (setq col (1+ col)))
    (setq cnt (1+ cnt))
  )
  (progn
    (setq pl (vlax-Invoke
	       space
	       'addLightWeightPolyline
	       (apply
		 'append
		 (unfract pts)
	       )
	     )
    )
    (vla-put-Color pl (setq col (1- col)))
    (setq cnt (rem (1+ cnt) 10))
  )
)
     )
   )
 )
 (princ)
)

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

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

Bred · le 25 avril 2007

Super jolie !!!!

un petit défaut : une ligne qui se balade ...

http://images1.hiboox.com/images/1707/zv4oo6iv.jpg

... et une petite amélioration (toujours pour s'amuser... si tu en as envies.... ;) ) : une "tempo" au lieu de valider pour chaque modif ??? ;)

[Edité le 25/4/2007 par Bred]

(gile) · le 25 avril 2007

:casstet: Curieux ce défaut, normalement il n'y a qu'une polyligne, seul le nombre de sommets change.

Chez moi je n'ai jamais eu ça...

bonuscad · le 26 avril 2007

Même résultat que Bred, avec en ligne de commande:

; erreur: une exception s'est produite: 0xC0000005 (Violation d'accès)

; avertissement: fonction unwind ignorée erreur inconnue

(gile) · le 26 avril 2007

Je ne comprends pas, je n'ai pas ce genre d'erreur.

Il est peut être préférable de ne pas maintenir la touche Entrée enfoncée (quoique chez moi ça marche aussi) mais plutôt de cliquer pour chaque transformation.

Une autre, avec deux fois moins de sommets, marchera peut-être mieux.

(defun c:flocon	(/ split fract unfract pl cnt col gr lst)

 (defun split (lst)
   (if	lst
     (cons (list (car lst) (cadr lst))
    (split (cddr lst))
     )
   )
 )

 (defun fract (lst / p1)
   (if	(cadr lst)
     (cons
(car lst)
(cons
  (setq	p1
	 (polar	(car lst)
		(angle (car lst) (cadr lst))
		(/ (distance (car lst) (cadr lst)) 3)
	 )
  )
  (cons
    (polar p1
	   (+ (angle (car lst) p1) (/ pi 3))
	   (distance (car lst) p1)
    )
    (cons
      (polar p1
	     (angle (car lst) (cadr lst))
	     (/ (distance (car lst) (cadr lst)) 3)
      )
      (fract (cdr lst))
    )
  )
)
     )
     (list (car lst))
   )
 )

 (defun unfract (lst)
   (if	(cdr lst)
     (cons (car lst) (unfract (cddddr lst)))
     (list (car lst))
   )
 )

 (setq	pl (vlax-Invoke
     (vla-get-ModelSpace
       (vla-get-ActiveDocument (vlax-get-acad-object))
     )
     'addLightWeightPolyline
     (list 0.0 0.0 0.5 (/ (sqrt 3) 2) 1.0 0.0 0.0 0.0)
   )
 )
 (vla-ZoomWindow
   (vlax-get-acad-object)
   (vlax-3d-point '(-0.5 -0.4 0.0))
   (vlax-3d-point '(1.5 1.0 0.0))
 )
 (vla-put-Color pl (setq col 10))
 (prompt "\nEntrée pour continuer, Echap pour sortir: ")
 (setq cnt 0)
 (while (setq gr (grread))
   (if	(= (cadr gr) 13)
     (if (	(progn
  (and (= cnt 0)
       (setq lst (reverse (split (vlax-get pl 'Coordinates))))
       (vlax-put pl 'Coordinates (apply 'append lst))
  )
  (vlax-put pl
	    'Coordinates
	    (apply 'append (setq lst (fract lst)))
  )
  (vla-put-Color pl (setq col (+ col 10)))
  (setq cnt (1+ cnt))
)
(progn
  (vlax-put pl
	    'Coordinates
	    (apply 'append (setq lst (unfract lst)))
  )
  (vla-put-Color pl (setq col (- col 10)))
  (setq cnt (rem (1+ cnt) 10))
)
     )
   )
 )
 (princ)
)

BIM G CO · le 26 avril 2007

Chez moi çà fonctionne bien avec AutoCAD 2007 avec toutes les mises à jour (excepté le SP2)

LUDWIG · le 26 avril 2007

pas d'erreur pour moi (2008)

Bred · le 26 avril 2007

Alors :

sur 2006 erreur :

Entrée pour continuer, Echap pour sortir: ; erreur: une exception s'est
produite: 0xC0000005 (Violation d'accès)
; avertissement: fonction unwind ignorée erreur inconnue
Commande:

sur 2007 et 2008 : OK

jalna · le 26 avril 2007

Je confirme l'erreur de Bred sur 2006!!

hardyorock · le 26 avril 2007

oui je confireme ca moi aussi

(gile) · le 26 avril 2007

Bien que l'utilité de ces routines soit discutable, je suis quand même très curieux de comprendre ce qui, dans ces codes, pourrait ne pas fonctionner avec les versions antérieures à 2007.

Aussi, si d'aucuns avaient le temps de me décrire à quel moment intervient l'erreur et ce qu'ils ont à l'écran à ce moment là (une ou plusieurs polylignes)

Je joins un petit Fichier ZIP qui contient un .AVI de ce qui devrait se passer avec la deuxième routine.

bonuscad · le 26 avril 2007

A priori il n'a plus de segment mémoire libre, j'ai glissé un (mem) dans ton code et voici le retour

; GC calls: 26; GC run time: 48 ms

Dynamic memory segments statistic:
PgSz Used Free FMCL Segs Type
512 12 115 89 1 lisp stacks
256 965 565 219 6 bytecode area
4096 288 12 12 20 CONS memory
32 793 1190 1163 1 ::new
4096 94 26 8 8 DM Str
4096 198 12 9 14 DMxx memory
128 3 508 508 1 bstack body
Segment size: 65536, total used: 51, free: 3
; GC calls: 26; GC run time: 48 ms

Dynamic memory segments statistic:
PgSz Used Free FMCL Segs Type
512 12 115 89 1 lisp stacks
256 965 565 219 6 bytecode area
4096 288 12 12 20 CONS memory
32 793 1190 1163 1 ::new
4096 94 26 8 8 DM Str
4096 198 12 9 14 DMxx memory
128 3 508 508 1 bstack body
Segment size: 65536, total used: 51, free: 3
; GC calls: 26; GC run time: 48 ms

Dynamic memory segments statistic:
PgSz Used Free FMCL Segs Type
512 12 115 89 1 lisp stacks
256 965 565 219 6 bytecode area
4096 288 12 12 20 CONS memory
32 793 1190 1163 1 ::new
4096 94 26 8 8 DM Str
4096 200 10 7 14 DMxx memory
128 3 508 508 1 bstack body
Segment size: 65536, total used: 51, free: 3
; GC calls: 26; GC run time: 48 ms

Dynamic memory segments statistic:
PgSz Used Free FMCL Segs Type
512 12 115 89 1 lisp stacks
256 965 565 219 6 bytecode area
4096 288 12 12 20 CONS memory
32 793 1190 1163 1 ::new
4096 94 26 8 8 DM Str
4096 206 4 2 14 DMxx memory
128 3 508 508 1 bstack body
Segment size: 65536, total used: 51, free: 3
; GC calls: 26; GC run time: 48 ms

Dynamic memory segments statistic:
PgSz Used Free FMCL Segs Type
512 12 115 89 1 lisp stacks
256 965 565 219 6 bytecode area
4096 288 12 12 20 CONS memory
32 793 1190 1163 1 ::new
4096 94 26 8 8 DM Str
4096 233 7 7 16 DMxx memory
128 3 508 508 1 bstack body
Segment size: 65536, total used: 53, free: 1
; GC calls: 27; GC run time: 64 ms

Dynamic memory segments statistic:
PgSz Used Free FMCL Segs Type
512 6 121 95 1 lisp stacks
256 957 573 219 6 bytecode area
4096 288 12 12 20 CONS memory
32 793 1190 1163 1 ::new
4096 66 54 10 8 DM Str
4096 314 31 11 23 DMxx memory
128 3 508 508 1 bstack body
Segment size: 65536, total used: 60, free: 0
; erreur: une exception s'est produite: 0xC0000005 (Violation d'accès)
; avertissement: fonction unwind ignoréeerreur inconnue

J'avais essayé aussi de faire un (trace) des fonctions, mais là c'est digne d'un écran de MATRIX ;)

Un (gc) glissé aussi dans le code n'a rien résolu :mad:

Bred · le 26 avril 2007

Salut, donc, sous 2006 :

c'est difficile à voir où est l'erreur, mais au bout du 7ème valide, ça bug.

http://xs114.xs.to/xs114/07174/floc.JPG

j'ai éssayé de voir avec la console, mais rien....

[Edité le 26/4/2007 par Bred]

(gile) · le 26 avril 2007

Peut-être faut-il jouer avec les fonctions (alloc ...) et (expand ...) mais je ne comprends pas bien comment elles fonctionent.

Une autre version qui n'utilise pas la récursivité, elle sera peut-être moins gourmande.

(defun c:flocon (/ 2d-coord->pt-lst pl loop cnt col gr n nlst)

 (defun 2d-coord->pt-lst (lst / rslt)
   (while lst
     (setq rslt (cons (list (car lst) (cadr lst) 0.0) rslt)
    lst	 (cddr lst)
     )
   )
   (reverse rslt)
 )

 (defun split (lst / rslt)
   (while lst
     (setq rslt (cons (list (car lst) (cadr lst)) rslt)
    lst	 (cddr lst)
     )
   )
   (reverse rslt)
 )
 
 (setq	pl (vlax-Invoke
     (vla-get-ModelSpace
       (vla-get-ActiveDocument (vlax-get-acad-object))
     )
     'addLightWeightPolyline
     (list 0.0 0.0 0.5 (/ (sqrt 3) 2) 1.0 0.0 0.0 0.0)
   )
 )
 (vla-ZoomWindow
   (vlax-get-acad-object)
   (vlax-3d-point '(-0.5 -0.4 0.0))
   (vlax-3d-point '(1.5 1.0 0.0))
 )
 (vla-put-Color pl (setq col 10))
 (prompt "\nEntrée pour continuer, Echap pour sortir: ")
 (setq	cnt 0
 )
 (while (setq gr (grread))
   (if	(= (cadr gr) 13)
     (if (	(progn
  (and (= cnt 0)
       (setq lst (reverse (split (vlax-get pl 'Coordinates))))
       (vlax-put pl 'Coordinates (apply 'append lst))
  )
  (setq	n   0
	lst '((0.0 0.0 0.0))
  )
  (repeat (fix (vlax-curve-getEndParam pl))
    (setq p0  (vlax-curve-getPointAtParam pl n)
	  lst
	      (append
		lst
		(list
		  (setq
		    p1 (vlax-curve-getPointAtParam pl (+ n (/ 1.0 3)))
		  )
		  (polar p1
			 (+ (angle p0 p1) (/ pi 3))
			 (distance p0 p1)
		  )
		  (vlax-curve-getPointAtParam pl (+ n (/ 2.0 3)))
		  (vlax-curve-getPointAtParam pl (setq n (1+ n)))
		)
	      )
    )
  )
  (vlax-put
    pl
    'Coordinates
    (apply 'append
	   (mapcar '(lambda (x) (list (car x) (cadr x))) lst)
    )
  )
  (vla-put-Color pl (setq col (+ col 10)))
  (setq cnt (1+ cnt))
)
(progn
  (setq	lst  (2d-coord->pt-lst (vlax-get pl 'Coordinates))
	nlst nil
  )
  (while (cdr lst)
    (setq nlst (cons (car lst) nlst)
	  lst  (cddddr lst)
    )
  )
  (setq nlst (cons (car lst) nlst))
  (vlax-put
    pl
    'Coordinates
    (apply 'append
	   (mapcar '(lambda (x) (list (car x) (cadr x)))
		   (reverse nlst)
	   )
    )
  )
  (vla-put-Color pl (setq col (- col 10)))
  (setq cnt (rem (1+ cnt) 10))
)
     )
   )
 )
 (princ)
)

bonuscad · le 26 avril 2007

Ben non, toujours pareil pour moi sous 2000, 2002 ou 2005.

Je pense pas que cela vienne de la récursivité car j'ai essayé les fractals de CHEN QING JUN dont on peut avoir le code sur TheSwamp et elles fonctionnent.

Les fonctions vlax sont capricieuses avec les versions d'Autocad.

Le code que j'ai fais offset_vertex fonctionne sous 2005, mais sous 2002 et 2000 (avec quelque incohérence pour cette dernière) me sort d'Autocad avec un message d'erreur lors de la 2ème utilisation si elle est relancé de suite ?!?!

Je crois qu'il ne faut pas trop chercher, mais l'ennuyeux c'est qu'on ne peut guère pondre un code qui soit compatible sans problème d'une version à l'autre dès qu'on utilise l'activeX.

Vu l'éventail des versions encore utilisées, je dirais que ça facilite pas le partage :mad:

(gile) · le 26 avril 2007

les fractals de CHEN QING JUN dont on peut avoir le code sur TheSwamp et elles fonctionnent.

Et elles sont autement plus belles que mes bidouillages...

...mais ça m'amuse, alors encore une petite variante sur le même thème qui ne dépasse pas les 769 sommets et y va petit à petit (il vautmieux garder le doigt appuyé sur Entrée)

(defun c:flocon	(/ split fract unfract pl cnt col gr lst)

 (defun split (lst)
   (if	lst
     (cons (list (car lst) (cadr lst))
    (split (cddr lst))
     )
   )
 )

 (defun fract (lst / p1)
   (append (cdr lst)
    (cons
      (setq p1
	     (polar (car lst)
		    (angle (car lst) (cadr lst))
		    (/ (distance (car lst) (cadr lst)) 3)
	     )
      )
      (cons
	(polar p1
	       (+ (angle (car lst) p1) (/ pi 3))
	       (distance (car lst) p1)
	)
	(cons
	  (polar p1
		 (angle (car lst) (cadr lst))
		 (/ (distance (car lst) (cadr lst)) 3)
	  )
	  (list (cadr lst))
	)
      )
    )
   )
 )

 (defun unfract (lst)
   (append (cddddr lst) (list (car (cddddr lst))))
 )

 (setq	pl (vlax-Invoke
     (vla-get-ModelSpace
       (vla-get-ActiveDocument (vlax-get-acad-object))
     )
     'addLightWeightPolyline
     (list 0.0 0.0 0.5 (/ (sqrt 3) 2) 1.0 0.0 0.0 0.0)
   )
 )
 (vla-ZoomWindow
   (vlax-get-acad-object)
   (vlax-3d-point '(-0.5 -0.4 0.0))
   (vlax-3d-point '(1.5 1.0 0.0))
 )
 (vla-put-Color pl (setq col 80))
 (prompt "\nEntrée pour continuer, Echap pour sortir: ")
 (setq cnt 0)
 (while (setq gr (grread))
   (if	(= (cadr gr) 13)
     (if (	(progn
  (and (= cnt 0)
       (setq lst (reverse (split (vlax-get pl 'Coordinates))))
       (vlax-put pl 'Coordinates (apply 'append lst))
  )
  (if (equal (car lst) '(0.0 0.0))
    (vla-put-Color pl (setq col (+ col 10)))
  )
  (vlax-put pl
	    'Coordinates
	    (apply 'append (setq lst (fract lst)))
  )
  (setq cnt (1+ cnt))
)
(progn
  (if (equal (car lst) '(0.0 0.0))
    (vla-put-Color pl (setq col (- col 10)))
  )
  (vlax-put pl
	    'Coordinates
	    (apply 'append (setq lst (unfract lst)))
  )
  (setq cnt (rem (1+ cnt) 510))
)
     )
   )
 )
 (princ)
)

bonuscad · le 27 avril 2007

Pour info, j'ai mis le doigt là où ça coince pour les version inférieure à 2007:

c'est la fonction (vlax-put pl 'Coordinates lors du premier appel pour (unfract)

(unfract) retourne bien une liste, mais elle n'est pas accepté par (vlax-put

Je ne peux te dire si la liste est bonne car trop longue (elle est tronquée à l'affichage)

Voilà si ça peux t'aider ...

Connexion

Flocon

Messages recommandés

(gile)

Bred

(gile)

bonuscad

(gile)

BIM G CO

LUDWIG

Bred

jalna

hardyorock

(gile)

bonuscad

Bred

(gile)

bonuscad

(gile)

bonuscad

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante