Lisp pour recopier longueur totale des polylignes d\'un calque dans un Textmult

BixenteLiz · le 11 août 2008

Bonjour à tous

Je viens régulièrement sur Cadxp pour trouver quelques astuces pouvant me faciliter la vie sur AutoCAD mais je n'avais encore jamais posté, donc voila qui est fait !

Je travaille en tant que technicien méthodes dans une entreprise de bâtiment. Dans le cadre de cette mission, j'effectue des "rotations de banches" (matériel de coffrage de murs).

Concrètement je "surligne" en polylignes les murs que nous allons réaliser chaque jours. 1 jour = 1 calque.

Actuellement je me sers des lisp " ztotm " ou "long_line" pour trouver la longueur cumulée des polylignes de chaque calques que je recopie ensuite en textmult dans un tableau.

J'aimerai pouvoir automatiser ces actions, ce qui me ferai gagner un temps précieux lors de modifications de ces documents.

L'idéal serait que mon tableau se mette à jour automatiquement lors de modifications et m'indique immédiatement la nouvelle longueur journalière cumulée.

Je ne pense pas qu'un lisp permettant de faire cela soit bien compliqué à réaliser mais n'ayant eu aucune formation pour le lisp, j'essaye d'apprendre seul depuis quelques semaines ... et là je cale !

En espérant que vous pourrez m'aider...

Merci beaucoup

Edit :

Petit oubli : j'aimerai également pouvoir automatiser le décompte de blocs ( que mon tableau inscrive automatiquement le nombre de blocs nommés "machin" appartenant au calque "bidule" )

Merci !

[Edité le 11/8/2008 par masterdisco]

BixenteLiz · le 11 août 2008

UP SVP .... :(

BixenteLiz · le 11 août 2008

Vraiment personne...? Ce tout petit programme me ferais gagner un temps dingue la journée ...

Merci

lili2006 · le 11 août 2008

Bonjour à toutes et tous,

Bienvenue masterdisco,

Un peu de patience, les "cadors" du lisp sont peut-être tous en vacances ou non connecté dans la journée,...

J'aimerai pouvoir automatiser ces actions

Un script, peut-être ?

Là aussi, il faut attendre le retour des pros,..

En ce qui me concerne, j'aime bien PLINE_BLOCK de (gile) & CurveLength_Field de bonuscad,...

Patrick_35 · le 11 août 2008

Salut

Vraiment personne...? Ce tout petit programme me ferais gagner un temps dingue la journée ...

Oui, mais pas nous, c'est trop spécifique métier et en plus il y a du monde en vacance.

Je veux bien te donner des indications pour t'aider à faire ton lisp.

Une première chose pour trouver la date du jour.

(menucmd "M=$(edtime, $(getvar,date),dd/mo/yy)")

@+

Lisp69 · le 11 août 2008

Bonjour

Tu peux peut être tout simplement utiliser les extractions de données (Outils > Extraction de données);

Tu peux y choisir tous les éléments que tu veux pour un type d'objet donné (par exemple, pour une polyligne: sont calque, sa couleur, son linéaire, etc..)

A la fin de la procédure, tu as le choix d'insérer un tableau dans le dessin ou de créer un tableau externe (excel)

Ce tableau est lié aux données, donc s'il y a modif des objets, le tableau est modifié.

L'ensemble demade un peu de manip,mais en bidouillant un peu on arrive à un bon résultat.

(NB j'utilise autocad 2008)

Voilà

Bon courage

Serge · le 12 août 2008

masterdisco

Voici du code qui produit un tableau de périmètres et un autre de blocs. Les 2 commandes sont expliquées dans les commentaires. Donne-moi en des nouvelles.

 
;;; c:tableau_Perimetres
;;; Dessine un tableau illustrant la liste des calques et les périmètres d'objets filtrés (en ModelSpace)
;;;
;;; Compatibilité: AutoCAD 2005 et plus
;;;
;;; Instructions:
;;; 1) Charger ce fichier
;;; 2) Tapez TABLEAU_PERIMETRES sur la ligne de commande
;;; 3) Indiquez le point d'insertion
;;; 4) La partie Personnalisation peut être modifiés.
;;;
;;; Par Serge Camiré, CadNovation, 2008/08/12
;;; http://www.cadnovation.com/fr
;;;

(defun c:tableau_Perimetres (
/ acadObject ColWidth endPt filteredLayers filteredObjets i LayerCount LayerName layerNames lcLayerName 
  LineWeight ModelSpace n NumColumns NumRows objectName perimeter Point2D Resultat Resultats row RowHeight 
  tableau textsize ThisDrawing Total vlaLayers vlaPoint3D vlaTableau
  )
 
  ;; ======================================================================================================================
  ;; Personnalisation
  ;; ======================================================================================================================
 
  ;; Liste des calques et objets désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules
  ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z
  ;; Exemple pour objets "*" pour tous les objets "*line,circle" pour tous les objets dont le nom se termine par "line", ainsi que les cercles
  (setq filteredLayers "*")  
  (setq filteredObjets "*line")  

  ;; Taille du tableau
  (setq textsize (getvar "textsize"))          ; Voir cette variable qui contrôle la hauteur du texte
  (setq RowHeight (* 2.0 textsize))
  (setq ColWidth (* 10.0 RowHeight))           ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes
  (setq LineWeight acLnWt040)                  ; Épaisseur de la ligne de séparation (voir LWDISPLAY)


 
  ;; ======================================================================================================================
  ;; Ne pas modifier la suite du programme
  ;; ======================================================================================================================

  (setq filteredLayers (strcase filteredLayers t))  ; Minuscules
  (setq filteredObjets (strcase filteredObjets t))  ; Minuscules

  (setq acadObject (vlax-get-acad-object))
  (setq ThisDrawing (vla-get-ActiveDocument acadObject))
  (setq ModelSpace (vla-get-ModelSpace ThisDrawing))
  (setq vlaLayers (vla-get-Layers ThisDrawing))
  (setq LayerCount (vla-get-count vlaLayers))

  (setq Point2D (getpoint "\nPoint d'insertion: "))
  (setq vlaPoint3D (PointToVariant Point2D))
  (setq NumRows (+ 3 LayerCount)) ; 2 lignes de titre + total
  (setq NumColumns 2)

  ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table)
  ;; dont les paires sont (LayerName Count)
  (setq Resultats nil)
  (setq layerNames nil)
  (vlax-for vlaLayer vlaLayers
     (setq layerName (vla-get-name vlaLayer))
     (setq lcLayerName (strcase layerName t))  ; Minuscules
     (if (wcmatch lcLayerName filteredLayers) (setq layerNames (cons lcLayerName layerNames)))
  )
  (setq layerNames (vl-sort layerNames '<))  ; Trier en ordre croissant
  (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) layerNames))

  (vlax-for vlaObject ModelSpace
     
     (if (and (wcmatch (setq objectName (strcase (vla-get-ObjectName vlaObject) t)) filteredObjets)
              (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers)
         )
     (progn
        (setq endPt (vlax-curve-getEndParam vlaObject))
        (setq perimeter (vlax-curve-getDistAtParam vlaObject endPt))
        (setq Total (+ perimeter (cdr (assoc layerName Resultats))))
        (setq Resultats (subst (cons layerName Total) (assoc layerName Resultats) Resultats)) 
     ))
  )

  ;; Ligne 0
  (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth))
  (vla-SetCellAlignment vlaTableau 0 0 acMiddleCenter)
  (vla-SetCellTextHeight vlaTableau 0 0 textsize)
  (vla-SetCellValue vlaTableau 0 0 "Résultats")

  ;; Ligne 1, colonne 0
  (vla-SetCellGridLineWeight vlaTableau 1 0 4 LineWeight)
  (vla-SetCellAlignment vlaTableau 1 0 acMiddleCenter)
  (vla-SetCellTextHeight vlaTableau 1 0 textsize)
  (vla-SetCellValue vlaTableau 1 0 "Calques")

  ;; Ligne 1, colonne 1
  (vla-SetCellGridLineWeight vlaTableau 1 1 4 LineWeight)
  (vla-SetCellAlignment vlaTableau 1 1 acMiddleCenter)
  (vla-SetCellTextHeight vlaTableau 1 1 textsize)
  (vla-SetCellValue vlaTableau 1 1 "Périmètres")

  ;; Lignes de résultat
  (setq i 0)
  (setq n LayerCount)
  (setq Total 0.0)
  (while (< i n)
     (setq Resultat (nth i Resultats))
     (setq row (+ i 2))

     ;; Calque
     (setq layerName (strcase (car Resultat)))
     (vla-SetCellAlignment vlaTableau row 0 acMiddleLeft)
     (vla-SetCellTextHeight vlaTableau row 0 textsize)
     (vla-SetCellValue vlaTableau row 0 layerName)

     ;; Périmètre
     (setq perimeter (cdr Resultat))
     (setq Total (+ Total perimeter))
     (vla-SetCellAlignment vlaTableau row 1 acMiddleRight)
     (vla-SetCellTextHeight vlaTableau row 1 textsize)
     (vla-SetCellValue vlaTableau row 1 (rtos perimeter))
     (setq i (1+ i))
  ) 

  ;; Total
  (setq row (+ LayerCount 2))
  (setq layerName "Total")
  (vla-SetCellGridLineWeight vlaTableau row 0 1 LineWeight)
  (vla-SetCellAlignment vlaTableau row 0 acMiddleLeft)
  (vla-SetCellTextHeight vlaTableau row 0 textsize)
  (vla-SetCellValue vlaTableau row 0 layerName)

  ;; Périmètre total
  (setq perimeter Total)
  (setq Total (+ Total perimeter))
  (vla-SetCellGridLineWeight vlaTableau row 1 1 LineWeight)
  (vla-SetCellAlignment vlaTableau row 1 acMiddleRight)
  (vla-SetCellTextHeight vlaTableau row 1 textsize)
  (vla-SetCellValue vlaTableau row 1 (rtos perimeter))
)

