Champ qui additionne les surface d'un Xref

Fraid · le 17 décembre 2018

He bonjour,

Merci

ce n'est pas souvent que l'on voit une proposition en vlisp

C'est surement grandement grâce à toi, Gile et aux autres.

Ce n'est pas facile, mais à force de persévérer on y arrive.

Pourquoi utiliser ObjectDbx

Parce que voulais tester la fonction de Lee Mac, c'étais donc l'occasion.

Pourquoi te limiter à 5 calques

Parce que je n'y suis pas arrivé...j'ai du m’emmêler les parenthèses. :unsure:

Fraid · le 17 décembre 2018

en fait c'est au niveau de la fonction GTHA, si je met une boucle selon la liste de calques, je n'arrive pas a incrémenter le nom des variables pour construire la liste finale.....

Fraid · le 17 décembre 2018

a oui, aussi, si il y a des calques contenant des hachures mais qu'ils ne sont pas désirés dans le tableau, je ne sais pas les détecter(hormis le 0).

litelsousa · le 18 décembre 2018

Eh bien un grand merci, c'est nickel

Patrick_35 · le 18 décembre 2018

Salut

Quelque chose dans ce style ?

(defun rch_hachures(/ def doc lgn lst obj tab)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vlax-for obj (vla-get-blocks doc)
   (and (eq (vla-get-objectname obj) "AcDbBlockTableRecord")
 (eq (vla-get-isxref obj) :vlax-true)
     (progn
(setq lst nil)
(vlax-for ent obj
  (and (eq (vla-get-objectname ent) "AcDbHatch")
    (or (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-area (list ent)))
      (if (setq def (assoc (vla-get-layer ent) lst))
	(setq lst (subst (list (car def) (+ (cadr def) (vla-get-area ent))) def lst))
	(setq lst (cons (list (vla-get-layer ent) (vla-get-area ent)) lst))
      )
    )
  )
)
(and lst
  (setq lgn (+ (strlen (vla-get-name obj)) 2)
	lst (mapcar '(lambda(x)(list (if (= (car x) "0")
				       "0"
				       (substr (car x) lgn)
				     )
				     (cadr x)
			       )
		     )
		     lst
	    )
	tab (cons (list (vla-get-name obj) (vl-sort lst '(lambda(a B)(< (strcase (car a)) (strcase (car B)))))) tab)
  )
)
     )
   )
 )
 (vl-sort tab '(lambda(a B)(< (strcase (car a)) (strcase (car B)))))
)

@+

litelsousa · le 19 décembre 2018

Bonjour,

Je me permets de revenir vers vous, y a t'il une variable sur le nombre maximum de hachures (par exemple maxsort )pour que ce lisp fonctionne sur une aire totale supérieur à 105'395 unités? J'ai (pour l'instant) 333 hachures.

Merci

Steven · le 19 décembre 2018

Bonjour,

Je me permets de revenir vers vous, y a t'il une variable sur le nombre maximum de hachures (par exemple maxsort )pour que ce lisp fonctionne sur une aire totale supérieur à 105'395 unités? J'ai (pour l'instant) 333 hachures.

Merci

Salut,

As-tu essayé l'extraction de données ?

litelsousa · le 20 décembre 2018

Bonjour,

J'ai essayé l'extraction de données, mais ça me sort un tableau avec les surfaces de chaque hachure. Je n'arrive pas à faire en sorte quue ça me sorte le total par calque

J'ai essayé plusieurs options d'extraction, mais je ne trouve pas la bonne.

Pour les lisp de Patrick_35, je ne vois pas où il faut l'insérer?

Fraid · le 20 décembre 2018

Bonjour,

Je ne vois pas pourquoi cela serais limité à 333 hachures...

Mais je ne comprend pas bien ton erreur.

Tu as 105'395 hachures dans une xref?

si tu as plus de 32000 objets dans un dwg ce n'est pas possible.

en plus nous sommes limité en nombre d'itération, donc encore moins possible.(je ne sais plus combien, autour de 20000 me semble t'il)

même en divisant tes plans en plus d'xref cela n’arrangerais rien.

litelsousa · le 20 décembre 2018

Non non non, les 105'395 sont la surface totale des hachures (en l'occurance des m²).

Et les 333 hachures sont le nombre de zone à hachurer.

Il s'agit d'un aéroport, c'est pour ça que c'est aussi étendu.

Par contre, J'ose demander ce qu'est une itération?

litelsousa · le 20 décembre 2018

.

Fraid · le 20 décembre 2018

l'itération est la répétition de code, dans une boucle par exemple.

