Aller au contenu

Diagramme ou "camembert"


bonuscad

Messages recommandés

Bonjour,

Bien qu'Autocad ne soit pas destiné à cela. Il peut être utile de faire une représentation de données sous forme de diagramme.J'ai pondu une fonction, je dis bien une fonction pas une commande, c'est à dire qu'elle attend des arguments.Ici les arguments devront être des paires pointés ("chaine" valeur-numérique)

Un exemple d'appel(diagram '(("VAL1" . 1.0) ("VAL2" . 2.0) ("VAL3" . 3.0) ("VAL4" . 4.0) ("VAL5" . 5.0) ("VAL6" . 6.0) ("VAL7" . 7.0)))

Je vous livre la fonction

(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)
p1 (polar (getvar "VIEWCTR") 0 (* 0.5 (getvar "VIEWSIZE")))
p2 (polar (getvar "VIEWCTR") pi (* 0.5 (getvar "VIEWSIZE")))
p3 (polar (getvar "VIEWCTR") (* 2 pi) (* 0.5 (getvar "VIEWSIZE")))
ll (list p1 p2)
pt_m (getvar "VIEWCTR")
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))
(cond
 	((eq (car key) 5)
   	(redraw)
   	(setq
     	p3 (cadr key)
   	)
   	(cond
     	(pt_m
       	(setq 
         	rad (distance pt_m p3)
         	inc (angle pt_m p1)
         	lst_pt '()
       	)
       	(repeat 36
         	(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)
     	)
   	)
 	)
)
 )
 (setq rad (if rad rad 0.0) ratio (/ (* 2 pi) (apply '+ l_cdr)) count 0 p10n nil bic 0)
 (initget 9)
 (setq pt (getpoint (getvar "VIEWCTR") "\nPoint d'insertion du camembert: "))
 (redraw)
 (initget "Valeur Type Deux _Value TYpe TWo")
 (setq key (getkword "\nInscrire les [Deux/Valeur/Type]?<V>: "))
 (cond
((eq key "TWo") (setq key "TWo"))
((eq key "TYpe") (setq key "TYpe"))
(T (setq key "Value"))
 )
 (mapcar
'(lambda (x y)
 	(setq bulge (/ (sin (* 0.25 x ratio)) (cos (* 0.25 x ratio))))
 	(cond
   	(rad
     	(if p10n
       	(setq p10 p10n)
       	(setq p10 (polar pt (if (not (zerop x)) (* pi 0.5) (* pi 1.5)) (* 0.5 rad)))
     	)
     	(setq p10n (polar pt (if (not (zerop x)) (+ (* pi 0.5) (* (+ bic (atan bulge)) 4)) (* pi 0.5)) (* 0.5 rad)))
     	(entmake
       	(list
         	(cons 0 "LWPOLYLINE")
         	(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 62 (setq count (1+ count)))
         	(cons 100 "AcDbPolyline")
         	(cons 90 2)
         	(cons 70 (if (not (zerop x)) 0 1))
         	(cons 43 rad)
         	(cons 38 0.0)
         	(cons 39 0.0)
         	(cons 10 p10)
         	(cons 40 rad)
         	(cons 41 rad)
         	(cons 42 (if (not (zerop x)) bulge 1.0))
         	(cons 91 0)
         	(cons 10 p10n)
         	(cons 40 rad)
         	(cons 41 rad)
         	(cons 42 (if (not (zerop x)) 0.0 1.0))
         	(cons 91 0)
         	(cons 210  (trans '(0 0 1) 1 0 T))
       	)
     	)
     	(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
           	(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)))
   	)
 	)
 	(setq p10 p10n)
)
l_cdr
l_car
 )
 (prin1)
)

Pour faire un diagramme des type d'entités contenu dans votre dessin, on peut par exemple faire (copier-coller en ligne de commande ce qui suit)

(diagram
((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))
		)
	)
))
)

Ou encore pour avoir le nombre d'entités par calque:Remplacer (assoc 0 ci-dessus par (assoc 8

 

Cela peut être très bien être des valeur stockées dans des blocs, des xdata, des données d'objet etc... du moment que la liste d'argument est correcte.

Bon "camembert"! tongue.gif

 

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Lien vers le commentaire
Partager sur d’autres sites

Coucou

 

Je n'ai pas le temps de lire mais je le ferai rapidement

Par contre je te le dis tout de suite : j'adore

 

Pour mon site je suis en train de préparer des exemples basés sur des "jeux" comme ça ça parle à tout le monde

C'est que je souhaitais lorsque j'ai demandé à Patrick la création de ce forum particulier.

 

Amicalement

 

Lien vers le commentaire
Partager sur d’autres sites

Excellent ! ! !

 

J'ai repris un lisp de Maître (gile) pour calculer les linéaires des calques, mais ce clacosse promet d'autres ouvertures... :)

 

J'adore aussi...

 

J'ai hâte de voir les jeux sur le site de Maître didier (oui, on mérite ce tire à ce niveau...) ;)

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

Lien vers le commentaire
Partager sur d’autres sites

Coucou

 

Deux choses :

Je réitère, je plussoie, mes félicitations à Bonuscad, j'ai pris le temps de lire et ça mérite l'admiration

Je te remercie DenisHEN, sans fausse humilité je ne sais pas si je mérite ce titre.

Pour ce qui est de la diffusion de mon exercice je ne pense pas qu'il y aura trop d'attente, je préviendrai ici.

 

Amicalement

 

Lien vers le commentaire
Partager sur d’autres sites

Que d'éloges....

Je ne peux que vous remercier !

Mais au final c'est comparable à un anneau (_donut) qui serait fragmenté en plusieurs segments d'arc indépendants à cause des couleur à appliquer aux segments.

Pas de quoi faire un fromage ! laugh.gif

 

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

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é