Annonces
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

AutoCAD : creation d'un lisp

gex53
Advocate

AutoCAD : creation d'un lisp

gex53
Advocate
Advocate

bonjour ne sachant toujours pas écrire mais lisp tous seul je fais appel a l'un d'entre vous svp.

 

je recherche un lisp capable de faire les choses suivantes et de préférences dans l'ordre 

 

récupérer les textes et/ou symboles dans chaque case 

les réécrire dans un fichier texte chacune des ligne (le nombre de case est variable)

retour a la ligne a la fin de chaque case

la fin de la récupération des textes et/ou symbole lorsque l'on ai a la case end 

création du fichier texte en format .ACC dans le même répertoire que le fichier Autocad.

 

je vous joint le fichier autocad en model dans lequel je vais travailler et un fichier type .ACC le résultat après action du lisp.

 

 

merci d'avance à vous


Le titre du sujet a été modifié par un modérateur pour faciliter la recherche. Titre original:
creation d'un lisp

 

 

 

 

0 J'aime
Répondre
Solutions acceptées (3)
1 243 Visites
14 Réponses
Replies (14)

CADaSchtroumpf
Advisor
Advisor
Solution acceptée

Bonjour,

Je peux te proposer ce code.

Tu seras invité à choisir un texte pour créer un filtre de sélection pour ne sélectionner que les textes ayant les mêmes propriétés communes (calque, couleur etc..)

Puis; soit tu pourras faire une sélection automatique de TOUT ces textes correspondant au filtre, soit un mode manuel (fenêtre, capture, un par un), ou un seul texte unique.

La sélection sera triée par la position en Y du texte puis le résultat écrit dans un fichier ACC

 