;;; c:tableau_Blocs
;;; Dessine un tableau illustrant la liste des calques et les blocs filtrés (en ModelSpace)
;;;
;;; Compatibilité: AutoCAD 2005 et plus
;;;
;;; Instructions:
;;; 1) Charger ce fichier
;;; 2) Tapez TABLEAU_BLOCS sur la ligne de commande
;;; 3) Indiquez le point d'insertion
;;; 4) La partie Personnalisation peut être modifiés.
;;;
;;; Par Serge Camiré, CadNovation, 2008/08/12
;;; http://www.cadnovation.com/fr
;;;

(defun c:tableau_Blocs (
/ acadObject blockName BlockNameCount blockNames ColWidth filteredBlockNames filteredLayers i layerName 
  lcBlockName LineWeight ModelSpace n NumColumns NumRows perimeter Point2D Resultat Resultats row RowHeight 
  textsize ThisDrawing total vlaBlocks vlaPoint3D vlaTableau 
  )
  ;; Liste des calques et noms de bloc désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules
  ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z
  ;; Exemple pour blockNames "*" pour tous les objets "*line,circle" pour tous les objets dont le nom se termine par "line", ainsi que les cercles
  (setq filteredLayers "*")  
  (setq filteredBlockNames "*")  

  ;; Taille du tableau
  (setq textsize (getvar "textsize"))          ; Voir cette variable qui contrôle la hauteur du texte
  (setq RowHeight (* 2.0 textsize))
  (setq ColWidth (* 10.0 RowHeight))           ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes
  (setq LineWeight acLnWt040)                  ; Épaisseur de la ligne de séparation (voir LWDISPLAY)

  ;; Ne pas modifier la suite du programme
  (setq filteredLayers (strcase filteredLayers t))  ; Minuscules
  (setq filteredBlockNames (strcase filteredBlockNames t))  ; Minuscules

  (setq acadObject (vlax-get-acad-object))
  (setq ThisDrawing (vla-get-ActiveDocument acadObject))
  (setq ModelSpace (vla-get-ModelSpace ThisDrawing))
  (setq vlaBlocks (vla-get-blocks ThisDrawing))

  (setq Point2D (getpoint "\nPoint d'insertion: "))
  (setq vlaPoint3D (PointToVariant Point2D))
  (setq NumColumns 2)

  ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table)
  ;; dont les paires sont (LayerName Count)
  (setq Resultats nil)
  (setq BlockNames nil)
  (vlax-for vlaBlock vlaBlocks
     (setq blockName (vla-get-name vlablock))
     (setq lcBlockName (strcase blockName t))  ; Minuscules, blocs nommés
     (if (and (/= "*" (substr lcBlockName 1 1)) (wcmatch lcBlockName filteredBlockNames)) (setq BlockNames (cons lcBlockName BlockNames)))
  )
  (setq BlockNames (vl-sort BlockNames '<))  ; Trier en ordre croissant
  (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) BlockNames))

  (vlax-for vlaObject ModelSpace
     
     (if (and (= "AcDbBlockReference" (vla-get-ObjectName vlaObject))
              (wcmatch (setq blockName (strcase (vla-get-Name vlaObject) t)) filteredBlockNames)
              (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers)
         )
     (progn
        (setq Total (1+ (cdr (assoc blockName Resultats))))
        (setq Resultats (subst (cons blockName Total) (assoc blockName Resultats) Resultats)) 
     ))
  )

  ;; Ligne 0
  (setq NumRows (+ 2 (length Resultats))) ; 2 lignes de titre
  (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth))
  (vla-SetCellAlignment vlaTableau 0 0 acMiddleCenter)
  (vla-SetCellTextHeight vlaTableau 0 0 textsize)
  (vla-SetCellValue vlaTableau 0 0 "Résultats")

  ;; Ligne 1, colonne 0
  (vla-SetCellGridLineWeight vlaTableau 1 0 4 LineWeight)
  (vla-SetCellAlignment vlaTableau 1 0 acMiddleCenter)
  (vla-SetCellTextHeight vlaTableau 1 0 textsize)
  (vla-SetCellValue vlaTableau 1 0 "Blocs")

  ;; Ligne 1, colonne 1
  (vla-SetCellGridLineWeight vlaTableau 1 1 4 LineWeight)
  (vla-SetCellAlignment vlaTableau 1 1 acMiddleCenter)
  (vla-SetCellTextHeight vlaTableau 1 1 textsize)
  (vla-SetCellValue vlaTableau 1 1 "Quantité")

  ;; Lignes de résultat
  (setq i 0)
  (setq n (length Resultats))
  (setq Total 0.0)
  (while (< i n)
     (setq Resultat (nth i Resultats))
     (setq row (+ i 2))

     ;; BlockName
     (setq BlockName (strcase (car Resultat)))
     (vla-SetCellAlignment vlaTableau row 0 acMiddleLeft)
     (vla-SetCellTextHeight vlaTableau row 0 textsize)
     (vla-SetCellValue vlaTableau row 0 BlockName)

     ;; Quantité
     (setq Total (cdr Resultat))
     (vla-SetCellAlignment vlaTableau row 1 acMiddleCenter)
     (vla-SetCellTextHeight vlaTableau row 1 textsize)
     (vla-SetCellValue vlaTableau row 1 (rtos Total 2 0))
     (setq i (1+ i))
  ) 
)

;;; PointToVariant
;;; Conversion de Point2D ou Point3D en variant
(defun PointToVariant (
  point
/ arraySpace sArray
  )
  (setq arraySpace (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length point)))))
  (setq sArray (vlax-safearray-fill arraySpace point))
  (vlax-make-variant sArray)
)

Serge

thry0 · le 12 août 2008

Bjr,

Message d'erreur chez moi (V2006)

erreur: no function definition: VLA-SETCELLVALUE

Si ça vous parle ... :o

lili2006 · le 12 août 2008

Bonjour à toutes et tous,

Rien à voir avec ta demande masterdisco, mais ces quelques blocs peuvent te servir,...

(gile) · le 12 août 2008

Salut,

Pour comptabiliser les blocs, tu peux aussi utiliser Tabloblo, une routine de Tramber que j'avais essayé de finaliser.

PS : Serge, chez moi, Tableau_blocs ne fonctionne pas si le dessin contient des blocs dynamiques (devenus anonymes après modification des propriétés).

[Edité le 12/8/2008 par (gile)]

BixenteLiz · le 12 août 2008

Bonjour et merci pour vos réponses.

>> Serge

J'ai essayé le bout de programme que tu m'as donné (merci au passage!) que j'ai donc recopié dans le bloc-notes puis enregistré en ".lsp". En voulant charger cette appli (commande APPLOAD), je selectionne le lisp et AutoCAD me donne ce message d'erreur :

erreur: bad argument type ; expected at [sTRCASE]

Je n'ai vraiment eu aucune formation ni sur la création ni sur l'utilisation du lisp donc je m'y prends peut être mal je ne sais pas... Si tu pouvais m'éclairer d'avantage..

>> lili2006

Merci pour cette bibliothèque de blocs. Je possédais déjà la plupart mais certains autres me seront bien utiles ! :) Tu travailles dans une entreprise de bâtiment ?

Au passage je renouvelle ma demande. Si jamais par le plus grand des hasards quelqu'un fait des manipulations similaires sur AutoCAD et possède un lisp...

Merci.

lili2006 · le 12 août 2008

Re,

Tu travailles dans une entreprise de bâtiment ?

Non !

Je suis professeur de Génie-civil en poste sur le BTS Géomètre-Topographe.

Je fais également des formations pour le compte du GRETA ( GRoupement d'ETAblissement) dans les différents secteurs d'activités du BTP. J'ai d'ailleurs été amené cette année à montrer le fonctionnement des rotations de matériel sur un chantier de bâtiment pour futurs chefs de chantier et conducteurs de travaux déjà en poste.

Je seconde, avec mes modestes connaissances sur AutoCAD, le développement du Bureau d'Etudes structure Béton d'un ami de fac qui utilises essentiellemnt AutoCAD.

(gile) · le 12 août 2008

Re,

Pour charger/lancer des LISP, tu peux voir cette page

BixenteLiz · le 12 août 2008

Merci (gile)

J'ai procédé de la même façon que dans le sujet : LISP et Visual LISP > Débuter en LISP > Charger un LISP

Après avoir "nettoyé" le code de Serge en supprimant les commentaires, je l'ai enregistré en .lsp.

J'ai ensuite chargé ce lisp par APPLOAD, pas de soucis.

Je tape ensuite la commande : " tableau_Perimetres " et AutoCAD m'indique :

erreur: bad argument type ; expected at [sTRCASE]

Merci pour votre aide ...

(gile) · le 13 août 2008

Salut,

Après avoir "nettoyé" le code de Serge en supprimant les commentaires, je l'ai enregistré en .lsp.

Excuse moi si je me suis mal exprimé dans le lien que je donnais : "tout le code, rien que le code" ne concerne pas les commentaires qui, à mon sens font aussi parti du code.

Je voulais dire : "prendre tout ce qui est affiché sur fond de papier perforé et uniquement ça".

Les codes commentés n'étant pas monnaie courante (moi même, je ne le fait pas assez souvent) je trouve dommage de supprimer ceux-ci quand ils existent.

Pour l'erreur que tu as, je ne saurais dire, TABLEAU_PERIMETRES fonctionne bien chez moi (acad 2007). Tu peux essayer de la localiser en utilisant la méthode décrite ici ("D'où vient l'erreur ?")

Pour que TABLEAU_BLOCS fonctionne aussi avec les blocs dynamiques (anonymes) on peut remplacer :

(wcmatch (setq blockName (strcase (vla-get-Name vlaObject) t))
	 filteredBlockNames
)

par :

(wcmatch (setq blockName
		(strcase
		  (if (vlax-property-available-p vlaObject 'EffectiveName)
		    (vla-get-EffectiveName vlaObject)
		    (vla-get-Name vlaObject)
		  )
		  t
		)
	 )
	 filteredBlockNames
)

Serge · le 13 août 2008

masterdisco,

Voici le code corrigé. Je me suis rendu compte de bien des petites choses:

1) les méthodes ne sont pas toutes identiques selon la version d'AutoCAD. J'ai corrigé et testé avec succès en 2006 et 2009

2) le support du SCU

3) le support des blocs dynamiques (merci à Gile)

;;; c:tableau_Perimetres
;;; Dessine un tableau illustrant la liste des calques et les périmètres d'objets filtrés (en ModelSpace)
;;;
;;; Compatibilité: AutoCAD 2005 et plus
;;;
;;; Instructions:
;;; 1) Charger ce fichier
;;; 2) Tapez TABLEAU_PERIMETRES sur la ligne de commande
;;; 3) Indiquez le point d'insertion
;;; 4) La partie Personnalisation peut être modifiés.
;;;
;;; Par Serge Camiré, CadNovation, 2008/08/12
;;; http://www.cadnovation.com/fr
;;;
(vl-load-com)

(defun c:tableau_Perimetres (
/ acadObject column ColWidth endPt filteredLayers filteredObjets i LayerCount LayerName layerNames lcLayerName 
  LineWeightMedium LineWeightNone LineWeightThick ModelSpace n NumColumns NumRows objectName perimeter Point3D_UCS 
  Point3D_WCS Resultat Resultats row RowHeight tableau textsize ThisDrawing Total vlaLayers vlaPoint3D vlaTableau
  ) 
 
  ;; ======================================================================================================================
  ;; Personnalisation
  ;; ======================================================================================================================
 
  ;; Liste des calques et objets désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules
  ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z
  ;; Exemple pour objets "*" pour tous les objets "*line,circle" pour tous les objets dont le nom se termine par "line", ainsi que les cercles
  (setq filteredLayers "*")  
  (setq filteredObjets "*line")  

  ;; Taille du tableau
  (setq textsize (getvar "textsize"))          ; Voir cette variable qui contrôle la hauteur du texte
  (setq RowHeight (* 2.0 textsize))
  (setq ColWidth (* 10.0 RowHeight))           ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes
  (setq LineWeightThick acLnWt090)             ; Épaisseur de la ligne de séparation (voir LWDISPLAY)
  (setq LineWeightMedium acLnWt040)            ; Épaisseur de la ligne de séparation (voir LWDISPLAY)
  (setq LineWeightNone acLnWt000)              ; Épaisseur de la ligne de séparation (voir LWDISPLAY)

 
  ;; ======================================================================================================================
  ;; Ne pas modifier la suite du programme
  ;; ======================================================================================================================

  (setq filteredLayers (strcase filteredLayers t))  ; Minuscules
  (setq filteredObjets (strcase filteredObjets t))  ; Minuscules

  (setq acadObject (vlax-get-acad-object))
  (setq ThisDrawing (vla-get-ActiveDocument acadObject))
  (setq ModelSpace (vla-get-ModelSpace ThisDrawing))
  (setq vlaLayers (vla-get-Layers ThisDrawing))
  (setq LayerCount (vla-get-count vlaLayers))

  (setq Point3D_UCS (getpoint "\nPoint d'insertion: "))
  (setq Point3D_WCS (trans Point3D_UCS 1 0))  ; Si pas en WCS
  (setq vlaPoint3D (PointToVariant Point3D_WCS))
  (setq NumRows (+ 3 LayerCount)) ; 2 lignes de titre + total
  (setq NumColumns 2)

  ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table)
  ;; dont les paires sont (LayerName Count)
  (setq Resultats nil)
  (setq layerNames nil)
  (vlax-for vlaLayer vlaLayers
     (setq layerName (vla-get-name vlaLayer))
     (setq lcLayerName (strcase layerName t))  ; Minuscules
     (if (wcmatch lcLayerName filteredLayers) (setq layerNames (cons lcLayerName layerNames)))
  )
  (setq layerNames (vl-sort layerNames '<))  ; Trier en ordre croissant
  (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) layerNames))

  (vlax-for vlaObject ModelSpace
     
     (if (and (wcmatch (setq objectName (strcase (vla-get-ObjectName vlaObject) t)) filteredObjets)
              (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers)
         )
     (progn
        (setq endPt (vlax-curve-getEndParam vlaObject))
        (setq perimeter (vlax-curve-getDistAtParam vlaObject endPt))
        (setq Total (+ perimeter (cdr (assoc layerName Resultats))))
        (setq Resultats (subst (cons layerName Total) (assoc layerName Resultats) Resultats)) 
     ))
  )

  ;; Ligne 0
  (setq row 0)
  (setq column 0)
  (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth))
  (SetCellProperties vlaTableau row column "Résultats" textsize acMiddleCenter nil)

  ;; Ligne 1, colonne 0
  (setq row 1)
  (setq column 0)
  (SetCellProperties vlaTableau row column "Calques" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium))

  ;; Ligne 1, colonne 1
  (setq row 1)
  (setq column 1)
  (SetCellProperties vlaTableau row column "Périmètres" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium))

  ;; Lignes de résultat
  (setq i 0)
  (setq n LayerCount)
  (setq Total 0.0)
  (while (< i n)
     (setq Resultat (nth i Resultats))
     (setq row (+ i 2))

     ;; Calque
     (setq column 0)
     (setq layerName (strcase (car Resultat)))
     (SetCellProperties vlaTableau row column layerName textsize acMiddleLeft nil)

     ;; Périmètre
     (setq column 1)
     (setq perimeter (cdr Resultat))
     (setq Total (+ Total perimeter))
     (SetCellProperties vlaTableau row column (rtos perimeter) textsize acMiddleRight nil)
     (setq i (1+ i))
  ) 

  ;; Total
  (setq row (+ LayerCount 2))
  (setq column 0)
  (setq layerName "Total")
  (SetCellProperties vlaTableau row column layerName textsize acMiddleLeft (cons acHorzTop LineWeightMedium))

  ;; Périmètre total
  (setq column 1)
  (setq perimeter Total)
  (setq Total (+ Total perimeter))
  (SetCellProperties vlaTableau row column (rtos perimeter) textsize acMiddleRight nil)
)

;;; c:tableau_Blocs
;;; Dessine un tableau illustrant la liste des calques et les blocs filtrés (en ModelSpace)
;;;
;;; Compatibilité: AutoCAD 2005 et plus
;;;
;;; Instructions:
;;; 1) Charger ce fichier
;;; 2) Tapez TABLEAU_BLOCS sur la ligne de commande
;;; 3) Indiquez le point d'insertion
;;; 4) La partie Personnalisation peut être modifiés.
;;;
;;; Par Serge Camiré, CadNovation, 2008/08/12
;;; http://www.cadnovation.com/fr
;;;

(defun c:tableau_Blocs (
/ acadObject blockName BlockNameCount blockNames column ColWidth filteredBlockNames filteredLayers i layerName 
  lcBlockName LineWeightMedium LineWeightNone LineWeightThick ModelSpace n NumColumns NumRows perimeter Point3D_UCS 
  Point3D_WCS Resultat Resultats row RowHeight textsize ThisDrawing total vlaBlocks vlaPoint3D vlaTableau 
  )
  ;; Liste des calques et noms de bloc désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules
  ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z
  ;; Exemple pour blockNames "*" pour tous les objets "*line,circle" pour tous les objets dont le nom se termine par "line", ainsi que les cercles
  (setq filteredLayers "*")  
  (setq filteredBlockNames "*")  

  ;; Taille du tableau
  (setq textsize (getvar "textsize"))          ; Voir cette variable qui contrôle la hauteur du texte
  (setq RowHeight (* 2.0 textsize))
  (setq ColWidth (* 10.0 RowHeight))           ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes
  (setq LineWeightThick acLnWt090)             ; Épaisseur de la ligne de séparation (voir LWDISPLAY)
  (setq LineWeightMedium acLnWt040)            ; Épaisseur de la ligne de séparation (voir LWDISPLAY)
  (setq LineWeightNone acLnWt000)              ; Épaisseur de la ligne de séparation (voir LWDISPLAY)

  ;; Ne pas modifier la suite du programme
  (setq filteredLayers (strcase filteredLayers t))  ; Minuscules
  (setq filteredBlockNames (strcase filteredBlockNames t))  ; Minuscules

  (setq acadObject (vlax-get-acad-object))
  (setq ThisDrawing (vla-get-ActiveDocument acadObject))
  (setq ModelSpace (vla-get-ModelSpace ThisDrawing))
  (setq vlaBlocks (vla-get-blocks ThisDrawing))

  (setq Point3D_UCS (getpoint "\nPoint d'insertion: "))
  (setq Point3D_WCS (trans Point3D_UCS 1 0))  ; Si pas en WCS
  (setq vlaPoint3D (PointToVariant Point3D_WCS))
  (setq NumColumns 2)

  ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table)
  ;; dont les paires sont (LayerName Count)
  (setq Resultats nil)
  (setq BlockNames nil)
  (vlax-for vlaBlock vlaBlocks
     (setq blockName (GetBlockName vlaBlock))   ; Nom du bloc (accepte les blocs dynamiques.
     (setq lcBlockName (strcase blockName t))    ; Minuscules, blocs nommés
     (if (and (/= "*" (substr lcBlockName 1 1)) (wcmatch lcBlockName filteredBlockNames)) (setq BlockNames (cons lcBlockName BlockNames)))
  )
  (setq BlockNames (vl-sort BlockNames '<))  ; Trier en ordre croissant
  (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) BlockNames))

  (vlax-for vlaObject ModelSpace
     
     (if (and (= "AcDbBlockReference" (vla-get-ObjectName vlaObject))
              (wcmatch (setq blockName (strcase (GetBlockName vlaObject) t)) filteredBlockNames)
              (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers)
         )
     (progn
        (setq Total (1+ (cdr (assoc blockName Resultats))))
        (setq Resultats (subst (cons blockName Total) (assoc blockName Resultats) Resultats)) 
     ))
  )

  (setq NumRows (+ 2 (length Resultats))) ; 2 lignes de titre
  (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth))

  ;; Ligne 0
  (setq row 0)
  (setq column 0)
  (SetCellProperties vlaTableau row column "Résultats" textsize acMiddleCenter nil)

  ;; Ligne 1, colonne 0
  (setq row 1)
  (setq column 0)
  (SetCellProperties vlaTableau row column "Blocs" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium))

  ;; Ligne 1, colonne 1
  (setq row 1)
  (setq column 1)
  (SetCellProperties vlaTableau row column "Quantité" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium))

  ;; Lignes de résultat
  (setq i 0)
  (setq n (length Resultats))
  (setq Total 0.0)
  (while (< i n)
     (setq Resultat (nth i Resultats))
     (setq row (+ i 2))

     ;; BlockName
     (setq column 0)
     (setq BlockName (strcase (car Resultat)))
     (SetCellProperties vlaTableau row column BlockName textsize acMiddleLeft nil)

     ;; Quantité
     (setq column 1)
     (setq Total (cdr Resultat))
     (SetCellProperties vlaTableau row column (rtos Total 2 0) textsize acMiddleCenter nil)

     (setq i (1+ i))
  ) 
)