Fraid · le 20 décembre 2018

je vais faire des testes ce soir, la suis charrette

je te tiens au courant

Patrick_35 · le 20 décembre 2018

Salut

En partant sur la base du tableau de Fraid

(defun c:tha(/ deb def doc lay lst nbx nby new tab tbl rch_hachures)
 (defun rch_hachures(/ def lgn lst obj tab)
   (vlax-for obj (vla-get-blocks doc)
     (and (eq (vla-get-objectname obj) "AcDbBlockTableRecord")
   (eq (vla-get-isxref obj) :vlax-true)
(progn
  (setq lst nil)
  (vlax-for ent obj
    (and (eq (vla-get-objectname ent) "AcDbHatch")
      (or (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-area (list ent)))
	(if (setq def (assoc (vla-get-layer ent) lst))
	  (setq lst (subst (list (car def) (+ (cadr def) (vla-get-area ent))) def lst))
	  (setq lst (cons (list (vla-get-layer ent) (vla-get-area ent)) lst))
	)
      )
    )
  )
  (and lst
    (setq lgn (+ (strlen (vla-get-name obj)) 2)
	  lst (mapcar '(lambda(x)(list (if (= (car x) "0")
					 "0"
					 (substr (car x) lgn)
				       )
				       (cadr x)
				 )
		       )
		       lst
	      )
	  tab (cons (list (vla-get-name obj) (vl-sort lst '(lambda(a B)(< (strcase (car a)) (strcase (car B)))))) tab)
    )
  )
)
     )
   )
   (vl-sort tab '(lambda(a B)(< (strcase (car a)) (strcase (car B)))))
 )

 (setq doc (vla-get-activedocument (vlax-get-acad-object))
tab (rch_hachures)
tbl (apply 'append (mapcar 'cadr tab))
 )
 (vla-startundomark doc)
 (while tbl
   (setq deb (car tbl)
  tbl (cdr tbl)
   )
   (while (setq def (assoc (car deb) tbl))
     (setq deb (list (car def) (+ (cadr deb) (cadr def)))
    tbl (vl-remove def tbl)
     )
   )
   (setq lst (cons deb lst))
 )
 (setq lst (vl-sort lst '(lambda(a B)(< (car a) (car B))))
new (vla-addtable (vla-get-modelspace doc)
		  (vlax-3d-point '(0.0 0.0 0.0))
		  (+ (length lst) 3)
		  (+ (length tab) 2) 
		  10 
		  66
    )
nbx 0
nby 0
 )
 (mapcar '(lambda(a B)(vlax-put new a B)) '(vertcellmargin titlesuppressed headersuppressed) '(3.0 :vlax-true :vlax-true))
 (vla-settext new 0 0 "Surfaces par Calques")
 (repeat (length tab)
   (vla-settext new 1 (1+ nbx) (car (nth nbx tab)))
   (setq nbx (1+ nbx))
 )
 (repeat (length lst)
   (vla-settext new (+ nby 2) 0 (car (nth nby lst)))
   (setq nby (1+ nby))
 )
 (vla-settext new 1 (1+ nbx) "Total")
 (vla-settext new (+ nby 2) 0 "Total")
 (setq nbx 1)
 (foreach xrf tab
   (setq nby 2 tot 0)
   (foreach lay lst
     (and (setq def (assoc (car lay) (cadr xrf)))
(setq tot (+ tot (cadr def)))
(vla-settext new nby nbx (cadr def))
     )
     (setq nby (1+ nby))
   )
   (vla-settext new nby nbx tot)
   (setq nbx (1+ nbx))
 )
 (setq nby 2 tot 0)
 (foreach lay lst
   (vla-settext new nby nbx (cadr lay))
   (setq nby (1+ nby)
  tot (+ tot (cadr lay))
   )
 )
 (vla-settext new nby nbx tot)
 (vla-endundomark doc)
 (princ)
)

@Fraid :

Ta fonction ListeCAR2 peut-être faite aussi de cette manière

(mapcar 'car Ma_liste)

@+

litelsousa · le 21 décembre 2018

Hello,

Merci, merci, merci

Ce que vous avez fait, c'est de la folie!!!!!

On peut rajouter des étapes et ça les prend directement en compte!

Par contre, je sais je pinaille, mais est-il possible que j'arrondisse les surfaces à l'unité?

Patrick_35 · le 21 décembre 2018

Salut

En partant sur les valeurs définies avec ddunits (ou commande unites ou les variables lunits et luprec)

(defun c:tha(/ deb def dmz doc lay lst nbx nby new tab tbl rch_hachures)
 (defun rch_hachures(/ def lgn lst obj tab)
   (vlax-for obj (vla-get-blocks doc)
     (and (eq (vla-get-objectname obj) "AcDbBlockTableRecord")
   (eq (vla-get-isxref obj) :vlax-true)
(progn
  (setq lst nil)
  (vlax-for ent obj
    (and (eq (vla-get-objectname ent) "AcDbHatch")
      (or (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-area (list ent)))
	(if (setq def (assoc (vla-get-layer ent) lst))
	  (setq lst (subst (list (car def) (+ (cadr def) (vla-get-area ent))) def lst))
	  (setq lst (cons (list (vla-get-layer ent) (vla-get-area ent)) lst))
	)
      )
    )
  )
  (and lst
    (setq lgn (+ (strlen (vla-get-name obj)) 2)
	  lst (mapcar '(lambda(x)(list (if (= (car x) "0")
					 "0"
					 (substr (car x) lgn)
				       )
				       (cadr x)
				 )
		       )
		       lst
	      )
	  tab (cons (list (vla-get-name obj) (vl-sort lst '(lambda(a B)(< (strcase (car a)) (strcase (car B)))))) tab)
    )
  )
)
     )
   )
   (vl-sort tab '(lambda(a B)(< (strcase (car a)) (strcase (car B)))))
 )

 (setq doc (vla-get-activedocument (vlax-get-acad-object))
tab (rch_hachures)
tbl (apply 'append (mapcar 'cadr tab))
 )
 (vla-startundomark doc)
 (while tbl
   (setq deb (car tbl)
  tbl (cdr tbl)
   )
   (while (setq def (assoc (car deb) tbl))
     (setq deb (list (car def) (+ (cadr deb) (cadr def)))
    tbl (vl-remove def tbl)
     )
   )
   (setq lst (cons deb lst))
 )
 (setq lst (vl-sort lst '(lambda(a B)(< (car a) (car B))))
new (vla-addtable (vla-get-modelspace doc)
		  (vlax-3d-point '(0.0 0.0 0.0))
		  (+ (length lst) 3)
		  (+ (length tab) 2) 
		  10 
		  66
    )
nbx 0
nby 0
 )
 (mapcar '(lambda(a B)(vlax-put new a B)) '(vertcellmargin titlesuppressed headersuppressed) '(3.0 :vlax-true :vlax-true))
 (vla-settext new 0 0 "Surfaces par Calques")
 (repeat (length tab)
   (vla-settext new 1 (1+ nbx) (car (nth nbx tab)))
   (setq nbx (1+ nbx))
 )
 (repeat (length lst)
   (vla-settext new (+ nby 2) 0 (car (nth nby lst)))
   (setq nby (1+ nby))
 )
 (vla-settext new 1 (1+ nbx) "Total")
 (vla-settext new (+ nby 2) 0 "Total")
 (setq nbx 1
dmz (getvar "dimzin")
 )
 (setvar "dimzin" 1)
 (foreach xrf tab
   (setq nby 2 tot 0)
   (foreach lay lst
     (and (setq def (assoc (car lay) (cadr xrf)))
(setq tot (+ tot (cadr def)))
(vla-settext new nby nbx (rtos (cadr def) (getvar "lunits") (getvar "luprec")))
     )
     (setq nby (1+ nby))
   )
   (vla-settext new nby nbx (rtos tot (getvar "lunits") (getvar "luprec")))
   (setq nbx (1+ nbx))
 )
 (setq nby 2 tot 0)
 (foreach lay lst
   (vla-settext new nby nbx (rtos (cadr lay) (getvar "lunits") (getvar "luprec")))
   (setq nby (1+ nby)
  tot (+ tot (cadr lay))
   )
 )
 (vla-settext new nby nbx (rtos tot (getvar "lunits") (getvar "luprec")))
 (setvar "dimzin" dmz)
 (vla-endundomark doc)
 (princ)
)

@+

litelsousa · le 21 décembre 2018

C'est parfait!

bonuscad · le 21 décembre 2018

Intéressant,Pour ceux qui utilisent des MPolygon (AutocadMap), si l'on remplace :

"AcDbHatch" par "AcDbMPolygon" cela fonctionne très bien aussi; la définition est la même que pour les hachures.

Merci

Connexion

Champ qui additionne les surface d'un Xref

Messages recommandés

Fraid

Fraid

Fraid

litelsousa

Patrick_35

litelsousa

Steven

litelsousa

Fraid

litelsousa

litelsousa

Fraid

Fraid

Patrick_35

litelsousa

Patrick_35

litelsousa

bonuscad

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante