CADxp: Remplacement de bloc par un autre - CADxp

Aller au contenu

  • 2 Pages +
  • 1
  • 2
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

Remplacement de bloc par un autre Le but étant de changer aussi la valeur de l'étiquette

#21 L'utilisateur est hors-ligne   francinez 

  • ceinture orange
  • Groupe : Membres
  • Messages : 28
  • Inscrit(e) : 29-octobre 09
  • LocationBâle

Posté 07 juillet 2016 - 17:17

Bonjour,

J'ai modifié le lisp selon vos indications et cela fonctionne parfaitement.
Concernant le point 2: mon soucis est que j'ai beaucoup trop de chemin. Je pensais pouvoir intégrer un lisp que j'utilise pour insérer un bloc de n'importe ou. Je vous le met en pièce jointe.
Pouvez vous m'aider svp car je n'ai aucune notion de programmation.

Encore merci

Fichier(s) joint(s)

  • Fichier joint  insrt.LSP (1,23 Ko)
    Nombre de téléchargements : 2
  • Fichier joint  insrt.txt (2,64 Ko)
    Nombre de téléchargements : 3

0

#22 L'utilisateur est hors-ligne   bryce 

  • ceinture noire 4em dan
  • Groupe : Membres
  • Messages : 2160
  • Inscrit(e) : 03-mars 06
  • Location68 Mulhouse

Posté 07 juillet 2016 - 18:53

Bonsoir,

Tu peux essayer le lisp ci-dessous (non testé).
Il faut modifier les chemins au début du code dans (setq f "...") et (setq d "...") pour pointer vers les bons fichiers.
Attention, le fichier listant les chemins de recherche doit être modifié pour remplacer tous les \ par des \\

(defun c:SWAPBLOCKS ( / acdoc ms *error* plist sep f d l flst dlst i ob nb ss vlnb )

  ; Chemin du fichier texte contenant les noms des blocs à remplacer et le nom des blocs
  ; de remplacement (chaque couple sur une ligne, avec un ; entre les 2 noms).
  (setq f "C:\\chemin vers le fichier texte\\remplacements.txt")
  
  ; Chemin du fichier texte contenant les chemins dans lesquels rechercher les blocs
  ; Les chemins doivent utiliser \\ !
  (setq d "C:\\chemin vers le fichier texte\\dossiers de recherche.txt")
  
  ; Caractère de séparation entre l'ancien bloc et le nouveau dans le fichier texte:
  (setq sep ";")

  ; Liste des propriétés de l'ancien bloc à appliquer au bloc de remplacement
  ; (l'échelle en X, Y et Z et l'angle de rotation sont récupérés d'office):
  (setq plist '("Layer" "TrueColor" "Linetype" "LinetypeScale" "LineWeight"))

;---------------------------------------------------------------------------------------------------------------------
  
;; Add Support File Search Paths  -  Lee Mac
;; Adds a list of Support File Search Paths, excluding duplicates and invalid paths.
;; lst - [lst] list of paths to add, e.g. '("C:\\Folder1" "C:\\Folder2" ... )
;; Returns: [str] "ACAD" Environment String following modification

(defun LM:sfsp+ ( lst )
    (   (lambda ( str lst )
            (if (setq lst
                    (vl-remove-if
                       '(lambda ( x )
                            (or (vl-string-search (strcase x) (strcase str))
                                (not (findfile x))
                            )
                        )
                        lst
                    )
                )
                (setenv "ACAD" (strcat str ";" (apply 'strcat (mapcar '(lambda ( x ) (strcat x ";")) lst))))
            )
        )
        (vl-string-right-trim ";" (getenv "ACAD"))
        (mapcar '(lambda ( x ) (vl-string-right-trim "\\" (vl-string-translate "/" "\\" x))) lst)
    )
)

;; Remove Support File Search Paths  -  Lee Mac
;; Removes a list of Support File Search Paths if present.
;; lst - [lst] list of paths to remove (case-insensitive), e.g. '("C:\\Folder1" "C:\\Folder2" ... )
;; Returns: [str] "ACAD" Environment String following modification

(defun LM:sfsp- ( lst / del str tmp )

    (defun del ( old str / pos )
        (if (setq pos (vl-string-search (strcase old) (strcase str)))
            (strcat (substr str 1 pos) (del old (substr str (+ 1 pos (strlen old)))))
            str
        )
    )   
    (setq str (strcat (vl-string-right-trim ";" (getenv "ACAD")) ";")
          tmp str
    )
    (foreach pth lst
        (setq str (del (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth)) ";") str))
    )
    (if (/= tmp str) (setenv "ACAD" str))
)

  (vl-load-com)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
        ms (vla-get-modelspace acdoc))

  (defun *error* (msg)
    (and msg
      (or
        (member (strcase msg) '("FUNCTION CANCELLED" "QUIT / EXIT ABORT" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
        (princ (strcat "\nErreur : " msg))
      )
    )
    (if ss (setq ss nil))
    (if dlst (LM:sfsp- dlst))
    (vla-endundomark acdoc)
    (princ)
  )

  (vla-startundomark acdoc)
  
  (setq flst '()
        dlst '() )
  (if (and f (setq f (open f "r")))
    (progn
      (while (setq l (read-line f))
        (setq flst (cons l flst))
      )
      (close f)
      (setq flst (reverse flst))
    )
    (*error* "Fichier de remplacement non trouvé !")
  )
  (if (and d (setq d (open d "r")))
    (progn
      (while (setq l (read-line d))
        (setq dlst (cons l dlst))
      )
      (close d)
      (LM:sfsp+ (setq dlst (reverse dlst)))
    )
  )
  
  (foreach l flst
    (setq i (vl-string-search sep l)
          ob (substr l 1 i)
          nb (substr l (+ i 2)))
    (princ (strcat "\n\nRemplacement de " ob " par " nb ":"))
    (setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 2 ob)(cons 410 "Model") )))
    (if ss
      (if (or (tblsearch "BLOCK" nb) (setq nb (findfile (strcat nb ".dwg"))))
        (progn
          (setq i 0)
          (repeat (sslength ss)
            (setq ob (vlax-ename->vla-object (ssname ss i)))
            (setq vlnb (vla-insertblock ms
                (vla-get-InsertionPoint ob)
                nb
                (vla-get-XScaleFactor ob)
                (vla-get-YScaleFactor ob)
                (vla-get-ZScaleFactor ob)
                (vla-get-Rotation ob)))
            (foreach p plist
              (eval (read (strcat "(vla-put-" p " vlnb (vla-get-" p " ob))")))
            )
            (vla-delete ob)
            (setq i (+ 1 i))
          );repeat
          (setq ss nil)
          (princ (strcat "\n" (itoa i) " blocs remplacés."))
        );progn
        (princ (strcat "\nBloc " nb " non trouvé, remplacement non effectué."))
      );if
      (princ (strcat "\nAucun bloc " ob " à remplacer."))
    );if ss
  );foreach
  (*error* nil)
)

Ce message a été modifié par bryce - 09 juillet 2016 - 12:37 .

1

#23 L'utilisateur est hors-ligne   francinez 

  • ceinture orange
  • Groupe : Membres
  • Messages : 28
  • Inscrit(e) : 29-octobre 09
  • LocationBâle

Posté 08 juillet 2016 - 09:05

Bonjour,
J'ai essayé votre lisp mais je recois le message d'erreur:
Erreur : bad argument type: stringp nil

Dans le fichier txt pour les chemins j'ai bien mis \\
ex: G:\\TE-Templates\\01-AutoCADTemplates\\CAD\\ArticleLibrary\\03-ScrewNailRivet\\BN5951
G:\\TE-Templates\\01-AutoCADTemplates\\CAD\\ArticleLibrary\\03-ScrewNailRivet\\BN6029


Je viens de m'apercevoir que j'ai perdu certains chemins dans option.
Est-il possible d'intégrer ceci dans votre lisp:
(defun findblock ( dwg )
(vl-some '(lambda ( nb ) (findfile (strcat nb dwg)))
'( ""
"G:\\TE-Templates\\01-AutoCADTemplates\\CAD\\ArticleLibrary\\03-ScrewNailRivet\\BN5951\\
"G:\\TE-Templates\\01-AutoCADTemplates\\CAD\\ArticleLibrary\\03-ScrewNailRivet\\BN6029\\
"G:\\TE-Templates\\01-AutoCADTemplates\\CAD\\ArticleLibrary\\03-ScrewNailRivet\\DIN95\\
)
)
)

0

#24 L'utilisateur est hors-ligne   bryce 

  • ceinture noire 4em dan
  • Groupe : Membres
  • Messages : 2160
  • Inscrit(e) : 03-mars 06
  • Location68 Mulhouse

Posté 09 juillet 2016 - 12:36

Bonjour,

En fait il ne faut PAS mettre des \\ dans le fichier qui contient les chemins !
J'ai été trop vite, et je me suis trompé ;)

Je viens de prendre le temps de faire un test, ça fonctionne
0

#25 L'utilisateur est hors-ligne   francinez 

  • ceinture orange
  • Groupe : Membres
  • Messages : 28
  • Inscrit(e) : 29-octobre 09
  • LocationBâle

Posté 11 juillet 2016 - 08:57

Bonjour,

J'ai remis un seul \ mais je recois encore le message: erreur: bad argument type: numberp: nil. Certains blocs sont modifés mais suite à cette erreur le lisp s'arrête. Je dois modifier mes fixations de A2 en A4.

Je vous renvoie le fichier lisp avec les TXT mais je n'arrive pas à vous envoyer le dwg correspondant!

Encore merci de votre aide.

Fichier(s) joint(s)


0

#26 L'utilisateur est hors-ligne   francinez 

  • ceinture orange
  • Groupe : Membres
  • Messages : 28
  • Inscrit(e) : 29-octobre 09
  • LocationBâle

Posté 11 juillet 2016 - 09:20

Bryce, est ce que je vous envoie le dwg sur votre adresse?
0

#27 L'utilisateur est hors-ligne   bryce 

  • ceinture noire 4em dan
  • Groupe : Membres
  • Messages : 2160
  • Inscrit(e) : 03-mars 06
  • Location68 Mulhouse

Posté 11 juillet 2016 - 09:22

Bonjour,

Pour poster des dwg sur le forum, il suffit de les zipper ;)
1

#28 L'utilisateur est hors-ligne   francinez 

  • ceinture orange
  • Groupe : Membres
  • Messages : 28
  • Inscrit(e) : 29-octobre 09
  • LocationBâle

Posté 11 juillet 2016 - 09:28

Cool merci.
Ci joint le plan de toutes les vis que je dois modifier sur une centaine de plans

Fichier(s) joint(s)


0

#29 L'utilisateur est hors-ligne   bryce 

  • ceinture noire 4em dan
  • Groupe : Membres
  • Messages : 2160
  • Inscrit(e) : 03-mars 06
  • Location68 Mulhouse

Posté 11 juillet 2016 - 10:24

Il y a une erreur à la 16e ligne du fichier A2-A4.txt: un : à la place d'un ;
C'est cela qui provoque l'erreur et interrompt le traitement.
1

#30 L'utilisateur est hors-ligne   francinez 

  • ceinture orange
  • Groupe : Membres
  • Messages : 28
  • Inscrit(e) : 29-octobre 09
  • LocationBâle

Posté 11 juillet 2016 - 11:14

Désolé je ne l'avais pas vu!
Encore un dernier soucis, après l'utilisation du lisp je perd mes chemins personnels (voir image ci joint)
Dans H: je met les lisp et blocs que j'utilise couramment
Merci de votre aide

Fichier(s) joint(s)


0

#31 L'utilisateur est hors-ligne   Chico 

  • ceinture blanche
  • Groupe : Membres
  • Messages : 2
  • Inscrit(e) : 18-avril 19

Posté 18 avril 2019 - 16:45

Bonjour,

Merci pour le LISP, je suis resté sur la première version et ça marche nickel !

Cependant certains de mes blocs ont des noms avec des caractères spéciaux (comme un "é", :angry: ). Comment puis-je prendre en compte ces caractères spéciaux ?

Sinon un grand merci à toi Bryce !
0

#32 L'utilisateur est hors-ligne   Chico 

  • ceinture blanche
  • Groupe : Membres
  • Messages : 2
  • Inscrit(e) : 18-avril 19

Posté 18 avril 2019 - 16:45

Bonjour,

Merci pour le LISP, je suis resté sur la première version et ça marche nickel !

Cependant certains de mes blocs ont des noms avec des caractères spéciaux (comme un "é", :angry: ). Comment puis-je prendre en compte ces caractères spéciaux ?

Sinon un grand merci à toi Bryce !
0

#33 L'utilisateur est hors-ligne   lili2006 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11935
  • Inscrit(e) : 21-décembre 05

Posté 18 avril 2019 - 18:21

Bonsoir à toutes et tous,

Citation

des caractères spéciaux (comme un "é", :angry: ).

Format => Renommer ?

AutoCAD MAP 3D 2020 - Covadis 17.0e
Forum : http://genie-civil.bbactif.com/
0

#34 L'utilisateur est hors-ligne   didier 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 8192
  • Inscrit(e) : 18-décembre 02
  • LocationPlanète : Terre

Posté 18 avril 2019 - 19:02

Coucou

Quand on dit qu'il faut éviter d'utiliser les accents, les espaces et autres caractères spéciaux on passe pour des passéistes, j'enrage !!!
Essaie avec un strcase ça va peut-être aider...

Éternel débutant ...
Programmer AutoCAD
0

Partager ce sujet :


  • 2 Pages +
  • 1
  • 2
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

1 utilisateur(s) en train de lire ce sujet
0 membre(s), 1 invité(s), 0 utilisateur(s) anonyme(s)