[Résolu] Lisp sur la base de la commande Liste

[Circus]

Bonjour,

 

J'étais à la recherche depuis un moment d'un moyen d'extraction de donnée ( nom de bloc, coordonnée, jeux de visibilité...)

La commande LISTE permet de le faire et j'ai enfin trouvé un lisp qui permet de le faire

Une fois le lisp executé, ca crée un fichier .log

 

(defun c:Listing (/ #SS)
(cond ((setq #SS (ssget))
(setvar 'logfilemode 1)
(command "_.list" #SS "")
(setvar 'logfilemode 0)
(startapp "Notepad" (getvar 'logfilename))
)
) ;_ cond
(princ)
)

 

- Mon problème est qu'il faut rester ou appuyer 100 fois ( environ ^^ ) sur entrer pour que le lisp continue a s'executer "Appuyez sur ENTREE pour continuer:" .

- J'aimerai aussi que le fichier créé précédement .log (47331-21371_1_1_2738.log par exemple chez moi) soit écrasé avant de rajouter le nouveau listing ou alors créé avec un nom indiquant l'heure sur le fichier. 47331-21371.dwg ->47331-21371_14_42. ( je prends toutes autres solution ou lisp pouvant m'aiguiller )

 

Merci d'avance

Cdt

 

Circus

[CadFrank]

Bonjour Circus,

 

Si je ne me trompe pas essaye d'ajouter "_X" apres ton ssget dans ta parenthèse.

 

Cordialement,

 

Francois.

[philsogood]

hello

pourquoi ne pas faire ça avec EXTRACTDONNEES??

Phil

[Circus]

Merci pour vos réponses rapide ( désolé notre serveur avait craché...)

 

pour _X cela ne fonctionne pas :

no function definition: SSGET_X

 

En ce qui concerne EXTRACTDONNEES je n'aime pas utiliser cette commande.

(depuis la ACA2014 "Sélectionner les objets dans le dessin actif", je doit cliquer 3 fois sur le bouton pour sélectionner mes objets ( un détail on va dire.)

J'ai d'autres arguments que je n'ai pas en tête mais c'est une solution que j'avais fortement exploré.

Je m'en sers tout de meme pour certain export basic.

[Circus]

Pour info j'avais fait différent tests avec _X, le plus concluant fu avec (ssget "_X")), enfin quand je dit concluant c'est à dire que je n'ai pas de message d'erreur.

Par contre avec cela je n'ai plus de le choix des objets à lister, il me fait un listing de l'ensemble de l'espace objet et j'ai encore a taper plusieur fois sur enter pour continuer.

 

Mon but principale est d'avoir une extraction de donnée brut, même moche (contrairement à extractdonnée qui permet d'avoir des colonnes directement exploitable sur excel mais...)

Un extraction moche ne m'inquiète pas car avec excel et le vba je pourrait sans soucis exploiter les données.

 

Pour ne faire perdre de temps a personne, le lisp ne me passionne pas. je ne parle pas du language en lui même mais j'ai déjà du mal avec le français l'anglais et le vba ^^ Et j'avou vouloir me perfectionner en vba...Bref

 

Si vous avez une idée, voir une approche totalement différente, je suis tout a fait ouvert.

Pour ma part ce soir c'est fini sur ACA, je l'ai banni de mon pc perso depuis bien longtemp XD

 

Cdt

 

Circus

[x_all]

si je me goure pas (ssget "_X")) te renvoie un jeu de sélection de tout le dessin... c'est un peu brut de décoffrage non?

 

tu veux faire quoi trier dans ce boxon?

 

fait au moins un filtre sur le type d'objet que tu veux lister non?

[Circus]

si je me goure pas (ssget "_X")) te renvoie un jeu de sélection de tout le dessin... c'est un peu brut de décoffrage non?

 

tu veux faire quoi trier dans ce boxon?

 

fait au moins un filtre sur le type d'objet que tu veux lister non?

 

 

Non non, justement, je ne le souhaite pas, je souhaite sélectionner une zone à lister, comme le fait très bien lisp que j'ai trouvé.

Je voudrais juste ne pas avoir a rester avec la touche enter pour lister l'ensemble de la zone d'objet que j'ai sélectionné.

 

En gros je lance le lisp, je sélectionne une zone et j'ai le fichier .log qui souvre que je copie/colle sous excel et avec le vba je l'exploite. le soucis est d'avoir a passer "Appuyez sur ENTREE pour continuer:" dans la console texte

[Circus]

Bonjour,

 

Pas d'idées pour m'éviter de rester appuyer sur entrée pendant 2 minutes ?

 

De mon coté mon code vba progresse bien ( même si il est un peu moche ^^)

 

Première partie: nettoyage du fichier log dans excel

Option Compare Text   ' Pas de différence minuscule/majuscule
Sub nettoyer()
Sheets("Liste de base").Select
 Application.ScreenUpdating = False
 derlig = Range("A65536").End(xlUp).Row
 For Ligne = derlig To 1 Step -1
   If Not Range("A" & Ligne) Like "*REFERENCE DE BLOC  Calque:*" And Not Range("A" & Ligne) Like "*Nom du bloc:*" _
   And Not Range("A" & Ligne) Like "*en point,*" And Not Range("A" & Ligne) Like "*Visibilité:*" _
   And Not Range("A" & Ligne) Like "*Distance:*" And Not Range("A" & Ligne) Like "*Distance1:*" _
   And Not Range("A" & Ligne) Like "*AEC_DOOR*" And Not Range("A" & Ligne) Like "*AEC_WINDOW*" _
   And Not Range("A" & Ligne) Like "*Largeur :*" And Not Range("A" & Ligne) Like "*Hauteur :*" _
   And Not Range("A" & Ligne) Like "*Style de porte*" And Not Range("A" & Ligne) Like "*Style de fenêtre*" Then
     Rows(Ligne).Delete
   End If
 Next Ligne
 Application.ScreenUpdating = True
End Sub

 

Deuxième partie: Listing

Sub Nomencla2()
'------------------------ Copy d'une feuil à l'autre
Application.ScreenUpdating = False
Sheets("Nomenclature").Select
derligsup = Range("A65536").End(xlUp).Row
Range("A1", "I" & derligsup).Select

   Selection.ClearContents
Sheets("Liste de Base").Select
derlig = Range("A65536").End(xlUp).Row
Sheets("Liste de Base").Range("A" & 1, "A" & derlig).Copy Sheets("Nomenclature").Range("A2")
'------------------------ prépa nomenclature
Sheets("Nomenclature").Select
Range("A1").Value = "Nom du bloc"
Range("B1").Value = "Jeux de Visibilité"
Range("C1").Value = "Nom Finale"
Range("D1").Value = "Qté"
Range("E1").Value = "Coordonnée"
Range("F1").Value = "Calque"
Range("G1").Value = "Distance"
Range("H1").Value = "Distance1"
Range("A1:H1").Select
Selection.AutoFilter

'------------------------ remplissage colonne
For Ligne = 2 To derlig
'--Calque--'
Range("A" & Ligne).Select
If Left(Range("A" & Ligne), 26) = "REFERENCE DE BLOC  Calque:" Then
Range("A" & Ligne).Select
ActiveCell = Right(ActiveCell, Len(ActiveCell) - 28)
ActiveCell = Left(ActiveCell, Len(ActiveCell) - 1)
Range("A" & Ligne).Select
Selection.Copy
Range("F" & Ligne).Select
ActiveSheet.Paste
Range("A" & Ligne).Select
Selection.Delete Shift:=xlUp
   '--Nom du bloc--'
   Range("A" & Ligne).Select
   If Left(Range("A" & Ligne), 12) = "Nom du bloc:" Then
   Range("A" & Ligne).Select
   ActiveCell = Right(ActiveCell, Len(ActiveCell) - 14)
   ActiveCell = Left(ActiveCell, Len(ActiveCell) - 1)
   End If
   '--Coordonnée--'
   If Left(Range("A" & Ligne + 1), 9) = "en point," Then
   Range("A" & Ligne + 1).Select
   ActiveCell = Right(ActiveCell, Len(ActiveCell) - 10)
   Range("A" & Ligne + 1).Select
   Selection.Copy
   Range("E" & Ligne).Select
   ActiveSheet.Paste
   Range("A" & Ligne + 1).EntireRow.Delete
   End If
   '--Visibilité--'
   If Left(Range("A" & Ligne + 1), 11) = "Visibilité:" Then
   Range("A" & Ligne + 1).Select
   ActiveCell = Right(ActiveCell, Len(ActiveCell) - 12)
   Range("A" & Ligne + 1).Select
   Selection.Copy
   Range("B" & Ligne).Select
   ActiveSheet.Paste
   Range("A" & Ligne + 1).EntireRow.Delete
   End If
   '--Distance--'
   If Left(Range("A" & Ligne + 1), 9) = "Distance:" Then
   Range("A" & Ligne + 1).Select
   ActiveCell = Right(ActiveCell, Len(ActiveCell) - 9)
   Range("A" & Ligne + 1).Select
   Selection.Copy
   Range("G" & Ligne).Select
   ActiveSheet.Paste
   Range("A" & Ligne + 1).EntireRow.Delete
   End If
   '--Distance1--'
   If Left(Range("A" & Ligne + 1), 10) = "Distance1:" Then
   Range("A" & Ligne + 1).Select
   ActiveCell = Right(ActiveCell, Len(ActiveCell) - 10)
   Range("A" & Ligne + 1).Select
   Selection.Copy
   Range("H" & Ligne).Select
   ActiveSheet.Paste
   Range("A" & Ligne + 1).EntireRow.Delete
   End If

End If


'---------------------------PORTE-------------------------'
'--CalquePorte--'
Range("A" & Ligne).Select
If Left(Range("A" & Ligne), 17) = "AEC_DOOR  Calque:" Then
Range("A" & Ligne).Select
ActiveCell = Right(ActiveCell, Len(ActiveCell) - 19)
ActiveCell = Left(ActiveCell, Len(ActiveCell) - 1)
Range("A" & Ligne).Select
Selection.Copy
Range("F" & Ligne).Select
ActiveSheet.Paste
Range("A" & Ligne).Select
Selection.Delete Shift:=xlUp
   '--DistanceLargeur--'
   If Left(Range("A" & Ligne), 9) = "Largeur :" Then
   Range("A" & Ligne).Select
   ActiveCell = Right(ActiveCell, Len(ActiveCell) - 9)
   Range("A" & Ligne).Select
   Selection.Copy
   Range("G" & Ligne).Select
   ActiveSheet.Paste
   Range("A" & Ligne).Select
   Selection.Delete Shift:=xlUp
   End If
   '--DistanceHauteur--'
   If Left(Range("A" & Ligne), 9) = "Hauteur :" Then
   Range("A" & Ligne).Select
   ActiveCell = Right(ActiveCell, Len(ActiveCell) - 9)
   Range("A" & Ligne).Select
   Selection.Copy
   Range("H" & Ligne).Select
   ActiveSheet.Paste
   Range("A" & Ligne).Select
   Selection.Delete Shift:=xlUp
   End If
   '--Nom du Porte--'
   Range("A" & Ligne).Select
   If Left(Range("A" & Ligne), 16) = "Style de porte :" Then
   Range("A" & Ligne).Select
   ActiveCell = Right(ActiveCell, Len(ActiveCell) - 17)
   'ActiveCell = Left(ActiveCell, Len(ActiveCell) - 1)
   End If
End If

'---------------------------FENETRE-------------------------'
'--CalqueFenetre--'
Range("A" & Ligne).Select
If Left(Range("A" & Ligne), 19) = "AEC_WINDOW  Calque:" Then
Range("A" & Ligne).Select
ActiveCell = Right(ActiveCell, Len(ActiveCell) - 21)
ActiveCell = Left(ActiveCell, Len(ActiveCell) - 1)
Range("A" & Ligne).Select
Selection.Copy
Range("F" & Ligne).Select
ActiveSheet.Paste
Range("A" & Ligne).Select
Selection.Delete Shift:=xlUp
   '--DistanceLargeur--'
   If Left(Range("A" & Ligne), 9) = "Largeur :" Then
   Range("A" & Ligne).Select
   ActiveCell = Right(ActiveCell, Len(ActiveCell) - 9)
   Range("A" & Ligne).Select
   Selection.Copy
   Range("G" & Ligne).Select
   ActiveSheet.Paste
   Range("A" & Ligne).Select
   Selection.Delete Shift:=xlUp
   End If
   '--DistanceHauteur--'
   If Left(Range("A" & Ligne), 9) = "Hauteur :" Then
   Range("A" & Ligne).Select
   ActiveCell = Right(ActiveCell, Len(ActiveCell) - 9)
   Range("A" & Ligne).Select
   Selection.Copy
   Range("H" & Ligne).Select
   ActiveSheet.Paste
   Range("A" & Ligne).Select
   Selection.Delete Shift:=xlUp
   End If
   '--Nom du Porte--'
   Range("A" & Ligne).Select
   If Left(Range("A" & Ligne), 18) = "Style de fenêtre :" Then
   Range("A" & Ligne).Select
   ActiveCell = Right(ActiveCell, Len(ActiveCell) - 19)
   'ActiveCell = Left(ActiveCell, Len(ActiveCell) - 1)
   End If
End If


'--Compiler A - B --'
If Range("B" & Ligne) <> "" Then
Range("C" & Ligne) = Range("A" & Ligne) & " - " & Range("B" & Ligne)
Else: Range("C" & Ligne) = Range("A" & Ligne)
End If
'--Compiler A - G--'
If Range("G" & Ligne) <> "" Then
Range("C" & Ligne) = Range("A" & Ligne) & " - " & Range("G" & Ligne)
Else: Range("C" & Ligne) = Range("A" & Ligne)
End If
'--Compiler A - H--'
If Range("G" & Ligne) <> "" Then
Range("C" & Ligne) = Range("A" & Ligne) & " - " & Range("H" & Ligne)
Else: Range("C" & Ligne) = Range("A" & Ligne)
End If
'--Compiler A - G x H--'
If Range("G" & Ligne) <> "" Then
Range("C" & Ligne) = Range("A" & Ligne) & " - " & Range("G" & Ligne) & " X " & Range("H" & Ligne)
Else: Range("C" & Ligne) = Range("A" & Ligne)
End If
'--Ligne suivante--'
Next
'--qté1--'
Derligfin = Range("A65536").End(xlUp).Row
For Ligne = 2 To Derligfin
Range("D" & Ligne) = 1
Next
'--Filtre--'
   ActiveWorkbook.Worksheets("Nomenclature").AutoFilter.Sort.SortFields.Clear
   ActiveWorkbook.Worksheets("Nomenclature").AutoFilter.Sort.SortFields.Add Key _
       :=Range("F1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
       xlSortNormal
   With ActiveWorkbook.Worksheets("Nomenclature").AutoFilter.Sort
       .Header = xlYes
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
   End With
'--fin--'
Application.ScreenUpdating = True
End Sub

 

Merci d'avance !

[VDH-Bruno]

Bonjour,

 

- Mon problème est qu'il faut rester ou appuyer 100 fois ( environ ^^ ) sur entrer pour que le lisp continue a s'executer "Appuyez sur ENTREE pour continuer:" .

En passant les entités une à une à la commande LIST au lieu d'une sélection global devrait considérablement réduire l'usage de la touche ENTRÉE.

(command "_.list" #SS "")

À remplacer par

(repeat (setq i (sslength #ss))
        (command "_.list" (ssname #ss (setq i (1- i))) "")
)

 

- J'aimerai aussi que le fichier créé précédement .log (47331-21371_1_1_2738.log par exemple chez moi) soit écrasé avant de rajouter le nouveau listing

La ligne de code suivante devrait suffire

(vl-file-delete (getvar "LOGFILENAME"))

 

Le code:

(defun c:Listing (/ #ss i)
 (cond ((setq #ss (ssget))
        (vl-file-delete (getvar "LOGFILENAME"))
        (setvar 'logfilemode 1)
        (repeat (setq i (sslength #ss)) (command "_.list" (ssname #ss (setq i (1- i))) ""))
        (setvar "LOGFILEMODE" 0)
        (startapp "Notepad" (getvar 'logfilename))
       )
 )
 (princ)
)

 

A+

[bonuscad]

- Mon problème est qu'il faut rester ou appuyer 100 fois ( environ ^^ ) sur entrer pour que le lisp continue a s'executer "Appuyez sur ENTREE pour continuer:" .

- J'aimerai aussi que le fichier créé précédement .log (47331-21371_1_1_2738.log par exemple chez moi) soit écrasé avant de rajouter le nouveau listing ou alors créé avec un nom indiquant l'heure sur le fichier. 47331-21371.dwg ->47331-21371_14_42. ( je prends toutes autres solution ou lisp pouvant m'aiguiller )

 

Bonjour,

 

Je n'ai pas de solution pour ENTREE, ou alors en s'appuyant sur une autre syntaxe que celle de LISTE.

Ce que je peux te proposer est la syntaxe DXF (mais il faut connaitre les codes) et tu n'aura pas des renseignements (du moins pas en clair, comme les distances ou les angles) de la même manière que LISTE.

 

Ce qui suit va te produire un fichier CSV en mode séquentiel (comme le DXF) qui sera lisible par excel en mode colonne (les données sont séparées, donc plus facile pour faire des tris ou des calculs)

(defun c:list_for_CSV ( / js file2open f_open n dxf_cod lremov)
 (setq js (ssget))
 (cond
   (js
     (setq file2open (strcat (getvar "DWGPREFIX") (getvar "DWGNAME") (rtos (getvar "cdate") 2 4) ".CSV"))
     (setq f_open (open file2open "w"))
     (repeat (setq n (sslength js))
       (setq dxf_cod (entget (ssname js (setq n (1- n)))) lremov nil)
       (foreach n dxf_cod (if (member (car n) '(5 330 -1)) (setq lremov (cons (car n) lremov))))
       (foreach m lremov
         (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
       )
       (foreach n dxf_cod
         (princ "\n" f_open)
         (if (listp (cdr n))
           (while (car n)
             (princ (car n) f_open)
             (princ ";" f_open)
             (setq n (cdr n))
           )
           (progn (princ (car n) f_open) (princ ";" f_open) (princ (cdr n) f_open) (princ ";" f_open))
         )
       )
     )
     (close f_open)
   )
 )
 (prin1)
)

[Circus]

Merci beaucoup !

 

Merci VDH-Bruno le lisp fonctionne nikel !

 

Merci bonuscad pour ta réponse mais en effet je préfère l'extraction de la manière LISTE.

 

Il me reste a améliorer mon code vba, qui est lourd et avec quelques bugs ^^

 

Cdt

 

Circus

[VDH-Bruno]

Re,

Merci VDH-Bruno le lisp fonctionne nikel !

Sauf si tu as une définition d'entité supérieure (cas d'une polyligne avec beaucoup de sommets) à la capacité de ta fenêtre de texte, dans ce cas pour ces quelques cas particulier, il te faudra encore utiliser la touche ENTRER.

 

A+

Ps: Personnellement si j'avais eu ce développement à faire, je serais également passé par les codes DXF.

[Circus]

Ahah, oui j'avais fais plusieurs tests, ca m'explique pourquoi des fois il fallait encore faire enter, mais pas grave ! on va dire que c'est un détail acceptable :) (si une solution pour contourner pour eviter est posssible je suis pas contre, bien entendu, mais celle actuelle j'en suis satisfait ! donc bon...Merci à nouveau)

 

Par contre il ne faut pas etre est épileptiqie avec ce lisp XD , je le suis mais pas avec ce genre ( strombo ou autre ^^ )

 

Vous parlez de DXF... j'ai honte de demander c'est quoi ?

Pour ma part je serait plutot vba...d'autocad à excel sans passer par un autre language!

Il n'est pas facile de trouver du support ACA/VB et c'est dommmage.

 

Actuelement la seul chose vba sur ACA que j'ai réussi c'est un beforesave -> purger les blocs

 

En tout cas merci !

 

Circus

[x_all]

je crois bien que c'est (gile) qui avait donné les liens, mais j'ai fini par le stoker cher moi...

 

joch04.free.fr/images/lisp-ini/acad_dev180.7z

 

par contre ce n'est à jour que jusqu’à la 2013 il me semble... il y a peut être mieux sur le net directement chez todesk

ps

il y a les références DXF et Autolisp aussi...

[bonuscad]

Vous parlez de DXF... j'ai honte de demander c'est quoi ?

 

DXF acronyme de Data eXchange File (en Français Fichier de Données d'Echange)

Ce format est apparu pratiquement à la naissance des logiciels de CAO, il est sensé être le format d'échange entre divers logiciel de conception graphique.

Généralement c'est un fichier parfaitement lisible avec un éditeur de texte, bien qu'Autocad puisse produire des fichier DXF en binaire (Fichier beaucoup plus compact).

 

Ce fichier à une structure bien précise pour reprendre la définition des objets que tu a pu dessiner sous Autocad.

En quelque sorte c'est la base de donnée en clair de ton dessin. Dès le début, le lisp s'est appuyé sur ce codage pour pouvoir interagir sur ton dessin en mode programmation: fonction (entget), (entmake), (entmod)

Maintenant, bien que toujours accessible, viable en programmation et je pense d'actualité pour encore pas mal de temps, la programmation à évolué vers le language orienté objet. Vlisp, ActiveX, VBA, C+, NET

 

La référence AutoDesk sur le DXF

Voir surtout la partie:DXF Entities Section

[lecrabe]

Hello

 

http://www.autodesk.com/techpubs/autocad/acad2000/dxf/index.htm

 

Bye, lecrabe

[Circus]

Merci pour les liens.

 

Je vais me concentrer sur le vba avec excel pour le moment ^^