Utilisation du LISP SOM de Patrick_35

[krolin]

Bonjour,

j'ai récupéré sur le net le lisp SOM de Patrick_35 et j'arrive à le faire fonctionner partiellement.

J'ai créer mon cartouche dénommé "cartouche", avec les attributs NUMPLAN, NUMFOLIO, TITRE1, TITRE2, un calque "CARTOUCHES".

Lorsque je lance la commande "SOM", cela me fait seulement apparaitre les données du cartouche de la première présentation. Donc une seule ligne dans la liste des documents.

Comment faire pour que la commande aille chercher les info également dans les autres onglets?

En vous remerciant de votre aide.

[Luna]

Coucou,
Je pense qu'il existe plusieurs version du LISP SOM sur le net, donc cela serait plus simple de savoir avec quelle version tu travailles. Un .dwg nous permettrait également de tester les modifications à apporter pour toi.

Bisous,
Luna

[iowa13]

Il y a une erreur dans ton lisp.

J'ai eu le même soucis.

J'essaie de l'adapter à mon fichier, mais je coince complètement...

Voici mon ébauche. C'est un peu capricieux, il faut parfois regénérer les onglets.

(vl-load-com)
;;;=================================================================
;;;
;;; SOM.LSP V1.00
;;;
;;; Sommaire
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun c:som(/ att doc ent fol ind js ef lay lign lst n old rec rect saut y)

  (defun rect(x y pas)
    (entmake (list	(cons   0 "LWPOLYLINE")
			(cons 100 "AcDbEntity")
			(cons 100 "AcDbPolyline")
			(cons  90 4)
			(cons  70 1)
			(cons  10 (list x y 0.0))
			(cons  10 (list (+ x 186) y 0.0))  			;longeur ligne haut tableau
			(cons  10 (list (+ x 186) (- y pas) 0.0))   ;longueur ligne basse tableau
			(cons  10 (list x (- y pas ) 0.0))
			(cons   6 "BYLAYER")
			(cons   8 "CARTOUCHES")
			(cons  62 256)
			(cons  67 1)
			(cons 370 -1)
			(cons 410 "000-1")
	      )
    )
  )

  (defun text(x y txt att)
    (entmake (list	(cons   0 "MTEXT")
			(cons 100 "AcDbEntity")
			(cons 100 "AcDbMText")
			(cons   1 txt)
			(cons   6 "BYLAYER")
			(cons   7 "ARIAL")
			(cons   8 "CARTOUCHES")
			(cons  10 (list x y 0.0))
			(cons  11 (list 0.0 0.0 0.0))
			(cons  40 3.0)
			(cons  50 0.0)
			(cons  62 256)
			(cons  67 1)
			(cons  71 att)
			(cons  72 1)
			(cons 370 -1)
			(cons 410 "000-1")
	      )
    )
  )

  (defun lign(x x1 y y1)
    (entmake (list	(cons   0 "LINE")
			(cons 100 "AcDbEntity")
			(cons 100 "AcDbLine")
			(cons  10 (list x y 0.0))
			(cons  11 (list (+ x x1) (+ y y1) 0.0))
			(cons   6 "BYLAYER")
			(cons   8 "CARTOUCHES")
			(cons  62 256)
			(cons  67 1)
			(cons 370 -1)
			(cons 410 "000-1")
	      )
    )
  )

  (if (setq js (ssget "x" (list (cons 0 "INSERT") (cons 2 "cartouche"))))
    (progn
      (setq ef (ssget "x" (list (cons 410 "000-1")
			  )
	       )
	    doc (vla-get-activedocument (vlax-get-acad-object))
	    lay (vla-item (vla-get-layers doc) "CARTOUCHES")
	    old (vla-get-lock lay)
 	    n 0
      )
      (vla-startundomark doc)
      (vla-put-lock lay :vlax-false)
      (if ef
	(while (setq ent (ssname ef n))
	  (if (not (eq (cdr (assoc 2 (entget ent))) "cartouche"))
	    (entdel ent)
	    (setq ind (vlax-ename->vla-object ent))
	  )
	  (setq n (1+ n))
	)
      )
    ;  (if ind
	;(foreach n (vlax-invoke ind 'getconstantattributes)
	;  (if (eq (vla-get-tagstring n) "IND")
	;    (setq ind (vla-get-textstring n))
	;  )
	;)
     ; )
      (setq n 0 lst '())
      (while (setq ent (ssname js n))
	(setq fol '())
	(foreach att (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
	  (cond
	    ((eq (vla-get-tagstring att) "NUMPLAN")
	      (setq rec (cons 0 (vla-get-textstring att)))
	    )
	    ((eq (vla-get-tagstring att) "NUMFOLIO")
	      (setq rec (cons 1 (vla-get-textstring att)))
	    )
	    ((eq (vla-get-tagstring att) "TITRE1")
	      (setq rec (cons 2 (vla-get-textstring att)))
	    )
	    ((eq (vla-get-tagstring att) "IND")
	      (setq rec (cons 3 (vla-get-textstring att)))
	    )
		((eq (vla-get-tagstring att) "DATE")
	      (setq rec (cons 4 (vla-get-textstring att)))
	    )
	  )
	  (setq fol (cons rec fol))
	)
	(setq fol (list (cdr (assoc 0 fol))
			(cdr (assoc 1 fol))
			(cdr (assoc 2 fol))
			(cdr (assoc 3 fol))
			(cdr (assoc 4 fol))
		  )
	)
	(if (not (member fol lst))
	  (setq lst (cons fol lst))
	)
	(setq n (1+ n))
      )
      (setq lst (vl-sort lst '(lambda (a b) (if (= (car a) (car b))
					      (< (cadr a) (cadr b))
					      (< (car a) (car b))
					    )
			      )
	        )
	    x 211.0 ;position horizontal du tableau
	    y (+ (/ (- (* (+ (length lst) 3) 4) 236) 2) 279)  ;voir avec hauteur position tableau
      )
      (rect x y 10) ;hauteur du cadres dans le tableau de titre
      (foreach n (list 86 98 108 120 ) ;position des lignes du tableaux des titres.
	(lign (+ x n) 0 y -10) ;hauteur des lignes dans le tableau de titre
      )
      (text (+ x 16) (- y 5) "LISTE DES DOCUMENTS" 5)
      (text (+ x 92) (- y 5) "N° PLAN" 5)
      (text (+ x 103) (- y 5) "FOLIO" 5)
      (text (+ x 114) (- y 5) "INDICE" 5)
	  (text (+ x 128) (- y 5) "DATE" 5)
     
;	 (foreach n (list 1 2 3 4 5 6)	(text (+ x 104 (* n 4)) (- y 6) (itoa n) 5)      )
     
	 (setq y (- y 12))
      (rect x y (* (length lst) 8))
      (foreach n (list 86 98 108 120);110 114 118 122 126
	(lign (+ x n) 0 y (- (* (length lst) 8))) ;en rapport avec longueur ligne vertical
      )
      (foreach txt lst
	(text (+ x 112.5) (- y 2) 
	
	(if (not (member (cadddr txt) (list "" "-")))
				  ;(strcat (caddr txt) " - " (cadddr txt))
				  (caddr txt) 
				)
				16 ;en rapport avec centrage vertical si 8 hauteur ligne, mettre 16 car -y2 plus haut
	)

	(text (+ x 92) (- y 2) (car txt) 5)  ;position des textes dans le titre
	
	(text (+ x 103) (- y 2) (cadr txt) 5)
	
	
	(text (+ x 114) (- y 2) (cadddr txt) 5)
	
	
	(text (+ x 128) (- y 2) (caddr txt) 5)
	
	
	;(text (+ x 104 (* (atoi ind) 4)) (- y 2) "cadr txt" 5)
	
	(if saut
	  (lign x 186 y 0) ;longueur ligne tableau
	)
	(setq y (- y 8) saut T)  ;hauteur des cellules du 2eme tableau
      )
      (vla-put-lock lay old)
      (vla-endundomark doc)
      (princ "\nSommaire effectué.")
    )
    (princ "\nPas de plans.")
  )
  (princ)
)

(setq nom_lisp "SOM")
(if (/= app nil)
  (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
    (princ (strcat "..." nom_lisp " chargé."))
    (princ (strcat "\n" nom_lisp ".LSP Chargé.....Tapez " nom_lisp " pour l'éxecuter.")))
  (princ (strcat "\n" nom_lisp ".LSP Chargé......Tapez " nom_lisp " pour l'éxecuter.")))
(setq nom_lisp nil)
(princ)

 

si des âmes charitables pouvaient m'en dire plus.?

EXEMPLE-1.dwg