TABLOBLO avec 1 contrainte

PHILPHIL · le 14 janvier 2010

hello tous

j'essaye de modifier le LISP de tramber

mais souci

je voudrais forcer le LISp a ne faire le tableau que avec les blocs dont je connais un bout du nom

ca doit bien se passer la ou j'ai surligner en jaune

mais ca a l'air de marcher avec une contrainte inverser

un tit coup de mains pour comprendre

a+

merci

phil

[Edité le 14/1/2010 par PHILPHIL]

(gile) · le 14 janvier 2010

Salut,

La version que tu essaye d'adapter (il y en a eu plusieurs répondant à des demandes différentes) propose soit de le lister une sélection, soit toute la collection.

Ta modification n'intervient que si l'utilisateur a choisi toute la collection en faisant Entrée. Elle est contenue dans l'expression (if col ...).

Si c'est ce que tu veux faire, il me semble que ton test est faux : il écarte les blocs qui contiennent parnombloc1.

Il faudrait écrire :

(if (and
     (wcmatch (setq name (vla-get-Name i)) (strcat "*" parnombloc1 "*"))
     (= :vlax-false (vla-get-IsXref i))
   )
 ....
)

et changer les filtres de sélection :

(list '(0 . "INSERT") (cons 2 (strcat "*" parnombloc1 "*")))

PHILPHIL · le 14 janvier 2010

HELLO GILE

merci ca marche

par contre je n'arrive tjrs pas a piger pourquoi

aussi bien "tabloblo" que "tabloblo1"

ne marchent pas quand ils sont charger avec le fichier "FAS"

et ne marche que si je les recharge a partir de VISUAL LISP

et tabloblo1 BUG si on met "*" comme partie du nom de bloc

ce qui permetrait de lister dans ce cas tous les blocs

apres un test il ne BUG pas mais il liste meme les nom de cotes, et autres trucs "insert"

a+

phil

 ;; TABLOBLO (Tramber)
;; Crée un tableau qui liste les blocs insérés (sélectionnés ou toute la collection)

(defun c:tabloblo1
      (/ libloc liidbloc ss col liref ptins tableVL cont row)
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )



 (setq parnombloc1 (getcfg "APPDATA/PARNOMBLOC1"))
 (setq	com1
 (getstring
   t
   (strcat
     "\nVEUILLEZ ENTRER UNE PARTIE DU NOM DES BLOCS A LISTER <"
     parnombloc1
     "> : "
   )
 )
 )


 
 (if (/= com1 "")
   (setq parnombloc1 com1)
 )
 (setcfg "APPDATA/PARNOMBLOC1" parnombloc1)
 (prompt
   "\nSélectionnez les blocs à lister ou "
 )
 (or (setq ss
     (ssget
       (list '(0 . "INSERT") (cons 2 (strcat "*" parnombloc1 "*")))
     )
     )
     (setq ss
     (ssget
       "_X"
       (list '(0 . "INSERT") (cons 2 (strcat "*" parnombloc1 "*")))
     )
    col	T
     )
 )
 (if ss
   (progn (vlax-for x (setq ss (vla-get-ActiveSelectionSet *acdoc*))
     (or (vlax-property-available-p x 'Path)
	 (setq liref
		(cons (if (vlax-property-available-p x 'EffectiveName)
			(vla-get-EffectiveName x)
			(vla-get-Name x)
		      )
		      liref
		)
	 )
     )
   )
   (vla-delete ss)
   )
 )
 (if col
   (vlax-for i	(vla-get-Blocks *acdoc*)
     (if (and (wcmatch	(setq name (vla-get-Name i))
		(strcat "*" parnombloc1 "*")
       )
       (= :vlax-false (vla-get-IsXref i))
  )
(setq libloc   (append libloc (list (vla-get-name i)))
      liidbloc (append liidbloc (list (vla-get-ObjectID i)))
)
     )
   )
   (setq libloc   (remove_doubles liref)
  liidbloc (mapcar '(lambda (x)
		      (vla-get-ObjectID
			(vla-item (vla-get-Blocks *acdoc*) x)
		      )
		    )
		   libloc
	   )
   )
 )
 (initget 1)
 (setq ptins (trans (getpoint "\nPoint d'insertion: ") 1 0))
 (setq	tableVL	(vla-addtable
	  (vla-get-modelspace
	    (vla-get-activedocument (vlax-get-acad-object))
	  )
	  (vlax-3d-point ptins)
	  (+ 2 (length libloc))
	  3
	  120			; Hauteur cellule
	  250			; Largeur cellule
	)
 )
 (vla-put-VertCellMargin tableVL 4.0)	; Marge verticale
 (vla-put-TitleSuppressed tableVL :vlax-false)
 (vla-put-HeaderSuppressed tableVL :vlax-false)
 (vla-setText tableVL 0 0 "Blocs")	; Titre
 (vla-setText tableVL 1 0 "Nom")	; Titre colonne 1
 (vla-setText tableVL 1 1 "Nombre")	; Titre colonne 2
 (vla-setText tableVL 1 2 "Symbole")	; Titre colonne 3
 (setq	cont -1
row 1
 )
 (repeat (- (vla-get-Rows tableVL) 2)
   (vla-settext
     tableVL
     (setq row (1+ row))
     0
     (nth (setq cont (1+ cont)) libloc)
   )
   (vla-settext
     tableVL
     row
     1
     (length (vl-remove-if-not
	'(lambda (n) (= n (nth cont libloc)))
	liref
      )
     )
   )
   (vla-SetBlockTableRecordId
     tableVL
     row
     2
     (nth cont liidbloc)
     :vlax-true
   )
   (vla-setcellalignment tableVL row 0 5)
   (vla-setcellalignment tableVL row 1 5)
 )
 (princ)
)

[Edité le 14/1/2010 par PHILPHIL]

PHILPHIL · le 14 janvier 2010

hello

je voudrais que le tableau soit dans l'ordre alphabetique

j'ai bien essayé ca un peu partout dans le lisp mais ca ne marche pas

 (setq liref (acad_strlsort libloc))

ou ca

 (setq liref (acad_strlsort liref))

mais si la liste est dans l'ordre des fois les blocs ne corespondent plus aux noms de blocs

zarbiii tous ca

a+

phil

(gile) · le 14 janvier 2010

Normal, le LISP fonctionne avec 2 listes : libloc et liidbloc et tu changes l'ordre d'une liste sans changer celui de l'autre...

Une solution serait de ne faire qu'une liste de paire pointée (NomDuBloc . IdDuBloc) :

remplacer :

(setq libloc   (append libloc (list (vla-get-name i)))
     liidbloc (append liidbloc (list (vla-get-ObjectID i)))
)

par

(setq libloc (cons (cons (vla-get-name i) (vla-get-ObjectID i)) libloc))

et

(setq libloc   (remove_doubles liref)
     liidbloc (mapcar '(lambda (x)
                         (vla-get-ObjectID
                           (vla-item (vla-get-Blocks *acdoc*) x)
                         )
                       )
                      libloc
              )
)

par

(setq libloc (remove_doubles liref)

libloc (mapcar '(lambda (x)

(cons x (vla-item (vla-get-Blocks *acdoc*) x))

)

libloc

)

puis trier la liste :

(setq libloc (vl-sort libloc '(lambda (x1 x2) (

 
et enfin dans le remplissage du tableau remplacer tous les :
[code](nth cont libloc)

PHILPHIL · le 15 janvier 2010

hello gile

doit y avoir un tit souci dans la liste

le tableau est a chaque fois vide

LA LISTE est dans l'ordre ca Ok

a+

phil

[Edité le 18/1/2010 par PHILPHIL]

(gile) · le 15 janvier 2010

Sans regarder plus avant, tu as oublié de remplacer :

(nth (setq cont (1+ cont)) libloc)

par

(car (nth (setq cont (1+ cont)) libloc))

PHILPHIL · le 15 janvier 2010

HELLO GILE

ok le tableau remplit sauf le probleme avec la selection des objets

mais vue que ca marche pour le tableau en validant direct je vais chercher pour

le tableau en selectionnant

je viendrait mettre la correction du lisp une fois reussis

merci gile

a+

phil

PHILPHIL · le 17 janvier 2010

HELLO

bon finallement le visulalips c'est pas encore ca

je pige que dalle

donc ca ne marche pas pour le tableau en selectionnant

sauf pour la tableau en demandant tout

desolé

a+

phil

(gile) · le 17 janvier 2010

Le problème n'avait pas de rapport avec Visual LISP. C'était juste un soucis dans la manipulation des listes.

Je te donnes une version un peu plus simple : j'ai supprimé la liste liidbloc qui ne servait en fait pas à grand chose.

(defun c:tabloblo2 (/ blocks libloc ss col liref ptins tableVL cont row blk)
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (setq blocks (vla-get-Blocks *acdoc*))
 
 (setq parnombloc1 (getcfg "APPDATA/PARNOMBLOC1"))
 (setq com1
        (getstring
          t
          (strcat
            "\nVEUILLEZ ENTRER UNE PARTIE DU NOM DES BLOCS A LISTER              parnombloc1
            "> : "
          )
        )
 )
 
 (if (/= com1 "")
   (setq parnombloc1 com1)
 )
 (setcfg "APPDATA/PARNOMBLOC1" parnombloc1)

 (setq test (strcat "*" parnombloc1 "*"))

 (prompt (strcat
           "\nle bout du nom de bloc est  : "
           test
         )
 )

 (prompt
   "\nSélectionnez les blocs à lister ou "
 )
 (or (setq ss
            (ssget
              (list '(0 . "INSERT") (cons 2 (strcat "*" parnombloc1 "*")))
            )
     )
     (setq ss
            (ssget
              "_X"
              (list '(0 . "INSERT") (cons 2 (strcat "*" parnombloc1 "*")))
            )
           col T
     )
 )
 (if ss
   (progn (vlax-for x (setq ss (vla-get-ActiveSelectionSet *acdoc*))
            (or (vlax-property-available-p x 'Path)
                (setq liref
                       (cons (if (vlax-property-available-p x 'EffectiveName)
                               (vla-get-EffectiveName x)
                               (vla-get-Name x)
                             )
                             liref
                       )
                )
            )
          )
          (vla-delete ss)
   )
 )

 (if col
   (vlax-for i (vla-get-Blocks *acdoc*)
     (if (and (wcmatch (setq name (vla-get-Name i))
                       (strcat "*" parnombloc1 "*")
              )
              (= :vlax-false (vla-get-IsXref i))
         )
       (setq libloc (cons (vla-get-name i) libloc))

     )
   )

   (setq libloc (remove_doubles liref))
 )

 (setq libloc (vl-sort libloc '
 (initget 1)
 (setq ptins (trans (getpoint "\nPoint d'insertion: ") 1 0))
 (setq tableVL (vla-addtable
                 (vla-get-modelspace
                   (vla-get-activedocument (vlax-get-acad-object))
                 )
                 (vlax-3d-point ptins)
                 (+ 2 (length libloc))
                 3
                 120                             ; Hauteur cellule
                 250                             ; Largeur cellule
               )
 )
 (vla-put-VertCellMargin tableVL 4.0)            ; Marge verticale
 (vla-put-TitleSuppressed tableVL :vlax-false)
 (vla-put-HeaderSuppressed tableVL :vlax-false)
 (vla-setText tableVL 0 0 "Blocs")               ; Titre
 (vla-setText tableVL 1 0 "Nom")                 ; Titre colonne 1
 (vla-setText tableVL 1 1 "Nombre")              ; Titre colonne 2
 (vla-setText tableVL 1 2 "Symbole")             ; Titre colonne 3
 (setq cont -1
       row 1
 )
 (repeat (- (vla-get-Rows tableVL) 2)
   (setq blk (nth (setq cont (1+ cont)) libloc))
   ;; Nom du bloc (colonne A)
   (vla-settext
     tableVL
     (setq row (1+ row))
     0
     blk
   )
   ;; Nombre de blocs (colonne B)
   (vla-settext
     tableVL
     row
     1
     (length (vl-remove-if-not
               '(lambda (n) (= n blk))
               liref
             )
     )
   )
   ;; Symbole (colonne C)
   (vla-SetBlockTableRecordId
     tableVL
     row
     2
     (vla-get-ObjectId (vla-item blocks blk))
     :vlax-true
   )
   (vla-setcellalignment tableVL row 0 5)
   (vla-setcellalignment tableVL row 1 5)
 )
 (princ)
)

PHILPHIL · le 17 janvier 2010

hello gile

merci

juste le smiley qui fait "ch..." en plein milieu

il cache quoi le smiley ??

a+

phil

(gile) · le 17 janvier 2010

J'ai désactivé les smileys.

Si tu veux avoir le code original, tu peux cliquer sur le bouton "Citer" du message...

PHILPHIL · le 17 janvier 2010

hello

merci gile

celui ci marche

il sufit de mettre une etoile "*" comme bout de nom pour tout prendre en compte

attention plus il y a de bloc plus ca prend de temps

au 250 ieme bloc le tableau met 10 secondes par ligne pour se remplir

et ca va en augnentant

a+

phil

 (defun c:tabloblo4 (/ blocks libloc ss col
;;; liref
ptins tableVL cont row blk)
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (setq blocks (vla-get-Blocks *acdoc*))
 (setq liref nil)
 (setq parnombloc1 (getcfg "APPDATA/PARNOMBLOC1"))
 (setq com1
        (getstring
          t
          (strcat
            "\nVEUILLEZ ENTRER UNE PARTIE DU NOM DES BLOCS A LISTER <"
            parnombloc1
            "> : "
          )
        )
 )

 (if (/= com1 "")
   (setq parnombloc1 com1)
 )
 (setcfg "APPDATA/PARNOMBLOC1" parnombloc1)

;  (setq test (strcat "*" parnombloc1 "*"))

;; (prompt (strcat
  ;;         "\nle bout du nom de bloc est  : "
    ;;       test
     ;;    )
;;  )

 (prompt
   "\nSélectionnez les blocs à lister ou "
 )
 (or (setq ss
            (ssget
              (list '(0 . "INSERT") (cons 2 (strcat "*" parnombloc1 "*")))
            )
     )
     (setq ss
            (ssget
              "_X"
              (list '(0 . "INSERT") (cons 2 (strcat "*" parnombloc1 "*")))
            )
           col T
     )
 )
 (if ss
   (progn (vlax-for x (setq ss (vla-get-ActiveSelectionSet *acdoc*))
            (or (vlax-property-available-p x 'Path)
                (setq liref
                       (cons (if (vlax-property-available-p x 'EffectiveName)
                               (vla-get-EffectiveName x)
                               (vla-get-Name x)
                             )
                             liref
                       )
                )
            )
          )
          (vla-delete ss)
   )
 )

 (if col
   (vlax-for i (vla-get-Blocks *acdoc*)

     (if (= parnombloc1 "*")
           (if (and (not (wcmatch (setq name (vla-get-Name i)) "`**,*|*"))
                  (= :vlax-false (vla-get-IsXref i))
             )
           (setq libloc (cons (vla-get-name i) libloc))
         )
         (if (and (wcmatch (setq name (vla-get-Name i))
                           (strcat "*" parnombloc1 "*")
                  )
                  (= :vlax-false (vla-get-IsXref i))
             )
           (setq libloc (cons (vla-get-name i) libloc))
         )
     
     )




   )

   (setq libloc (remove_doubles liref))
 )

 (setq libloc (vl-sort libloc '<))

 (initget 1)
 (setq ptins (trans (getpoint "\nPoint d'insertion: ") 1 0))
 (setq tableVL (vla-addtable
                 (vla-get-modelspace
                   (vla-get-activedocument (vlax-get-acad-object))
                 )
                 (vlax-3d-point ptins)
                 (+ 2 (length libloc))
                 3
                 120                             ; Hauteur cellule
                 250                             ; Largeur cellule
               )
 )
 (vla-put-VertCellMargin tableVL 4.0)            ; Marge verticale
 (vla-put-TitleSuppressed tableVL :vlax-false)
 (vla-put-HeaderSuppressed tableVL :vlax-false)
 (vla-setText tableVL 0 0 "Blocs")               ; Titre
 (vla-setText tableVL 1 0 "Nom")                 ; Titre colonne 1
 (vla-setText tableVL 1 1 "Nombre")              ; Titre colonne 2
 (vla-setText tableVL 1 2 "Symbole")             ; Titre colonne 3
 (setq cont -1
       row 1
 )

 (SETQ nbobj (+ 1 (length libloc)))

 (repeat (- (vla-get-Rows tableVL) 2)
   (setq blk (nth (setq cont (1+ cont)) libloc))
   ;; Nom du bloc (colonne A)
   (vla-settext
     tableVL
     (setq row (1+ row))
     0
     blk
   )
   ;; Nombre de blocs (colonne B)
   (vla-settext
     tableVL
     row
     1
     (length (vl-remove-if-not
               '(lambda (n) (= n blk))
               liref
             )
     )
   )
   ;; Symbole (colonne C)
   (vla-SetBlockTableRecordId
     tableVL
     row
     2
     (vla-get-ObjectId (vla-item blocks blk))
     :vlax-true
   )
   (vla-setcellalignment tableVL row 0 5)
   (vla-setcellalignment tableVL row 1 5)

   (prompt
     (strcat "\rENTITE TRAITEE : " (rtos row 2 0) " SUR : " (rtos nbobj 2 0))
   )
 )
 (princ)
)

[Edité le 17/1/2010 par PHILPHIL]

TABLOBLO avec 1 contrainte

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante