Graphique Camembert

 

On va pas en faire un fromage !

Dans la série : programmer en s'amusant voici un programme qui va permettre de dessiner un graphique "camembert".Ce type de graphique est utilisé pour représenter le rapport du nombre d'entités dans un cercle rempli représentant quant lui l'ensemble (100 %).Chaque secteur est plus ou moins gros suivant le nombre qu'il représente.

Je ne suis pas l'auteur de ce programme, le coupable, que je dénonce lâchement, est BonusCad, un programmeur assez compétent qui sévit sur pas mal de sites consacrés au sujet qui vous a amené ici.

Au gré de vos pérégrinations il est fort possible que votre souris survole un Schtroumph de ce style et c'est justement BonuCad qui se représente ainsi.

Les entités choisies pour représenter les secteurs angulaires sont des polylignes épaisses et courbes donc très riches en enseignement pour apprendre à gérer ces entités mais ce n'est pas tout car d'autres "combines" sont utilisées et c'est pourquoi j'ai eu envie de déposer ce code sur mon site, j'en avais envie mais j'ai demandé l'autorisation avant, elle m'a été accordée et j'en profite pour renouveler mes remerciements à BonusCad.

Le code est commenté par l'auteur et je pense que ces commentaires sont assez explicites pour que je n'en fasse pas des tonnes, toutefois je suis comme toujours à l'écoute de vos questions par le biais du formulaire de CONTACT.

Voici le code :

;;diagram.lsp
;(diagram '(("VAL1" . 1.0) ("VAL2" . 2.0) ("VAL3" . 3.0) ("VAL4" . 4.0) ("VAL5" . 5.0) ("VAL6" . 6.0) ("VAL7" . 7.0)))
(defun diagram (l / l_car l_cdr p1 p2 p3 ll pt_m px1 px2 key rad inc lst_pt pa1 pa2 ratio pt key bulge p10 p10n bic)
	(setq l_car (mapcar 'car l) l_cdr (mapcar 'cdr l)<br />;scinder la liste soumise en argument en liste d'étiquettes et liste de valeurs<br />	      p1 (polar (getvar "VIEWCTR") 0 (* 0.5 (getvar "VIEWSIZE")))<br />;point du centre de la vue au point à droite à la demidistance de la hauteur graphique de la vue
	      p2 (polar (getvar "VIEWCTR") pi (* 0.5 (getvar "VIEWSIZE")))	;idem pour point à gauche
	      ll (list p1 p2)
	      pt_m (getvar "VIEWCTR")	;point central de la vue courante
	      px1 (polar pt_m (+ (angle p1 p2) (* pi 0.5)) (distance p1 p2))
	      px2 (polar pt_m (- (angle p1 p2) (* pi 0.5)) (distance p1 p2))
	)
	(princ "\nRayon de référence moyen?: ")
	(while (and (setq key (grread T 4 0)) (/= (car key) 3))	;tant que le code retourné par grread n'est pas un clic gauche alors obtention d'un point en dynamique
		(cond
			((eq (car key) 5)	;uniquement si grread retourne le code 5 -> mode déplacement du curseur
				(redraw)	;alors redessinne l'écran
				(setq
					p3 (cadr key)	;récupére les coordonnées dynamique du déplacement
				)
				(setq 
					rad (distance pt_m p3)	;alors rayon est la distance du point central au point dynamique
					inc (angle pt_m p1)	;angle d'origine pour incrementation : mode trigo -> origine à l'Est
					lst_pt '()	;initialisation/réinitialisation de la liste de point à calculer
				)
				(repeat 36	;boucle pour calculer avec une incrementation d'angle 2PI/36 les points afin de simuler un cercle
					(setq
						pa1 (polar pt_m inc rad)
						inc (+ inc (/ (* pi 2.0) 36.0))
						pa2 (polar pt_m inc rad)
						lst_pt (append lst_pt (list pa1 pa2))
					)
				)
				(grvecs lst_pt)	;dessine virtuellement le cercle
			)
		)
	)
	;Le point validé fixe le rayon
	(setq ratio (if (not (zerop (apply '+ l_cdr))) (/ (* 2 pi) (apply '+ l_cdr)) 1) count 0 p10n nil bic 0)	;calcul du ratio: division de 360° par la somme des valeurs soumises à condition que la somme différene de zéro et initialisation des variables
	(initget 9)
	(setq pt (getpoint (getvar "VIEWCTR") "\nPoint d'insertion du camembert: "))	;demande de positionnement du point central du futur camembert.
	(redraw)	;redessine pour effacer le cercle virtuel
	(initget "Valeur Type Deux _Value TYpe TWo")	;standardisation en international pour éventuelle utilisation multilangues, ceci après traduction des messages et adaptation de la première partie initget jusqu'au "_", la variable key retournera toujours la valeur initié par l'underscore, cela évite de modifier le reste du programme pour adapter la variable key si l'on veut adapter à une autre langue.
	(setq key (getkword "\nInscrire les [Deux/Valeur/Type]?: "))
	(cond
		((eq key "TWo") (setq key "TWo"))
		((eq key "TYpe") (setq key "TYpe"))
		(T (setq key "Value"))
	)
;;;Algo principal
	(mapcar
		'(lambda (x y)	;ici le x et y de la fonction anonyme représente chaque valeur itérative retourné par mapcar des listes scindées, donc y=l'étiquette et x=sa valeur correspondante
			(setq bulge (/ (sin (* 0.25 x ratio)) (cos (* 0.25 x ratio))))	;calcul de l'arrondi bulge (1/4 de la arctangente) en tenant compte du ratio des valeurs
			(cond
				((not (zerop x))	;à condition que la valeur ne soit pas zéro
					(if p10n	;p10n (comprendre p10-next) sont les coordonnées calculés en n-1 de p10: au premier passage elle n'existe pas puisque mise à nil précédemment
						(setq p10 p10n)	;si point précédent alors nouveau point de départ=point précédent
						(setq p10 (polar pt (if (not (zerop x)) (* pi 0.5) (* pi 1.5)) (* 0.5 rad)))	;autrement calcul du point de départ original fixé au Nord
					)
					(setq p10n (polar pt (if (not (zerop x)) (+ (* pi 0.5) (* (+ bic (atan bulge)) 4)) (* pi 0.5)) (* 0.5 rad)))	;calcul du point suivant
;;Dessin de l'arc de polyligne correspondant à la valeur X
					(entmake
						(list
							(cons 0 "LWPOLYLINE")
							(cons 100 "AcDbEntity")
							(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))	; suivant si l'utilisateur est en espace papier ou objet
							(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))	;idem
							(cons 8 (getvar "CLAYER"));	création dans le calque courant
							(cons 62 (setq count (1+ count)))	;couleur incrémenté par segment
							(cons 100 "AcDbPolyline")
							(cons 90 2)	;le segment a toujours que deux sommets
							(cons 70 (if (> (length l_cdr) 1) 0 1))	;si qu'une seule valeur dans l_cdr la polyligne sera close: diagramme complet
							(cons 43 rad)
							(cons 38 0.0)
							(cons 39 0.0)
							(cons 10 p10)
							(cons 40 rad)
							(cons 41 rad)
							(cons 42 (if (> (length l_cdr) 1) bulge 1.0))	;si qu'une seule valeur dans l_cdr l'arrondi est entier: demi-cercle
							(cons 91 0)
							(cons 10 p10n)
							(cons 40 rad)
							(cons 41 rad)
							(cons 42 (if (> (length l_cdr) 1) 0.0 1.0))	;si qu'une seule valeur dans l_cdr l'arrondi est entier: demi-cercle restant
							(cons 91 0)
							(cons 210  (trans '(0 0 1) 1 0 T))	;détermine le vecteur d'extrusion du SCU courant pour le SCG 
						)
					)
					(entmake
						(list
							(cons 0 "MTEXT")
							(cons 100 "AcDbEntity")
							(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
							(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
							(cons 8 (getvar "CLAYER"))
							(cons 100 "AcDbMText")
							(cons 10 (polar pt (+ (* pi 0.5) (* 4 bic) (* 2 (atan bulge))) (+ rad (* 0.2 rad))))
							(cons 40 (* 0.25 rad))
							(cons 41 0.0)
							(cons 46 0.0)
							(cons 71
								(if (and (> (+ (* pi 0.5) (* 4 bic) (* 2 (atan bulge))) (* 0.5 pi)) (<= (+ (* pi 0.5) (* 4 bic) (* 2 (atan bulge))) (* 1.5 pi)))
									6
									4
								)
							)
							(cons 72 5)
							(cons 1
								(strcat
									"{\\fArial|b0|i0|c0|p34;"
									(cond
										((eq key "Value") (rtos x 2 2))
										((eq key "TYpe") y)
										((eq key "TWo") (strcat y " " (rtos x 2 0)))
									)
								)
							)
							(cons 7 "Standard")
							(cons 210  (trans '(0 0 1) 1 0 T))
							(list 11 1.0 0.0 0.0)
							(cons 50	;orientation pour que le texte reste orienté entre 0 et PI
								(if (and (> (+ (* pi 0.5) (* 4 bic) (* 2 (atan bulge))) (* 0.5 pi)) (<= (+ (* pi 0.5) (* 4 bic) (* 2 (atan bulge))) (* 1.5 pi)))
									(+ (* pi 1.5) (* 4 bic) (* 2 (atan bulge)))
									(+ (* pi 0.5) (* 4 bic) (* 2 (atan bulge)))
								)
							)
							(cons 73 1)
							(cons 44 1.0)
						)
					)
					(setq bic (+ bic (atan bulge)))	;incrémentation de l'angle pour le segment suivant
				)
			)
			(setq p10 p10n)	;AFFECTATION du point suivant comme point de départ pour continuer le quartier de diagramme suivant
		)
		l_cdr
		l_car
	)
	(prin1)
)

Le lancement du programme demande un argument comme précisé dans la première ligne en commentaire, cet argument est une liste (list).
Dixit l'auteur - toujours - il est possible de "fabriquer" cette liste avec un joli bout de code :

(setq lst_arg 
       ((lambda ( / )
                 (setq js (ssget "_X") l_typ nil)
                 (repeat (setq n (sslength js))
                    (setq ent (ssname js (setq n (1- n))))         
                    (setq typ (cdr (assoc 0 (entget ent))))               
                    (if (not (member typ (mapcar 'car l_typ)))
                      (setq l_typ (cons (cons typ 1) l_typ))               
                      (setq l_typ (subst (cons typ (1+ (cdr (assoc typ 
                       l_typ)))) (assoc typ l_typ) l_typ))
                    )  
               )
         )
      )
  )

Exemple de liste créée : la chaîne (string) est le type d'entité, le nombre entier (integer) en fin de paire pointée est la quantité de cette entité dans le dessin.

(("VIEWPORT" . 2) ("ARC" . 7) ("ELLIPSE" . 26) ("MTEXT" . 121) ("CIRCLE" . 7) ("MULTILEADER" . 24) ("SOLID" . 5) ("TEXT" . 347) ("INSERT" . 313) ("LINE" . 174) ("DIMENSION" . 552) ("LWPOLYLINE" . 437) ("HATCH" . 3))

à vous de "jouer"…

BonusCAD (l'auteur) ayant lu cette page m'a contacté pour apporter le commentaire suivant à propos de le liste en argument :
Elle doit être une liste globale contenant des listes de PAIRES POINTÉE S(dotted pair) (en quantité non limitée) dont le premier élément est OBLIGATOIREMENT une CHAÎNE (string) et le second élément un nombre entier ou un nombre réel (integer / real).
Si cela n'est pas respecté, la fonction va échouer.

Haut de Page

Retour vers Prog-Perso

le 03 mai 2019
mise à jour le 09 mai 2019