(defun c:text_value2ACC ( / js dxf_cod mod_sel n lremov file_name cle f_open ename l_pt l_pr l_sort nbs)
  (princ "\nChoix d'un objet modèle pour le filtrage: ")
  (while
    (null
      (setq js
        (ssget "_+.:E:S"
          (list
            '(0 . "*TEXT")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
          )
        )
      )
    )
    (princ "\nCe n'est pas un objet valable pour cette fonction!")
  )
  (vl-load-com)
  (setq dxf_cod (entget (ssname js 0)))
  (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov))))
    (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
  )
  (initget "Unique Tout Manuel _Single All Manual")
  (if (eq (setq mod_sel (getkword "\nMode de sélection filtrée, choix [Unique/Tout/Manuel]<Manuel>: ")) "Single")
    (setq n -1)
    (if (eq mod_sel "All")
        (setq js (ssget "_X" dxf_cod) n -1)
        (setq js (ssget dxf_cod) n -1)
    )
  )
  (setq file_name (getfiled "Nom du fichier a créer ?: " (strcat (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 3)) "ACC") "ACC" 37))
  (if (null file_name) (exit))
  (if (findfile file_name)
    (progn
      (prompt "\nFichier éxiste déjà!")
      (initget "Ajoute Remplace annUler _Add Replace Undo")
      (setq cle
        (getkword "\nDonnées dans fichier? [Ajouter/Remplacer/annUler] <R>: ")
      )
      (cond
        ((eq cle "Add")
          (setq cle "a")
        )
        ((or (eq cle "Replace") (eq cle ()))
          (setq cle "w")
        )
        (T (exit))
      )
      (setq f_open (open file_name cle))
    )
    (setq f_open (open file_name "w"))
  )
  (setq l_pt nil)
  (repeat (sslength js)
    (setq ename (vlax-ename->vla-object (ssname js (setq n (1+ n)))))
    (setq l_pr (cons 'TextString 'InsertionPoint) nbs 0)
    (if (vlax-property-available-p ename (car l_pr))
      (setq l_pt
        (cons (cons (vlax-get ename (cdr l_pr)) (vlax-get ename (car l_pr))) l_pt)
      )
    )
  )
  (setq
    l_pt (mapcar '(lambda (x) (cons (cadar x) (cdr x))) l_pt)
    l_sort (vl-sort (mapcar 'car l_pt) '>)
  )
  (foreach n (mapcar '(lambda (x) (cdr (assoc x l_pt))) l_sort)
    (write-line n f_open)
  )
  (write-line "" f_open)
  (close f_open)
  (prin1)
)

 

gex53
Advocate
Advocate

bonjour @CADaSchtroumpf je te remercie d'avoir prie du temps pour mon lisp je l'essai des que je peu et je te redis. 

0 J'aime

gex53
Advocate
Advocate

Bonjour @CADaSchtroumpf 

 

je viens de tester ton lisp il fonctionne bien mais il me rajoute des textes non prévu dans les noms.

A tu une idée du problème?

 

 

renseignement ACC1.JPG

 

merci 

0 J'aime

CADaSchtroumpf
Advisor
Advisor

@gex53  a écrit :

Bonjour @CADaSchtroumpf 

 

je viens de tester ton lisp il fonctionne bien mais il me rajoute des textes non prévu dans les noms.

A tu une idée du problème?

 

 

renseignement ACC1.JPG

 

merci 


Cela vient des textes Multilignes où tu peux forcer dans l'éditeur des paramètres tel que la couleur, la hauteur, le style etc... sur toute ou une partie du texte mis en surbrillance, cela génère des codes particuliers.

Comment y remédier?

Plusieurs solutions

* Faire une marque d'annulation dans ton dessins

 Sélectionner tous les MText concernés et les décomposer (cela deviendra des textes simple)

 Utiliser alors la routine

A la fin de la procédure faire une annulation retour à la marque pour retrouver tes textes multiligne.

* Ou alors utiliser StripMtext disponible ICI pour enlever les code de formatage à l'intérieur des textes multilignes si tu veux les enlever définitivement.

La routine dans ce cas fonctionnera correctement.

gex53
Advocate
Advocate

merci je teste ca

0 J'aime

braudpat
Mentor
Mentor

Hello @gex53 @CADaSchtroumpf 

 

Je vous propose un StripMText vs 5.0D ...

 

La Sante, Bye, Patrice

 

Patrice ( Supporting Troops ) - Autodesk Expert Elite
If you are happy with my answer please mark "Accept as Solution" and if very happy please give me a Kudos (Felicitations) - Thanks

Patrice BRAUD

EESignature


0 J'aime

gex53
Advocate
Advocate

merci @braudpat pour ton lisp stripmtext

 

merci a toi @CADaSchtroumpf ton lisp fonctionne très bien du coup.

 

0 J'aime

gex53
Advocate
Advocate

salut @CADaSchtroumpf 

 

aurait tu le temps stp de me faire un lisp qui récupère les donné de mes fichier ACC pour  les transférer sur autocad car je les retape a la main et autant te dire que je suis entrain de pété un plomb lol  

 

je te met un fichier ACC en model 

 

merci d'avance si tu trouve le temps 

0 J'aime

CADaSchtroumpf
Advisor
Advisor
Solution acceptée

@gex53  a écrit :

salut @CADaSchtroumpf 

 

aurait tu le temps stp de me faire un lisp qui récupère les donné de mes fichier ACC pour  les transférer sur autocad car je les retape a la main et autant te dire que je suis entrain de pété un plomb lol  

 

je te met un fichier ACC en model 

 

merci d'avance si tu trouve le temps 


@gex53 

C'est sûr que + 1000 lignes à la main ça fait du taf!

Alors je te propose deux solutions.

La plus simple donnant des entités TEXT séparées que tu pourras manipuler comme tu veux:

 

 

(defun c:Import-ACC2Text ( / input f_open js l_read ins_pt p h_t l_read n dxf_ent l_d l_p d)
  (setq
    input (getfiled "Sélectionner un fichier ACC" "" "acc" 2)
    f_open (open input "r")
    js (ssadd)
  )
  (initget 9)
  (setq ins_pt (getpoint "\nPoint de départ haut gauche des textes: ") p (trans ins_pt 1 0))
  (initget 6)
  (setq h_t (getdist ins_pt (strcat "\nHauteur du texte <" (rtos (getvar "textsize")) ">: ")))
  (if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
  (while (setq l_read (read-line f_open))
    (entmake
      (list
        '(0 . "TEXT")
        (cons 8 (getvar "CLAYER"))
        (cons 10 p)
        (cons 40 (getvar "textsize"))
        (cons 1 l_read)
        '(50 . 0)
      )
    )
    (setq js (ssadd (entlast) js))
    (setq
      p
      (polar
        p
        (* 1.5 pi)
        (* (getvar "TEXTSIZE") 1.606412005457025)
      )
    )
  )
  (close f_open)
  (repeat (setq n (sslength js))
    (setq
      dxf_ent (entget (ssname js (setq n (1- n))))
      l_d (cons (apply '- (reverse (mapcar 'car (textbox dxf_ent)))) l_d)
      l_p (cons (cdr (assoc 10 dxf_ent)) l_p)
    )
  )
  (setq d (apply 'max l_d))
  (mapcar
    '(lambda (x)
      (entmakex
        (list
          '(0 . "LWPOLYLINE")
          '(100 . "AcDbEntity")
          '(100 . "AcDbPolyline")
          (cons 8 (getvar "CLAYER"))
          '(90 . 4)
          '(70 . 1)
          (cons 10 x)
          (list 10 (+ (car x) d) (cadr x))
          (list 10 (+ (car x) d) (+ (cadr x) (* (getvar "TEXTSIZE") 1.606412005457025)))
          (list 10 (car x) (+ (cadr x) (* (getvar "TEXTSIZE") 1.606412005457025)))
        )
      )
    )
    l_p
  )
)

 

 

 

La seconde qui offre l'avantage d'être une entité unique: un tableau

Mais avec + de 1000 lignes, ça bouffe pas mal de processus.

D'ailleurs Autodesk recommande de scinder en plusieurs tableaux pour éviter ce risque; ce que j'ai fais...

Tu auras plusieurs tableaux de 128 lignes qui seront accolés (cela me semble plus facilement consultable).

Toute fois tu peux changer dans le code (à la ligne 14) ce nombre. Avec 1500 et ton fichier ACC tu n'auras qu'un seul tableau. A toi de voir...  avec 1500 lignes tu commence à être limite mais ça le fait !

 

 

(defun c:Import-ACC2Tab ( / input f_open count l_read w_c el list_all AcDoc Space ins_pt_cell h_t n_row ename_cell)
  (initget 9)
  (setq ins_pt_cell (getpoint "\nPoint d'insertion haut gauche du tableau: "))
  (initget 6)
  (setq h_t (getdist ins_pt_cell (strcat "\nHauteur du texte <" (rtos (getvar "textsize")) ">: ")))
  (if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
  (setq
    input (getfiled "Selectionner un fichier ACC" "" "acc" 2)
    f_open (open input "r")
    count 0
  )
  (while (setq l_read (read-line f_open))
    (setq count (1+ count) w_c (cons (apply '- (reverse (mapcar 'car (textbox (list (cons 1 l_read)))))) w_c))
    (if (eq (rem count 128) count)
      (setq el (cons l_read el))
      (setq list_all (cons (cons l_read el) list_all) count 0 el nil)
    )
  )
  (close f_open)
  (setq
    list_all (cons el list_all)
    w_c (+ (apply 'max w_c) (* 2 (getvar "textsize")))
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (setq ins_pt_cell (polar ins_pt_cell 0 (* (1- (length list_all)) w_c)))
  (foreach el list_all 
    (setq n_row (length el))
    (setq ename_cell (vla-addTable Space (vlax-3d-point (trans ins_pt_cell 1 0)) n_row 1 (+ h_t (* h_t 0.25)) w_c))
    (vla-put-RegenerateTableSuppressed ename_cell :vlax-true)
    (vla-put-TitleSuppressed ename_cell :vlax-false)
    (vla-put-HeaderSuppressed ename_cell :vlax-false)
    (mapcar
      '(lambda (x)
        (vla-SetText ename_cell (setq n_row (1- n_row)) 0 x)
        (vla-SetCellTextHeight ename_cell n_row 0 (vlax-make-variant h_t 5))
        (vla-SetCellAlignment ename_cell n_row 0 4)
      )
      el
    )
    (vla-put-RegenerateTableSuppressed ename_cell :vlax-false)
    (setq ins_pt_cell (polar ins_pt_cell pi w_c))
  )
  (prin1)
)

 

 

gex53
Advocate
Advocate

bonjour @CADaSchtroumpf 

 

merci pour les 2 lisp il fonctionnent très bien je vais utiliser le lisp qui fais plusieurs tableau pour la lecture et la modification c'est plus simple.  peut tu me modifier le lisp qui transforme en ACC car aujourd'hui le lisp mélange les lignes.

 

merci a toi

 

 

loicriviere53700_0-1669193131504.pngloicriviere53700_1-1669193171166.png

 

0 J'aime

CADaSchtroumpf
Advisor
Advisor
Solution acceptée

@gex53  a écrit :

bonjour @CADaSchtroumpf 

 

peut tu me modifier le lisp qui transforme en ACC car aujourd'hui le lisp mélange les lignes.


En effet, d'avoir introduis les tableaux en plusieurs colonnes nécessite de corriger le code.

On ne peut plus se contenter de faire un tri que sur les Y mais sur les X puis aussi les Y, ce qui explique les mélanges de lignes.

Si je comprends bien tu explose le tableau pour pouvoir utiliser la routine, puis tu reviens en arrière?

 

Voici le code corrigé (je pense!...)

 

(defun c:text_value2ACC ( / js dxf_cod mod_sel n lremov file_name cle f_open ename l_pt l_pr l_sort nbs)
  (princ "\nChoix d'un objet modèle pour le filtrage: ")
  (while
    (null
      (setq js
        (ssget "_+.:E:S"
          (list
            '(0 . "*TEXT")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
          )
        )
      )
    )
    (princ "\nCe n'est pas un objet valable pour cette fonction!")
  )
  (vl-load-com)
  (setq dxf_cod (entget (ssname js 0)))
  (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov))))
    (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
  )
  (initget "Unique Tout Manuel _Single All Manual")
  (if (eq (setq mod_sel (getkword "\nMode de sélection filtrée, choix [Unique/Tout/Manuel]<Manuel>: ")) "Single")
    (setq n -1)
    (if (eq mod_sel "All")
        (setq js (ssget "_X" dxf_cod) n -1)
        (setq js (ssget dxf_cod) n -1)
    )
  )
  (setq file_name (getfiled "Nom du fichier a créer ?: " (strcat (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 3)) "ACC") "ACC" 37))
  (if (null file_name) (exit))
  (if (findfile file_name)
    (progn
      (prompt "\nFichier éxiste déjà!")
      (initget "Ajoute Remplace annUler _Add Replace Undo")
      (setq cle
        (getkword "\nDonnées dans fichier? [Ajouter/Remplacer/annUler] <R>: ")
      )
      (cond
        ((eq cle "Add")
          (setq cle "a")
        )
        ((or (eq cle "Replace") (eq cle ()))
          (setq cle "w")
        )
        (T (exit))
      )
      (setq f_open (open file_name cle))
    )
    (setq f_open (open file_name "w"))
  )
  (setq l_pt nil)
  (repeat (sslength js)
    (setq ename (vlax-ename->vla-object (ssname js (setq n (1+ n)))))
    (setq l_pr (cons 'TextString 'InsertionPoint) nbs 0)
    (if (vlax-property-available-p ename (car l_pr))
      (setq l_pt
        (cons (cons (vlax-get ename (cdr l_pr)) (vlax-get ename (car l_pr))) l_pt)
      )
    )
  )
  (setq
    l_sort
    (vl-sort
      (mapcar 'car l_pt)
        '(lambda (x y)
          (cond
            ((= (car x)(car y))(> (cadr x)(cadr y)))
            ((< (car x)(car y)))
          )
        )
    )
  )
  (foreach n (mapcar '(lambda (x) (cdr (assoc x l_pt))) l_sort)
    (write-line n f_open)
  )
  (write-line "" f_open)
  (close f_open)
  (prin1)
)

 

