MOUV

[salvanorigatore]

Bonjour a tous,

j'ai récupéré un jour sur un site (cadxp peut-être ...) le lisp ci dessous dont je me sert de tant en tant, ils sert a concaténer plusieurs dwg en 1 seul.

On sélectionne le premier fichier (tous les fichiers se trouvant dans le même dossier) et ensuite il les concatène dans le même fichier en les collant les uns après les autres.

Est ce que quelqu'un pourrait le modifier afin que je puisse choisir la distance ou le pas de concaténation ?

Merci beaucoup d'avance.

Bon WE

 

((lambda ( / prefix pt_ins last_pt obj ll ur lg)
(setvar "cmdecho" 0)
(setvar "attreq" 0)
(vl-load-com)
(setq prefix (strcat (vl-filename-directory (getfiled "Sélectionner un fichier DWG TEMOIN" "" "dwg" 16)) "\\"))
(setq pt_ins (getpoint "\nPoint d'insertion pour le 1er Bloc? <0.0,0.0,0.0>: "))
(if (null pt_ins) (setq pt_ins '(0.0 0.0 0.0)))
(setq last_pt nil)
(foreach dwg (vl-directory-files prefix "*.dwg" 1)
(command "_.-insert" (strcat "\"" prefix dwg "\"") "_none" pt_ins "1.0" "1.0" "0.0")
(setq Obj (vlax-ename->vla-object (entlast)))
(vla-GetBoundingBox Obj 'll 'ur)
(setq ll (safearray-value ll))
(setq ur (safearray-value ur))
(if last_pt
(progn
(command "_.move" (entlast) "" "_none" (list (car ll) (cadr pt_ins) (caddr pt_ins)) "_none" pt_ins)
(setq lg (distance (list (car ll) (cadr pt_ins) (caddr pt_ins)) pt_ins))
)
(setq lg 0.0)
)

(setq pt_ins (list (+ lg (car ur)) (cadr pt_ins) (caddr pt_ins)))
(setq last_pt pt_ins)
)
(command "_.zoom" "_all")
(command "_.zoom" "_extents")
(setvar "attreq" 1)
(setvar "cmdecho" 1)
(prin1)
))

[sebc]

Bonjour,

 

Super lisp , effectivement ca serait bien de pouvoir appliquer un décalage entre les blocs (je n'y connais rien en lisp et n'ai réussi à décaler que le 1er bloc) .

Pourquoi pas aussi avoir un réglage colonne/ligne .

Et si en plus ce lisp créé un texte sous chacun des blocs reprenant le nom du fichier ce serait pas mal .

Pour faire des planches contact ca aiderait bien .

 

Cordialement

Sébastien

[Patrick_35]

Salut

 

Tu as ce sujet

 

@+

[sebc]

Bonjour,

 

Ok merci, par contre :

l'autre Lisp créait des blocs de chacun des dwg , pas grf .

Grf crée des onglets... pas necessaire pour moi .

Il y a bien un décalage de chacun des dwg sur grf (pas réglable) et "une mise en page" ligne / colonne .

Et il n' y a finalement pas de création de texte sous chacun des blocs .

 

Merci

 

A+

[Patrick_35]

Tu peux modifier le lisp afin qu'il corresponde à tes besoins

 

l'autre Lisp créait des blocs de chacun des dwg , pas grf .

A supprimer

       (or (vl-catch-all-error-p (vl-catch-all-apply 'vla-explode (list obj)))
  (vla-delete obj)
)

Grf crée des onglets... pas necessaire pour moi .

A supprimer

       (while (< (strlen lay) 3)
         (setq lay (strcat "0" lay))
       )
       (and (vl-catch-all-error-p (vl-catch-all-apply 'vla-add (list (vla-get-layouts doc) lay)))
            (ssget "x" (list (cons 410 lay)))
         (progn
           (vlax-map-collection (setq sel (vla-get-activeselectionset doc)) 'vla-delete)
           (vla-delete sel)
         )
       )
       (vla-put-activelayout doc (setq tab (vla-item (vla-get-layouts doc) lay)))
(setq fen (vla-addpviewport (vla-get-block tab) (vlax-3d-point (mapcar '(lambda(a B) (/ (+ a B) 2.0)) bg hd)) dix diy))
(vla-put-layer fen "0")
(vla-put-color fen "256")
(vla-put-viewporton fen :vlax-true)
(vla-zoomextents (vlax-get-acad-object))
(vla-display fen :vlax-false)
(vla-display fen :vlax-true)
(vla-put-mspace doc :vlax-true)
(vla-zoomWindow (vlax-get-acad-object) (vlax-3d-point bg) (vlax-3d-point hd))
(vla-put-mspace doc :vlax-false)
(vla-put-displaylocked fen :vlax-true)

Il y a bien un décalage de chacun des dwg sur grf (pas réglable) et "une mise en page" ligne / colonne .

Et il n' y a finalement pas de création de texte sous chacun des blocs .

A modifier en fonction de tes besoins

(setq tot (1+ tot)
      col (1+ col)
      x (+ x (* dix 1.05))
)
(and (> diy my)
  (setq my diy)
)
(and (eq col 10)
  (setq x 0.0
	y (+ y (* my 1.05))
	my 0.0
	col 1
  )
)

Il reste à ajouter le texte, je te laisse chercher...

 

@+

[sebc]

Ok, merci beaucoup .

Bon j'y connais rien en lisp donc les textes c'est pas gagné .

Mais c'est déjà beaucoup .

 

Encore merci pour votre aide .

 

Bien cordialement