(defun SetCellProperties (
  vlaTableau Row Column Texte TextHeight Alignment LineWeightPair
  )
  ;; Gère les propriétés populaires des cellules d'un tableau
  ;;    vlaTableau Row Column : Obligatoire, les autres sont facultatifs
  ;;    Row, Column : INT, base 0
  ;;    Alignment: INT, 
  ;;    LineWeightPair: nil, sinon (cons "AcGridLineType enum" "acad_lweight enum"), soit (cons Position Épaisseur)
  ;; Support pour Acad2006 et Acad2009
  (if LineWeightPair (vla-SetCellGridLineWeight vlaTableau Row Column (car LineWeightPair) (cdr LineWeightPair)))
  (if Alignment (vla-SetCellAlignment vlaTableau Row Column Alignment))
  (if TextHeight (vla-SetCellTextHeight vlaTableau Row Column TextHeight))
  (if Texte
     (if vla-SetCellValue 
        (vla-SetCellValue vlaTableau Row Column Texte) ; AutoCAD 2009
        (vla-SetText vlaTableau Row Column Texte)      ; AutoCAD 2006
     )
  )
)

;;; PointToVariant
;;; Conversion de Point2D ou Point3D en variant
(defun PointToVariant (
  point
/ arraySpace sArray
  )
  (setq arraySpace (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length point)))))
  (setq sArray (vlax-safearray-fill arraySpace point))
  (vlax-make-variant sArray)
)

;;; Obtenir le nom du bloc (accepte les blocs dynamiques)
(defun GetBlockName (vlaBlock)
  (if (vlax-property-available-p vlaBlock 'EffectiveName) (vla-get-EffectiveName vlaBlock) (vla-get-Name vlaBlock))
)

Serge

BixenteLiz · le 14 août 2008

Bonjour.

Merci pour vos réponses (c'est assez rare de trouver des sites où les gens s'impliquent autant pour aider les autres)

>>> (serge)

J'ai réessayé les codes de ton post n°15, les deux fonctionnent très bien ! :D

Concernant TABLEAU_PERIMETRES : ça correspond exactement à ce dont j'avais besoin, rien à dire si ce n'est merci!

Concernant TABLEAU_BLOCS : le tableau me comptabilise effectivement les blocs contenus dans le dessin par contre ce n'est pas exactement ce dont j'avais besoins.

Je vais essayer d'être plus clair concernant mon travail :

Je récupère les plans de structure de chaque étage d'un bâtiment, que je place en fond de mon dessin soit par Xref soit comme bloc.

Je me sers d'un jeu de calques prédéfini contenus dans mon gabarit de dessin et contenant entre autres :

- Jour 1 - murs

- Jour 1 - banches

- Jour 2 - murs

- Jour 2 - banches

- etc...

Dans mes calques "Jour X - murs" :

je surligne les murs à réalisés je jour J et laisse apparaitre sur mes présentations (par un simple "geler dans fenêtre courante") les murs réalisés les jours précédents.

Dans mes calques "Jour X - banches" :

je place mes banches (2.40 / 1.20 ....) sous forme de blocs.

<> Ce que je cherche à faire <>

- Créer un tableau contenant les linéaires journaliers effectués > OK avec TABLEAU_PERIMETRES

- Créer un tableau comptabilisant les banches utilisées chaque jour.

>> TABLEAU_BLOCS me comptabilise tous les blocs "B-240" (par exemple) contenus dans le dessin, c.a.d. le cumul des banches utilisées en J1 + J2 + J3 ...

>> Est ce qu'il serait possible comptabiliser selon la forme :

.............................B240........B120........B90............

J1...........................2................1...............0.............

J2...........................1................0................2............

MAXI .....................2................1................2............

\_ (maxi correspondant à l'utlisation journalière maximale de matériel, et donc à la commande à effectuer)

Ce qui revient à compter séparément le nombre de blocs "bidule" dans le calque "machin", puis le nombre de blocs "bidule" dans le calque "trucmuch"

Encore merci pour votre aide

[Edité le 14/8/2008 par masterdisco]

Serge · le 14 août 2008

masterdisco

(version corrigée pour tenir compte que le calque courant peut être verrouillé)

Voilà !

Ce n'est pas dit que j'aurai toujours le temps mais présentement, je suis en vacances et j'avais besoin de me ressourcer en Lisp. Alors ça me fait plaisir.

Très important: jeter un coup d'oeil à certaines [surligneur] variables à paramétrer [/surligneur]dans la fonction c:tableau_Blocs sinon le tableau sera très lourd (il y aura une quantité de cellules égale au nombre de blocs x nombre de calques (sans compter les entêtes). Ces variables sont:

;; Noms d'objets acceptés

;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z

(setq [surligneur] filteredLayers [/surligneur]"*") ; Tout

(setq [surligneur] filteredBlockNames [/surligneur]"*") ; Tout

;; Noms d'objets à exclure

;; Exemple pour calques: "" pour aucun, "*$*,*|*" pour tous ceux contenant un $ ou | (i.e. issu de xref)

(setq [surligneur] excludedLayers [/surligneur]"defpoint,*$*,*|*") ; Exclure defpoint et ceux issus de Xrefs

(setq [surligneur] excludedBlockNames [/surligneur]"`**,*$*,*|*") ; Exclure blocs anonymes et ceux issus de Xrefs

;; Exclusion de lignes ou rangées vides

(setq [surligneur] excludeEmptyColumns [/surligneur]t) ; Exclure du tableau si tous les items de la colonne sont 0

(setq [surligneur] excludeEmptyRows [/surligneur]t) ; Exclure du tableau si tous les items de la rangée sont 0

Code à copier

;;; c:tableau_Perimetres
;;; Dessine un tableau illustrant la liste des calques et les périmètres d'objets filtrés (en ModelSpace)
;;;
;;; Compatibilité: AutoCAD 2005 et plus
;;;
;;; Instructions:
;;; 1) Charger ce fichier
;;; 2) Tapez TABLEAU_PERIMETRES sur la ligne de commande
;;; 3) Indiquez le point d'insertion
;;; 4) La partie Personnalisation peut être modifiés.
;;;
;;; Par Serge Camiré, CadNovation, 2008/08/12
;;; http://www.cadnovation.com/fr
;;;
(vl-load-com)

(defun c:tableau_Perimetres (
/ acadObject column ColWidth endPt filteredLayers filteredObjets i LayerCount LayerName layerNames lcLayerName 
  LineWeightMedium LineWeightNone LineWeightThick ModelSpace n NumColumns NumRows objectName perimeter Point3D_UCS 
  Point3D_WCS Resultat Resultats row RowHeight tableau textsize ThisDrawing Total vlaLayers vlaPoint3D vlaTableau
  ) 
 
  ;; ======================================================================================================================
  ;; Personnalisation
  ;; ======================================================================================================================
 
  ;; Liste des calques et objets désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules
  ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z
  ;; Exemple pour objets "*" pour tous les objets "*line,circle" pour tous les objets dont le nom se termine par "line", ainsi que les cercles
  (setq filteredLayers "*")  
  (setq filteredObjets "*line")  

  ;; Taille du tableau
  (setq textsize (getvar "textsize"))          ; Voir cette variable qui contrôle la hauteur du texte
  (setq RowHeight (* 2.0 textsize))
  (setq ColWidth (* 10.0 RowHeight))           ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes
  (setq LineWeightThick acLnWt090)             ; Épaisseur de la ligne de séparation (voir LWDISPLAY)
  (setq LineWeightMedium acLnWt040)            ; Épaisseur de la ligne de séparation (voir LWDISPLAY)
  (setq LineWeightNone acLnWt000)              ; Épaisseur de la ligne de séparation (voir LWDISPLAY)

 
  ;; ======================================================================================================================
  ;; Ne pas modifier la suite du programme
  ;; ======================================================================================================================

  (setq filteredLayers (strcase filteredLayers t))  ; Minuscules
  (setq filteredObjets (strcase filteredObjets t))  ; Minuscules

  (setq acadObject (vlax-get-acad-object))
  (setq ThisDrawing (vla-get-ActiveDocument acadObject))
  (setq ModelSpace (vla-get-ModelSpace ThisDrawing))
  (setq vlaLayers (vla-get-Layers ThisDrawing))
  (setq LayerCount (vla-get-count vlaLayers))

  (setq Point3D_UCS (getpoint "\nPoint d'insertion: "))
  (setq Point3D_WCS (trans Point3D_UCS 1 0))  ; Si pas en WCS
  (setq vlaPoint3D (PointToVariant Point3D_WCS))

  ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table)
  ;; dont les paires sont (LayerName Count)
  (setq Resultats nil)
  (setq layerNames nil)
  (vlax-for vlaLayer vlaLayers
     (setq layerName (vla-get-name vlaLayer))
     (setq lcLayerName (strcase layerName t))  ; Minuscules
     (if (wcmatch lcLayerName filteredLayers) (setq layerNames (cons lcLayerName layerNames)))
  )
  (setq layerNames (vl-sort layerNames '<))  ; Trier en ordre croissant
  (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) layerNames))

  (vlax-for vlaObject ModelSpace
     
     (if (and (wcmatch (setq objectName (strcase (vla-get-ObjectName vlaObject) t)) filteredObjets)
              (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers)
         )
     (progn
        (setq endPt (vlax-curve-getEndParam vlaObject))
        (setq perimeter (vlax-curve-getDistAtParam vlaObject endPt))
        (setq Total (+ perimeter (cdr (assoc layerName Resultats))))
        (setq Resultats (subst (cons layerName Total) (assoc layerName Resultats) Resultats)) 
     ))
  )

  (setq NumRows (+ 3 LayerCount)) ; 2 lignes de titre + total
  (setq NumColumns 2)
  (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth))

  ;; Ligne 0
  (setq row 0)
  (setq column 0)
  (SetCellProperties vlaTableau row column "Résultats" textsize acMiddleCenter nil)

  ;; Ligne 1, colonne 0
  (setq row 1)
  (setq column 0)
  (SetCellProperties vlaTableau row column "Calques" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium))

  ;; Ligne 1, colonne 1
  (setq row 1)
  (setq column 1)
  (SetCellProperties vlaTableau row column "Périmètres" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium))

  ;; Lignes de résultat
  (setq i 0)
  (setq n LayerCount)
  (setq Total 0.0)
  (while (< i n)
     (setq Resultat (nth i Resultats))
     (setq row (+ i 2))

     ;; Calque
     (setq column 0)
     (setq layerName (strcase (car Resultat)))
     (SetCellProperties vlaTableau row column layerName textsize acMiddleLeft nil)

     ;; Périmètre
     (setq column 1)
     (setq perimeter (cdr Resultat))
     (setq Total (+ Total perimeter))
     (SetCellProperties vlaTableau row column (rtos perimeter) textsize acMiddleRight nil)
     (setq i (1+ i))
  ) 

  ;; Total
  (setq row (+ LayerCount 2))
  (setq column 0)
  (setq layerName "Total")
  (SetCellProperties vlaTableau row column layerName textsize acMiddleLeft (cons acHorzTop LineWeightMedium))

  ;; Périmètre total
  (setq column 1)
  (setq perimeter Total)
  (setq Total (+ Total perimeter))
  (SetCellProperties vlaTableau row column (rtos perimeter) textsize acMiddleRight nil)
)

;;; c:tableau_Blocs
;;; Dessine un tableau illustrant la liste des calques et les blocs filtrés (en ModelSpace)
;;;
;;; Compatibilité: AutoCAD 2005 et plus
;;;
;;; Instructions:
;;; 1) Charger ce fichier
;;; 2) Tapez TABLEAU_BLOCS sur la ligne de commande
;;; 3) Indiquez le point d'insertion
;;; 4) La partie Personnalisation peut être modifiés.
;;;
;;;    IMPORTANT  IMPORTANT  IMPORTANT  IMPORTANT  IMPORTANT  IMPORTANT  IMPORTANT
;;;    Parmi les items à personnaliser, il faut prêter attention à ces variables
;;;    ;; Noms d'objets acceptés
;;;    (setq filteredLayers "*")  
;;;    (setq filteredBlockNames "*")  
;;;
;;;    ;; Noms d'objets à exclure
;;;    ;; Exemple pour calques: "" pour aucun, "*$*,*|*" pour tous ceux contenant un $ ou | (i.e. issu de xref)
;;;    (setq excludedLayers "defpoint,*$*,*|*")     ; Exclure defpoint et ceux issus de Xrefs
;;;    (setq excludedBlockNames "`**,*$*,*|*")      ; Exclure blocs anonymes et ceux issus de Xrefs
;;;
;;;    ;; Exclusion de lignes ou rangées vides
;;;    (setq excludeEmptyColumns t)                 ; Exclure du tableau si tous les items de la colonne sont 0
;;;    (setq excludeEmptyRows t)                    ; Exclure du tableau si tous les items de la rangée sont 0
;;;
;;;
;;; Par Serge Camiré, CadNovation, 2008/08/14
;;; http://www.cadnovation.com/fr
;;;