gex53
Advocate
Advocate

bonjour @CADaSchtroumpf 

 

super je viens de tester ca marche très bien, tu as tous compris je récupère le fichier ACC qui est un fichier avec des poids, des tailles, volume, poing de graviter etc. je modifie aux besoin et je reforme le fichier ACC . avec ce lisp combien de ligne et de colonne en y et x je peu gère? merci pour ton aide

0 J'aime

CADaSchtroumpf
Advisor
Advisor

@gex53  a écrit :

avec ce lisp combien de ligne et de colonne en y et x je peu gère? merci pour ton aide


Sans avoir fait de test, je dirais à la limite des nombres entiers, soit 2 147 483 647 (2^31).

Je pense que tu as de la marge 😉

En même temps faire un tableau de cette taille mettrai à genoux AutoCad... (pas de réponse dans le gestionnaire de tâche), déjà quand tu fais un tableau manuellement avec Autocad si tu choisis par exemple 2000 lignes pour une seule colonne; tu as un message d'avertissement pour valider ta demande disant grosso modo que tu vas bouffer pas mal de ressource et qu'Autocad risque de devenir instable.

Donc je ne connais pas la limite exact pour un seul tableau. Autocad n'est pas voué à être un tableur comme Excel...

gex53
Advocate
Advocate

merci de ta réponse elle me va très bien, je ne vais jamais atteindre c'est chiffre car je modifie principalement mes fichiers il est assez rare de devoir en rajouter 

0 J'aime