AIDE SOMMAIRE AUTOMATIQUE

[sada20]

Bonjour,

je souhaiterais ajouter 3 pages supplémentaires aux 3 pages de sommaires déja présente dans ce lisp afin d'en obtenir 6 au cas, car j'ai beaucoup de pages parfois.

Pourriez vous également m'indiquer comment chacun des étape de ce lisp, je n'y connais rien et souhaiterais apprendre calmement. Si vous avez besoin des blocs n'hésitez pas.

 

(defun c:SOMI (/ _insert _AddNextTab CopytoLayout ThetabOrder data tagOrder _filter NLay TB existData
                data layName ipt _layouts attb _Attb  layName indx 1lay 2lay ts as _AddData)
;;;            pBe 2020                ;;;
(defun _insert (bn pt spc)
    (vlax-invoke (vlax-get spc 'Block) 'InsertBlock pt bn 1 1 1 0)
  )
  
(defun _AddNextTab (doc lnm / nlay)
    (if (vl-catch-all-error-p
                (setq nlay (vl-catch-all-apply
                               (function vla-item)
                                 (list (vla-get-Layouts doc) lnm))))            
            (setq nlay (vla-Add (vla-get-Layouts doc) lnm)))
      )
  
(defun CopytoLayout (l1 l2 l3 l4 doc _O nx / NLay ObjLst)  
 (mapcar '(lambda  (v fn fns)            
    (or ObjLst
      (vlax-for obj (vlax-get (vla-item (vla-get-Layouts doc) l1) 'Block)
          (setq ObjLst (cons Obj ObjLst)))
        )
    (setq NLay (vla-Add (vla-get-Layouts doc) v))
      (vla-CopyObjects doc
            (vlax-make-variant
              (vlax-safearray-fill
                (vlax-make-safearray vlax-vbObject
                  (cons 0 (1- (length ObjLst))))
                (reverse ObjLst)))
            (vla-get-Block NLay))
    
    (foreach lay (eval fn)
      (vla-put-taborder
        (vla-item (vla-get-Layouts doc) lay)
        nx
      )
      (setq nx (1+ nx))
    )
    (_AddData v fns)        
    (setq _O (mapcar 'car (setq ordr
             (vl-sort (cddr (ThetabOrder (vla-get-Layouts doc)))
                  '(lambda (n m)(< (Cdr n)(cdr m))))
               ))
      nx (cdr (assoc (Car _O) ordr)))
    )
     l2 l3 l4)
  )

(defun _filter (g / f fdata)
       (foreach    itm tagOrder (if (Setq f (assoc itm g))
                   (setq fdata (cons f fdata))
                 )
                   )
          fdata
  )
(defun _AddData ( _lay _fn / Adata attb)
(if
  (and
      (setq Adata (ssget "_x" (append SelFil (list (cons 410 _lay)))))
    (setq attb (_filter (_Attb (setq Adata (ssname Adata 0)))))
    )
    (progn      
            (foreach itm (list (cons "FOL" _lay) '("IND" . "A"))
              (if (assoc (car itm) attb)
                  (setpropertyvalue Adata (car itm) (cdr itm))))
            (setq data (Eval _fn))
      )  
      )
  )
  
(setq ThetabOrder
       (lambda (l / lst)
     (vlax-for lay l
       (setq lst (cons (cons (vla-get-name lay)
                 (vla-get-taborder lay)
               )
               lst
             )
           )
         )
           )
    )
  
(setq _Attb (lambda (v)
          (mapcar
          '(lambda (At)
             (list (Vla-get-tagstring at)
               (itoa (Vla-get-objectID  at))
             )
           )
          (vlax-invoke (vlax-ename->vla-object v) 'GetAttributes)
        )
          )
      )
  
(setq Nsheet (lambda (n) (vl-string-subst n "a"  1lay)))  
(setq aDoc (vla-get-activedocument (vlax-get-acad-object))
      _layouts (vla-get-layouts aDoc)
      ipt '(0.0 275.0 0.0)
      Order (ThetabOrder _Layouts)
      tagOrder '("FOL" "TITRE1" "TITRE2" "DATE" "IND")
      m 28  SelFil '((0 . "INSERT") (66 . 1) (2 . "CFA-F_A3_2014"))
      )
  
  (if
    (and
            (vl-every '(lambda (b)
             (tblsearch "BLOCK" b)) '("SOMMAIRE_HEADER" "SOMMAIRE_DATA"))
          (setq data nil TB (ssget "X" SelFil))
      )
     (progn
        (if (setq existData (ssget "_X" '((2 . "SOMMAIRE_DATA"))))
          (repeat (sslength existData)
          (setq e (ssname existData 0))
          (entdel e)(ssdel e existData))
          )       
      
    (repeat (setq i (sslength TB))
     (setq layName
        (cdr
          (assoc 410
             (entget (setq e (ssname TB (setq i (1- i)))))
          )
        )
     )
     (setq attb (_Attb e))
     (setq Data (Cons (list (Cdr (assoc layName Order)) layName attb)
              DAta
            )
          )
    )
     (setq data (mapcar '(lambda (d / fdata) (Setq g (Caddr d))
                   (setq fdata (_filter g))
                   (list (car d)(cadr d) (reverse fdata))
                 )  data )
           data (vl-sort data '(lambda (a b) (< (car a) (car b))))
           _Order (mapcar 'cadr data)
           indx (caar data)
           1lay (cadar data)
           2lay (Nsheet "b")
           3Lay (Nsheet "c")
           data (mapcar 'caddr data)
                ts '(append (list (car _O) v) (cdr _O))
            as '(append (list (car data) attb) (cdr data)))
       
    (cond
       (    (and (> (setq llength (length data)) ( * m 2.0) )
             (not (member 3Lay (layoutlist))))
            (CopytoLayout 1lay (list 2lay 3Lay)
                  (list ts '(append (list (car _O)(cadr _O) v) (cddr _O)))
                          (list as '(append (list (car data)
                               (cadr data) attb) (cddr data)))
                      aDoc _Order indx)
                )
       (    (and (> llength m)
             (not (member 2lay (layoutlist))))        
               (CopytoLayout 1lay (list 2lay)(list ts)
                          (list as) aDoc _Order indx)
               )
          )
       
     (foreach itm data
       (if (<= (cadr ipt) 41.0)
              (setq ipt '(0.0 275.0 0.0) 1lay 2lay
                2lay (vl-string-subst "c" "b"  2lay)))
       
       (setq atbv (_insert  "SOMMAIRE_DATA" ipt (Vla-item _layouts 1lay)))       
       (foreach atv (Vlax-invoke atbv 'GetAttributes)
         (if (setq f (assoc (vla-get-tagstring atv) itm))
               (vla-put-textstring atv (strcat 
                           "%<\\AcObjProp Object(%<\\_ObjId "
                            (cadr f) ">%).TextString \\f \"%tc1\">%"))))       
       (setq ipt (polar ipt (* pi 1.5) 9.0))
     )
       )
    (princ "\n<<< Support block(s) not found | Null Selection >>>")
     )
  (princ)
)