Barycentre ou Centre de gravité

[lecrabe]

 

Hello

 

Voici mon problème :

 

La routine en Lisp et/ou VLisp doit pouvoir tourner sur tout AutoCAD version 2002-2008

 

Je désire à partir d'une sélection de N objets de type TEXT ou MTEXT ou à la rigueur un BLOC avec au moins UN attribut (dans ce cas, on donne le nom du bloc et de l'attribut concerné) :

 

La sélection se fera :

SOIT par le mode classique "Choix des objets" : clic sur objet, fenêtre, CP, etc

SOIT en désignant une polyligne 2D close déja dessinée

 

- Récupérer la valeur numérique V de texte ou attribut (sur le début du contenu en fait)

Car le contenu peut être par exemple "10.25 kg" / "0.75m"

Stocker aussi les coordonnées XY d'Insertion des TEXT/MTEXT ou point d'insertion du Bloc

 

1) Afficher le nombre total S d'objet sélectionnés, le nombre total N d'objet traités (TEXT, MTEXT, BLOC) et le total T des N valeurs numériques traitées

 

2) Dessin du texte total T au barycentre XB,YB des textes traités par la formule :

XB Barycentre = somme (V * X) / T

YB Barycentre = somme (V * Y) / T

 

Est ce bien la formule pour retrouver le barycentre des N valeurs numériques pondérés par la valeur en question ?

 

3) Cerise sur le gateau: dessin d'un cercle de rayon R autour de TOUS les objets sélectionnés mais non traités car ce n'est pas un TEXT, MTEXT, ou Bloc avec le fameux attribut

 

J'espère que mon cahier des charges est compréhensible ?

 

Le Decapode

 

 

 

[(gile)]

Salut,

 

Un premier jet qui ne fonctionne qu'avec les textes ou mtextes.

 

;;; SelByObj -Gilles Chanteau- 06/10/06
;;; Crée un jeu de sélection avec tous les objets contenus ou  capturés,
;;; dans la vue courante, par un objet (cercle, ellipse, polyligne fermée)
;;; Arguments :
;;; - ent : un objet (ename ou vla-object) 
;;; - opt : un mode de sélection (Cp ou Wp)
;;; - fltr : un filtre de sélection (liste) ou nil
;;;
;;; modifié le 26/07/07 : fonctionne avec les objets hors fenêtre

(defun SelByObj	(ent opt fltr / obj dist n lst prec dist p_lst ss)
 (vl-load-com)
 (or *acad* (setq *acad* (vlax-get-acad-object)))
 (if (= (type ent) 'ENAME)
   (setq obj (vlax-ename->vla-object ent))
   (setq obj ent
  ent (vlax-vla-object->ename ent)
   )
 )
 (cond
   ((member (vla-get-ObjectName obj)
     '("AcDbCircle" "AcDbEllipse")
    )
    (setq dist	(/ (vlax-curve-getDistAtParam
	     obj
	     (vlax-curve-getEndParam obj)
	   )
	   50
	)
   n	0
    )
    (repeat 50
      (setq
 lst
  (cons
    (trans
      (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
      0
      1
    )
    lst
  )
      )
    )
   )
   ((and (= (vla-get-ObjectName obj) "AcDbPolyline")
  (= (vla-get-Closed obj) :vlax-true)
    )
    (setq p_lst (vl-remove-if-not
	   (function
	     (lambda (x)
	       (or (= (car x) 10)
		   (= (car x) 42)
	       )
	     )
	   )
	   (entget ent)
	 )
    )
    (while p_lst
      (setq
 lst
  (cons
    (trans (append (cdr (assoc 10 p_lst))
		   (list (cdr (assoc 38 (entget ent))))
	   )
	   ent
	   1
    )
    lst
  )
      )
      (if (/= 0 (cdadr p_lst))
 (progn
   (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst))))))
	 dist (/ (- (if	(cdaddr p_lst)
		      (vlax-curve-getDistAtPoint
			obj
			(trans (cdaddr p_lst) ent 0)
		      )
		      (vlax-curve-getDistAtParam
			obj
			(vlax-curve-getEndParam obj)
		      )
		    )
		    (vlax-curve-getDistAtPoint
		      obj
		      (trans (cdar p_lst) ent 0)
		    )
		 )
		 prec
	      )
	 n    0
   )
   (repeat (1- prec)
     (setq
       lst (cons
	     (trans
	       (vlax-curve-getPointAtDist
		 obj
		 (+ (vlax-curve-getDistAtPoint
		      obj
		      (trans (cdar p_lst) ent 0)
		    )
		    (* dist (setq n (1+ n)))
		 )
	       )
	       0
	       1
	     )
	     lst
	   )
     )
   )
 )
      )
      (setq p_lst (cddr p_lst))
    )
   )
 )
 (cond
   (lst
    (vla-ZoomExtents *acad*)
    (setq ss (ssget (strcat "_" opt) lst fltr))
    (vla-ZoomPrevious *acad*)
    ss
   )
 )
)

;;; BARYCENTRE Calcule le barycentre de points pondérés contenus dans une liste d'association
;;; ex : (BARYCENTRE '(((10.0 10.0 0.0) . 1.0) ((20.0 30.0 10.0) . 3.0))) -> ((17.5 25.0 7.5) . 4.0)

(defun barycentre (lst)
 (if (cdr lst)
   (barycentre
     (cons
(cons
  (mapcar '+
	  (caar lst)
	  (mapcar
	    (function
	      (lambda (x)
		(* x (/ (cdadr lst) (+ (cdar lst) (cdadr lst))))
	      )
	    )
	    (mapcar '- (caadr lst) (caar lst))
	  )
  )
  (+ (cdar lst) (cdadr lst))
)
(cddr lst)
     )
   )
   (car lst)
 )
)

;; Fonction principale

(defun c:cg-txt	(/ txt2num key ss pl n num lst1 lst2 bar rad)

 (defun txt2num (str / lst)
   (setq lst (vl-string->list str)
  num ""
   )
   (if	(      (while (or (	(setq num (strcat num (chr (car lst)))
      lst (cdr lst)
)
     )
   )
   (if	(/= num "")
     (atof num)
   )
 )

 (initget "Polyligne")
 (setq	key (getkword
      "\nChoisissez l'option [Polyligne] ou : "
    )
 )
 (if (= key "Polyligne")
   (progn
     (while (not (and
	    (setq pl (car (entsel)))
	    (= (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
	  )
     )
     )
     (setq ss (SelByObj pl "WP" '((0 . "TEXT,MTEXT"))))
   )
   (setq ss (ssget '((0 . "TEXT,MTEXT"))))
 )
 (if ss
   (progn
     (repeat (setq n (sslength ss))
(setq elst (entget (ssname ss (setq n (1- n)))))
(if (setq num (txt2num (cdr (assoc 1 elst))))
  (setq lst1 (cons (cons (cdr (assoc 10 elst)) num) lst1))
  (setq lst2 (cons (cdr (assoc 10 elst)) lst2))
)
     )
     (if lst2
(progn
  (while (not (setq rad (getdist "\nRayon: "))))
  (mapcar
    (function
      (lambda (x)
	(entmake
	  (list
	    '(0 . "CIRCLE")
	    (cons 10 x)
	    (cons 40 rad)
	  )
	)
      )
    )
    lst2
  )
)
     )
     (if lst1
(progn
  (setq bar (barycentre lst1))
  (entmake
    (list
      '(0 . "TEXT")
      (cons 10 (car bar))
      (cons 40 (getvar "TEXTSIZE"))
      (cons 7 (getvar "TEXTSTYLE"))
      (cons 1 (setq tot (rtos (cdr bar))))
    )
  )
)
(setq tot 0)
     )
     (princ (strcat "\n\t"
	     (itoa (sslength ss))
	     " textes sélectionnés\t"
	     (itoa (length lst1))
	     " traités\t total = "
	     tot
     )
     )
   )
   (princ "\nAucun texte sélectionné.")
 )
 (princ)
)

 

[Edité le 7/2/2008 par (gile)]

[lecrabe]

 

Hello Gilles

 

Sur AutoCAD 2004 ou 2008, j'ai l'erreur :

(Juste après le RETURN)

; erreur: groupe DXF incorrect: (10 (508.403 603.164 0.0) . 63.0)

 

Apres avoir sélectionné qq TEXTEs simples ! :o

 

Le Decapode

 

[(gile)]

Il y avait une erreur dans la fonction barycentre du code ci-dessus, elle est réparée, il faut donc recharger le nouveau code ou encore tester directement la nouvelle version.

 

Cette version propose d'abord de choisir entre traiter un les références d'un Bloc, les Textes (et/ou mtetxtes) ou lesDeux (entrer B, T ou D).

Cette version utilise une autre version de la routine barycentre (non récursive).

 

;;; SelByObj -Gilles Chanteau- 06/10/06
;;; Crée un jeu de sélection avec tous les objets contenus ou  capturés,
;;; dans la vue courante, par un objet (cercle, ellipse, polyligne fermée)
;;; Arguments :
;;; - ent : un objet (ename ou vla-object) 
;;; - opt : un mode de sélection (Cp ou Wp)
;;; - fltr : un filtre de sélection (liste) ou nil
;;;
;;; modifié le 26/07/07 : fonctionne avec les objets hors fenêtre

(defun SelByObj	(ent opt fltr / obj dist n lst prec dist p_lst ss)
 (vl-load-com)
 (or *acad* (setq *acad* (vlax-get-acad-object)))
 (if (= (type ent) 'ENAME)
   (setq obj (vlax-ename->vla-object ent))
   (setq obj ent
  ent (vlax-vla-object->ename ent)
   )
 )
 (cond
   ((member (vla-get-ObjectName obj)
     '("AcDbCircle" "AcDbEllipse")
    )
    (setq dist	(/ (vlax-curve-getDistAtParam
	     obj
	     (vlax-curve-getEndParam obj)
	   )
	   50
	)
   n	0
    )
    (repeat 50
      (setq
 lst
  (cons
    (trans
      (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
      0
      1
    )
    lst
  )
      )
    )
   )
   ((and (= (vla-get-ObjectName obj) "AcDbPolyline")
  (= (vla-get-Closed obj) :vlax-true)
    )
    (setq p_lst (vl-remove-if-not
	   (function
	     (lambda (x)
	       (or (= (car x) 10)
		   (= (car x) 42)
	       )
	     )
	   )
	   (entget ent)
	 )
    )
    (while p_lst
      (setq
 lst
  (cons
    (trans (append (cdr (assoc 10 p_lst))
		   (list (cdr (assoc 38 (entget ent))))
	   )
	   ent
	   1
    )
    lst
  )
      )
      (if (/= 0 (cdadr p_lst))
 (progn
   (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst))))))
	 dist (/ (- (if	(cdaddr p_lst)
		      (vlax-curve-getDistAtPoint
			obj
			(trans (cdaddr p_lst) ent 0)
		      )
		      (vlax-curve-getDistAtParam
			obj
			(vlax-curve-getEndParam obj)
		      )
		    )
		    (vlax-curve-getDistAtPoint
		      obj
		      (trans (cdar p_lst) ent 0)
		    )
		 )
		 prec
	      )
	 n    0
   )
   (repeat (1- prec)
     (setq
       lst (cons
	     (trans
	       (vlax-curve-getPointAtDist
		 obj
		 (+ (vlax-curve-getDistAtPoint
		      obj
		      (trans (cdar p_lst) ent 0)
		    )
		    (* dist (setq n (1+ n)))
		 )
	       )
	       0
	       1
	     )
	     lst
	   )
     )
   )
 )
      )
      (setq p_lst (cddr p_lst))
    )
   )
 )
 (cond
   (lst
    (vla-ZoomExtents *acad*)
    (setq ss (ssget (strcat "_" opt) lst fltr))
    (vla-ZoomPrevious *acad*)
    ss
   )
 )
)

;; BARYCENTRE
;; Calcule le barycentre de points pondérés contenus dans une liste de paire pointées
;;
;; Argument
;; lst : une liste dont chaque élément est une paire pointée du type (point . poids)
;; ex : (BARYCENTRE '(((10 10 0) . 1.0) ((20 30 10) . 3.0))) -> ((17.5 25.0 7.5) . 4.0)

(defun barycentre (lst)
 ((lambda (s)
    (cons
      (mapcar
 (function (lambda (v) (/ v s)))
 (apply
   'mapcar
   (cons '+
	 (mapcar
	   (function
	     (lambda (p)
	       (mapcar (function (lambda (x) (* x (cdr p)))) (car p))
	     )
	   )
	   lst
	 )
   )
 )
      )
      s
    )
  )
   (apply '+ (mapcar 'cdr lst))
 )
)

;; Fonction principale

(defun c:cg-txt	(/ txt2num opt nom tag fltr key ss pl n elst alst att num lst1 lst2 bar rad)

 (defun txt2num (str / lst)
   (setq lst (vl-string->list str)
  num ""
   )
   (if	(      (while (or (	(setq num (strcat num (chr (car lst)))
      lst (cdr lst)
)
     )
   )
   (if	(/= num "")
     (atof num)
   )
 )

 (initget 1 "Bloc Textes lesDeux")
 (setq opt (getkword "\nSpécifiez le type d'objet [bloc/Textes/lesDeux]: "))
 (if (/= opt "Textes")
   (while (not
     (and (setq nom (getstring T "\nNom du bloc: "))
	  (tblsearch "BLOCK" nom)
	  (setq tag (strcase (getstring "\nEtiquette de l'attribut: ")))
     )
   )
   )
 )
 (cond
   ((= opt "Bloc")
    (setq fltr (list '(0 . "INSERT") (cons 2 nom)))
   )
   ((= opt "Textes") (setq fltr '((0 . "TEXT,MTEXT"))))
   (T
    (setq fltr	(list '(-4 . "[b]		      '(0 . "TEXT,MTEXT")
	      '(-4 . "[b]		      '(0 . "INSERT")
	      (cons 2 nom)
	      '(-4 . "AND>")
	      '(-4 . "OR>")
	)
    )
   )
 )
 (initget "Polyligne")
 (setq	key (getkword
      "\nChoisissez l'option [Polyligne] ou [b]: "
    )
 )
 (if (= key "Polyligne")
   (progn
     (while (not (and
	    (setq pl (car (entsel)))
	    (= (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
	  )
     )
     )
     (setq ss (SelByObj pl "WP" fltr))
   )
   (setq ss (ssget fltr))
 )
 (if ss
   (progn
     (repeat (setq n (sslength ss))
(setq ent  (ssname ss (setq n (1- n)))
      elst (entget ent)
)
(if (= (cdr (assoc 0 elst)) "INSERT")
  (progn
    (setq att (entnext ent))
    (while (= (cdr (assoc 0 (setq alst (entget att)))) "ATTRIB")
      (if (= (cdr (assoc 2 alst)) tag)
	(if (setq num (txt2num (cdr (assoc 1 alst))))
	  (setq lst1 (cons (cons (cdr (assoc 10 elst)) num) lst1))
	  (setq lst2 (cons (cdr (assoc 10 elst)) lst2))
	)
      )
      (setq att (entnext att))
    )
  )
  (if (setq num (txt2num (cdr (assoc 1 elst))))
    (setq lst1 (cons (cons (cdr (assoc 10 elst)) num) lst1))
    (setq lst2 (cons (cdr (assoc 10 elst)) lst2))
  )
)
     )
     (if lst2
(progn
  (while (not (setq rad (getdist "\nRayon: "))))
  (mapcar
    (function
      (lambda (x)
	(entmake
	  (list
	    '(0 . "CIRCLE")
	    (cons 10 x)
	    (cons 40 rad)
	  )
	)
      )
    )
    lst2
  )
)
     )
     (if lst1
(progn
  (setq bar (barycentre lst1))
  (entmake
    (list
      '(0 . "TEXT")
      (cons 10 (car bar))
      (cons 40 (getvar "TEXTSIZE"))
      (cons 7 (getvar "TEXTSTYLE"))
      (cons 1 (setq tot (rtos (cdr bar))))
    )
  )
)
(setq tot "0")
     )
     (princ (strcat "\n\t"
	     (itoa (sslength ss))
	     " textes sélectionnés\t"
	     (itoa (length lst1))
	     " traités\t total = "
	     tot
     )
     )
   )
   (princ "\nAucun texte sélectionné.")
 )
 (princ)
) 

 

[Edité le 7/2/2008 par (gile)]

[lecrabe]

 

Hello

 

J'ai une autre erreur au chargement :

 

Commande: ; erreur: cdrs supplémentaire dans la paire pointée en entrée

 

J'ai peut etre loupé le copier/coller dans le NOTEPAD !

 

SVP peux tu m'envoyer TON Lisp sur mon adresse courriel

 

cadxp at hotmail.fr

 

Merci d'avance, Le Decapode

 

[(gile)]

J'avais encore une fois oublié de traficoter les "

 

Le code ci-dessus est corrigé, je te l'envoie aussi par courriel.

 

[Edité le 7/2/2008 par (gile)]

[lecrabe]

 

Hello Gilles

 

La routine est OK d'un point de vue syntaxique

Et elle me semble satisfaisante - c SUPER !!! :) :D :cool:

 

J'ai une petite question :

Suis je au barycentre ou au centre de gravité pondéré des N textes ?

 

Merci beaucoup, Le Decapode

 

[(gile)]

Dans ce cas là c'est la même chose, la première routine "barycentre" est issue d'un LISP que j'avais fait pour placer un point au centre d'une structure (ou de sa section) composée de différents élément pouvant avoir des densités différentes (ici

[Patrick_35]

Salut

 

On dirait que le crabinou se fait sa propre bibliothèque de lisps ;)

 

Le Patrick "d'humeur taquine"

 

@+

[lecrabe]

 

Bon Matin

 

Si Gilles & Patrick se mettent tous les deux à taquiner Le Decapode ! :o

Que fait la police !? :)

 

A propos j'ai une petite question pour les "cakes" de dev:

 

- J'ai toujours eu le sentiment que l'on pouvait faire "à peu près"

tout ce qu'on veut en Lisp et VLisp !?

- Et que le VBA AutoCAD était "plus limité "! :exclam:

Ai je tort ou raison ?

 

Le Decapode

 

[bonuscad]

Et que le VBA AutoCAD était "plus limité "!

 

Non, je ne pense pas!

 

Je ne m'investis pas dans le VBA, car la principale chose qui me freine et la portabilité d'une version à une autre, ou simplement de poste à poste. Ceci pour des applications assez évoluées.

 

Je pense que le gros avantage du VBA est l'interopérabilité entre applications.

Par exemple, je pense que les applications dévelloppés par Patrick_35 concernant les échanges entre Excel et Autocad serait plus performantes en VBA.

 

Mais les soucis d'utilisation avec des versions différentes des modules de Crosoft (Netframework etc..) sont trop contraignantes pour nous petit développeurs.

 

Le lisp est nettement plus facile et portable (avec modifications mineures en générale) d'une version à l'autre.

 

Mais je dit peut être des "conneries", vu que je ne pratique pas le VBA... :P

[Patrick_35]

Je rejoins Bonus dans son analyse.

 

Je compléterai juste avec un gros avantage du lisp par rapport au vba notamment au sujet des réacteurs et un gros avantage du vba par rapport au lisp notamment tout ce qui concerne les activex. C'est une usine à gaz en vlisp et on n'arrive pas toujours à avoir ce que l'on souhaite (comme une selection multiple de fichiers par exemple)

De plus, toujours pour les activex, il est beaucoup plus facile de trouver des exemples en vba qu'en vlisp et faire la traduction n'est pas toujours aisée.

 

les échanges entre Excel et Autocad serait plus performantes en VBA

Je ne sais pas. C'est à tester.

Il est vrai que logiquement un dialogue vba -> vba, est ce qui il y a de plus rapide, mais comme avec le lisp je me connecte sur la bibliothèque d'échange pour dialoguer et qu'Autocad doit faire de même en vba, à voir.

 

@+

[bonuscad]

serait plus performantes

 

En fait en me relisant, ce n'est pas exactement ce que je voulais dire.

Je pencherais plutôt pour serait plus adaptées car en fait (je pense) tu pourrais faire appel a des modules déjà en place, alors en VL tu as du pratiquement les concevoir de A à Z.

 

Mais en terme de rapidité, je pense que tu as raison, cela doit être kif-kif

 

Mais au moins en VL tu maitrise ton code parfaitement. ;)

 

Lecrabe, tu devrait reposer ta question dans le forum VBA pour avoir des avis plus éclairés de personne qui le pratique, car j'ai certainement des aprioris non fondés.