récupération liste de calque

[-Olivier-]

Bonjour à tous,

 

Sur un dossier, j'ai une charte graphique à respecter avec une longue liste de calque sur excel. Cette liste comprend notamment les noms, couleur et définition.

Comment je peux la récupérer sous Autocad sans tout réécrire ?

 

A+

 

Olivier

[Goldorak44]

Salut,

 

voici un lisp qui qui permet d'injecter des calques dans Autocad avec la couleur et le type de ligne défini dans Excel :

 

(defun C:layersacad (/ 
 ExclAppl WrkbsExcl strFicXLS AwkbExcl AsheExcl CellsAshe intRow intColumn RangAshe strCalque strRepXLS blnWrkbOpen blnExclOpen
 strLineType intCouleur strCouleur
 )
 (defun CP_:XlsExistWorkbook (WrkbsExcl strFicXLS /
   intNbWs intW blnExist WrkbExcl strFullName vntRetour   
   )
   (setq intNbWs (vlax-get-property WrkbsExcl 'Count)) 
   (setq blnExist nil)
   (setq intW 1) 
   (repeat intNbWs
     (setq WrkbExcl (vlax-get-property WrkbsExcl 'Item intW))
     (setq strFullName (vlax-get-property WrkbExcl 'FullName))
     (cond
       ((= (strcase strFullName)(strcase strFicXLS))
          (setq blnExist WrkbExcl)
       )
       (T
       
       )
     )
     (setq intW (1+ intW)) 
   )
   (setq vntRetour blnExist)
 )  
 (vl-load-com)
 (setq blnExclOpen T)
 (setq ExclAppl (vlax-get-object "Excel.Application"))
 (if (null ExclAppl)
   (progn
     (setq blnExclOpen nil)
     (setq ExclAppl (vlax-create-object "Excel.Application"))
   )
 )
 (setq WrkbsExcl (vlax-get-property ExclAppl 'Workbooks))

 (setq strRepXLS "C:\\")

 (setq strFicXLS (getfiled "Sélection d'un fichier XLS" strRepXLS "XLS" 8))
 (cond
   ((null strFicXLS)

   )
   (T
      (setq blnWrkbOpen T)
      (if (null (setq AwkbExcl (CP_:XlsExistWorkbook WrkbsExcl strFicXLS)))
        (progn
          (setq blnWrkbOpen nil)
          (setq AwkbExcl (vlax-invoke-method WrkbsExcl 'Open strFicXLS))
        )
      )
      
      (setq AsheExcl (vlax-get-property ExclAppl 'ActiveSheet))
      (setq CellsAshe (vlax-get-property AsheExcl 'Cells))
      (setq intRow 2)
      (setq intColumn 1)
      (setq RangAshe (vlax-variant-value (vlax-get-property CellsAshe 'Item intRow intColumn)))
      (setq strCalque (vlax-variant-value (vlax-get-property RangAshe 'Value)))
      (setq intColumn 2)
      (setq RangAshe (vlax-variant-value (vlax-get-property CellsAshe 'Item intRow intColumn)))
      (setq strCouleur (vlax-variant-value (vlax-get-property RangAshe 'Value)))
      (setq intColumn 3)
      (setq RangAshe (vlax-variant-value (vlax-get-property CellsAshe 'Item intRow intColumn)))
      (setq strLineType (vlax-variant-value (vlax-get-property RangAshe 'Value)))
      (setvar "CMDECHO" 0)
      (while strCalque
        (setq strCouleur (fix strCouleur))
        (cond
          ((null (tblsearch "LAYER" strCalque))
             (command "._-LAYER" "_N" strCalque "")
          )
          (T
          
          )
        )
        (command "._-LAYER" "_CO" (fix strCouleur) strCalque "")
        (cond
          ((null (tblsearch "LTYPE" strLineType))
             (command "._-LINETYPE" "_L" strLineType "ACADISO.LIN" "")
          )
          (T
          
          )
        )
        (command "._-LAYER" "_LT" strLineType strCalque "")
        
        (setq intRow (1+ intRow))
        (setq intColumn 1)
        (setq RangAshe (vlax-variant-value (vlax-get-property CellsAshe 'Item intRow intColumn)))
        (setq strCalque (vlax-variant-value (vlax-get-property RangAshe 'Value)))
        (setq intColumn 2)
        (setq RangAshe (vlax-variant-value (vlax-get-property CellsAshe 'Item intRow intColumn)))
        (setq strCouleur (vlax-variant-value (vlax-get-property RangAshe 'Value)))
        (setq intColumn 3)
        (setq RangAshe (vlax-variant-value (vlax-get-property CellsAshe 'Item intRow intColumn)))
        (setq strLineType (vlax-variant-value (vlax-get-property RangAshe 'Value)))
      )
      (setvar "CMDECHO" 1)
      (if (null blnWrkbOpen)
        (progn
          (vlax-invoke-method AwkbExcl 'Close)
        )
      )
      (if (null blnExclOpen)
        (progn
          (vlax-invoke-method ExclAppl 'Quit)
          (vlax-release-object ExclAppl)
          (gc)
        )
      )
   )
 )
 (princ)
)

 

A adapter en fonction de ton fichier excel ! ;)

[-Olivier-]

Bonjour Goldorak44,

Je vais regarder ça.

Merci ! :)

[philsogood]

hello

sinon t'as la solution excel puis lisp

ça amrche super bien

je m'en sers également pur geler des calques dans les rpésentations...

très pratique

http://cjoint.com/14av/DDepJNvAr26.htm