(defun c:tableau_Blocs (
/ acadObject blockName blockNames column ColWidth Count CurrentlayerWasLocked excludedBlockNames 
  excludedLayers excludeEmptyColumns excludeEmptyRows filteredBlockNames filteredLayers i j 
  layerName layerNames lcBlockName lcLayerName LineWeightMedium LineWeightNone LineWeightThick 
  m ModelSpace n NumColumns NumRows Point3D_UCS Point3D_WCS Resultats ResultatsBlock ResultatsBlocks 
  ResultatsLayersBlocks row RowHeight textsize ThisDrawing total vlaBlocks vlaLayers vlaPoint3D 
  vlaTableau 
  )
  ;; Liste des calques et noms de bloc désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules
  ;; Le résultats est un tableau dont les titre de colonne sont les noms de bloc et les titres de rangée sont les calques.

  ;; Noms d'objets acceptés
  ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z
  (setq filteredLayers "*")     ; Tout
  (setq filteredBlockNames "*") ; Tout

  ;; Noms d'objets à exclure
  ;; Exemple pour calques: "" pour aucun, "*$*,*|*" pour tous ceux contenant un $ ou | (i.e. issu de xref)
  (setq excludedLayers "defpoint,*$*,*|*")     ; Exclure defpoint et ceux issus de Xrefs
  (setq excludedBlockNames "`**,*$*,*|*")      ; Exclure blocs anonymes et ceux issus de Xrefs

  ;; Exclusion de lignes ou rangées vides
  (setq excludeEmptyColumns t)                 ; Exclure du tableau si tous les items de la colonne sont 0
  (setq excludeEmptyRows t)                    ; Exclure du tableau si tous les items de la rangée sont 0

  ;; Taille du tableau
  (setq textsize (getvar "textsize"))          ; Voir cette variable qui contrôle la hauteur du texte
  (setq RowHeight (* 2.0 textsize))
  (setq ColWidth (* 10.0 RowHeight))           ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes
  (setq LineWeightThick acLnWt090)             ; Épaisseur de la ligne de séparation (voir LWDISPLAY)
  (setq LineWeightMedium acLnWt040)            ; Épaisseur de la ligne de séparation (voir LWDISPLAY)
  (setq LineWeightNone acLnWt000)              ; Épaisseur de la ligne de séparation (voir LWDISPLAY)

 
  ;; ======================================================================================================================
  ;; Ne pas modifier la suite du programme
  ;; ======================================================================================================================

  (setq filteredLayers (strcase filteredLayers t))  ; Minuscules
  (setq filteredBlockNames (strcase filteredBlockNames t))  ; Minuscules

  (setq acadObject (vlax-get-acad-object))
  (setq ThisDrawing (vla-get-ActiveDocument acadObject))
  (setq ModelSpace (vla-get-ModelSpace ThisDrawing))
  (setq vlaBlocks (vla-get-blocks ThisDrawing))
  (setq vlaLayers (vla-get-Layers ThisDrawing))

  ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table)
  ;; dont les paires sont (LayerName Count)

  (setq ResultatsBlocks nil)
  (setq BlockNames nil)
  (vlax-for vlaBlock vlaBlocks
     (setq blockName (GetBlockName vlaBlock))          ; Nom du bloc (accepte les blocs dynamiques.
     (setq lcBlockName (strcase blockName t))          ; Minuscules, blocs nommés
     (if (and 
            (wcmatch lcBlockName filteredBlockNames) 
            (not (wcmatch lcBlockName excludedBlockNames))
          ) 
        (setq BlockNames (cons lcBlockName BlockNames))
     )
  )
  (setq BlockNames (vl-sort BlockNames '<))  ; Trier en ordre croissant
  (setq ResultatsBlocks (mapcar '(lambda (x) (cons x 0)) BlockNames))

  (setq ResultatsLayersBlocks nil)
  (setq layerNames nil)
  (vlax-for vlaLayer vlaLayers
     (setq layerName (vla-get-name vlaLayer))
     (setq lcLayerName (strcase layerName t))          ; Minuscules
     (if (and 
            (wcmatch lcLayerName filteredLayers)
            (not (wcmatch lcLayerName excludedLayers))
         )
        (setq layerNames (cons lcLayerName layerNames))
     )
  )
  (setq layerNames (vl-sort layerNames '<))  ; Trier en ordre croissant
  (setq ResultatsLayersBlocks (mapcar '(lambda (x) (cons x ResultatsBlocks)) layerNames))

  (vlax-for vlaObject ModelSpace
     
     (if (and (= "AcDbBlockReference" (vla-get-ObjectName vlaObject))
              (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers)
              (wcmatch (setq blockName (strcase (GetBlockName vlaObject) t)) filteredBlockNames)
              (setq ResultatsBlocks (cdr (assoc layerName ResultatsLayersBlocks)))
              (setq ResultatsBlock (assoc blockName ResultatsBlocks))
         )
     (progn
        (setq Total (1+ (cdr ResultatsBlock)))
        (setq ResultatsBlocks (subst (cons blockName Total) (assoc blockName ResultatsBlocks) ResultatsBlocks)) 
        (setq ResultatsLayersBlocks (subst (cons layerName ResultatsBlocks) (assoc layerName ResultatsLayersBlocks) ResultatsLayersBlocks)) 
     ))
  )

  (if (and ResultatsLayersBlocks excludeEmptyRows)
  (progn
     ;; Nettoyage des lignes vides
     (setq ResultatsLayersBlocks (vl-remove-if '(lambda (x) (= 0 (apply '+ (mapcar 'cdr (cdr x))))) ResultatsLayersBlocks))
  ))

  (if (and ResultatsLayersBlocks excludeEmptyColumns)
  (progn
     ;; Nettoyage des colonnes vides
     (setq j (length BlockNames))
     (while (> j 0)
        (setq j (1- j))
        (setq BlockName (nth j BlockNames))
        (if (= 0 (apply '+ (mapcar '(lambda (x) (cdr (nth j (cdr x)))) ResultatsLayersBlocks)))
        (progn
           (setq ResultatsLayersBlocks (mapcar '(lambda (x) (cons (car x) (vl-remove-if '(lambda (y) (= BlockName (car y))) (cdr x)))) ResultatsLayersBlocks))
           (setq BlockNames (vl-remove-if '(lambda (x) (= x BlockName)) BlockNames))
        ))
     )
  ))

  ;; Dessiner le tableau, s'il reste des calques et des blocs après épuration
  (if (> (* (length BlockNames) (length ResultatsLayersBlocks)) 0)
  (progn
    (setq NumRows (+ 2 (length ResultatsLayersBlocks)))     ; 2 lignes de titre
    (setq NumColumns (+ 1 (length BlockNames)))             ; 1 colonne de plus pour les noms de calque
    (setq Point3D_UCS (getpoint "\nPoint d'insertion: "))
    (setq Point3D_WCS (trans Point3D_UCS 1 0))  ; Si pas en WCS
    (setq vlaPoint3D (PointToVariant Point3D_WCS))
    (setq CurrentlayerWasLocked (= :vlax-true (vla-get-lock (vla-get-ActiveLayer ThisDrawing))))
    (if CurrentlayerWasLocked (vla-put-lock (vla-get-ActiveLayer ThisDrawing) :vlax-false))
    (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth))

    ;; Ligne 0
    (setq row 0)
    (setq column 0)
    (SetCellProperties vlaTableau row column "Résultats" textsize acMiddleCenter nil)

    ;; Ligne 1
    (setq row 1)
    (setq column 0)
    (while (< column (length BlockNames))
       (SetCellProperties vlaTableau row (1+ column) (nth column BlockNames) textsize acMiddleCenter (cons acHorzBottom LineWeightMedium))
       (setq column (1+ column))
    )

    ;; Lignes de résultat
    (setq i 0)
    (setq n (length ResultatsLayersBlocks))
    (while (< i n)
       (setq ResultatsBlocks (nth i ResultatsLayersBlocks))
       (setq row (+ i 2))  ; On saute les 2 lignes de titre

       ;; LayerName
       (setq column 0)
       (setq LayerName (car ResultatsBlocks))
       (SetCellProperties vlaTableau row column LayerName textsize acMiddleLeft nil)

       ;; Quantité
       (setq j 0)
       (setq m (length BlockNames))
       (setq ResultatsBlocks (cdr ResultatsBlocks))
       (while (< j m)
          (setq column (1+ j))  ; On saute la colonne des noms de calque
          (setq Count (cdr (nth j ResultatsBlocks)))
          (SetCellProperties vlaTableau row column (itoa Count) textsize acMiddleCenter nil)
          (setq j (1+ j))
       )

       (setq i (1+ i))
    )
    (if CurrentlayerWasLocked (vla-put-lock (vla-get-ActiveLayer ThisDrawing) :vlax-true))
  ))
  (princ)
)

(defun SetCellProperties (
  vlaTableau Row Column Texte TextHeight Alignment LineWeightPair
  )
  ;; Gère les propriétés populaires des cellules d'un tableau
  ;;    vlaTableau Row Column : Obligatoire, les autres sont facultatifs
  ;;    Row, Column : INT, base 0
  ;;    Alignment: INT, 
  ;;    LineWeightPair: nil, sinon (cons "AcGridLineType enum" "acad_lweight enum"), soit (cons Position Épaisseur)
  ;; Support pour Acad2006 et Acad2009
  (if LineWeightPair (vla-SetCellGridLineWeight vlaTableau Row Column (car LineWeightPair) (cdr LineWeightPair)))
  (if Alignment (vla-SetCellAlignment vlaTableau Row Column Alignment))
  (if TextHeight (vla-SetCellTextHeight vlaTableau Row Column TextHeight))
  (if Texte
     (if vla-SetCellValue 
        (vla-SetCellValue vlaTableau Row Column Texte) ; AutoCAD 2009
        (vla-SetText vlaTableau Row Column Texte)      ; AutoCAD 2006
     )
  )
)

;;; PointToVariant
;;; Conversion de Point2D ou Point3D en variant
(defun PointToVariant (
  point
/ arraySpace sArray
  )
  (setq arraySpace (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length point)))))
  (setq sArray (vlax-safearray-fill arraySpace point))
  (vlax-make-variant sArray)
)

;;; Obtenir le nom du bloc (accepte les blocs dynamiques)
(defun GetBlockName (vlaBlock)
  (if (vlax-property-available-p vlaBlock 'EffectiveName) (vla-get-EffectiveName vlaBlock) (vla-get-Name vlaBlock))
)

Serge

[Edité le 14/8/2008 par Serge]

BixenteLiz · le 14 août 2008

Salut serge

Merci pour ta réponse. Je n'ai pas encore pu essayer ce nouveau code et je n'aurais surement pas le temps la semaine prochaine non plus...

Un nouveau gros dossier est tombé sur mon bureau ce matin et m'oblige à laisser l'étude que je faisais actuellement en stand-by ...

Dès que j'aurais remis le nez dedans j'essaierai ce code et je te dirais ce que ça donne.

( Puis comme ça je te laisse tranquille pendant tes vacances ! )

Merci et bonnes vacances

Serge · le 14 août 2008

masterdisco,

Fait juste attention au fait que j'ai corrigé la version alors que tu étais en ligne. Il se peut que tu ait copié la première version (ce qui n'est pas mauvais), mais la version éditée tien compte que le calque courant peut être verrouillé (j'ai découvert cela en faisant d'autres tests).

Serge

Patrick_35 · le 14 août 2008

Salut serge

J'ai regardé ton code et j'aurai quelques questions si tu le permets

Je vois que tu définis cette variable

(setq LineWeightMedium acLnWt040)

Mais où peut-on trouver acLnWt040 ?

Je remarque que tu as aussi définit une fonction PointToVariant

Pourquoi ne pas utiliser (vlax-3d-point ...) ?

Une dernière chose.

Tu ne trouve pas que les tableaux d'autocad, lors de leur création puis modification via le lisp consomme énormément de ressources (surtout visible pour les très grands tableaux)

@+

Serge · le 15 août 2008

Salut Patrick,

a) Pour trouver acLnWt040, il suffit de regarder dans le fichier d'aide sous "Lineweight Property". Autres valeurs: acLnWtByLayer, acLnWtByBlock, acLnWtByLwDefault, acLnWt000, acLnWt005, acLnWt009, acLnWt013, acLnWt015, acLnWt018, acLnWt020, acLnWt025, acLnWt030, acLnWt035, acLnWt040, acLnWt050, acLnWt053, acLnWt060, acLnWt070, acLnWt080, acLnWt090, acLnWt100, acLnWt106, acLnWt120, acLnWt140, acLnWt158, acLnWt200, acLnWt211,

b) Je vais dorénavant utiliser vlax-3d-point . Puisque j'avais déjà fait jadis une fonction qui faisait le même travail avec le même effort, je ne m'étais jamais posé de question. Merci. Voici la partie corrigée (en tenant compte aussi d'une transformation conditionnelle)

Ligne 289

    (setq Point3D (getpoint "\nPoint d'insertion: "))
  (if (/= 1 (getvar "worlducs")) (setq Point3D (trans Point3D 1 0)))  ; Si pas en WCS
  (setq vlaPoint3D (vlax-3d-point Point3D))

c) Les tableaux sont relativement très gourmants mais c'est ce qui avait été demandé au départ. Une fois que le tableau est dessiné, il ne prend plus de mémoire et est beaucoup plus facile à éditer (surtout si on veut changer les largeurs de colonnes, la justification, etc. En revanche, un tableau fait à l'ancienne demande beaucoup plus de codes et comporte plus de risque d'erreur. Concernant la vitesse, j'ai du inclure 2 variables pour 'épurer' les lignes et les cellules vides, ainsi que des filtres d'inclusion et d'exclusion. Il n'est pas rare d'avoir des dessins avec 1000 calques et 100 blocs, ce qui aurait donné 100 000 cellules et AutoCAD aurait planté joyeusement (et même pour de plus petits tableaux). Avec les filtres, on obtient un tableau beaucoup plus compact.

d) Il y a quelque chose que j'aurais peut-être du faire: si le tableau est vide, je n'affiche pas de message pour l'indiquer. Voici un corectif (pour ne pas tout réécrire).

Ligne 334, avant

      (if CurrentlayerWasLocked (vla-put-lock (vla-get-ActiveLayer ThisDrawing) :vlax-true))
  ))

Ligne 334, après

       (if CurrentlayerWasLocked (vla-put-lock (vla-get-ActiveLayer ThisDrawing) :vlax-true))
  )
  (progn
     (princ "\nLe tableau est vide.")
  ))

e) Idéalement, les améliorations apportées à la routine c:tableau_Blocs devraient s'appliquer à c:tableau_Perimetres (fonction vlax-3d-point, vérification de l'état du calque, le wcs, les filtres d'exclusion, l'épuration des lignes vides, etc)

Serge

Patrick_35 · le 17 août 2008

Merci beaucoup Serge, c'est un plaisir

@+

Connexion

Lisp pour recopier longueur totale des polylignes d\'un calque dans un Textmult

Messages recommandés

BixenteLiz

BixenteLiz

BixenteLiz

lili2006

Patrick_35

Lisp69

Serge

thry0

lili2006

(gile)

BixenteLiz

lili2006

(gile)

BixenteLiz

(gile)

Serge

BixenteLiz

Serge

BixenteLiz

Serge

Patrick_35

Serge

Patrick_35

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante