Olivier Eckmann

Bonjour, MAP 2012 SP2, MAP 2014 SP2 CC49 ajout d'une commune de l'Essonne http://inspire.cadastre.gouv.fr/scpc/91666.wms? Aucun souci Par contre si on ne coche que certaines couches, elles ne sont pas forcément visibles à l'échelle du zoom sur la commune. Par exemple si on ajoute Bati et Parcelle, l'écran reste blanc, mais si on zoome assez, les objets apparaissent. C'est pourquoi j'ajoute toutes les couches et je coche "combiner en un calque" Comme cela j'ai toujours quelque chose qui s'affiche à l'écran quelque soit le niveau de zoom. Olivier

Bonjour, mettre a variable PICKFIRST à 1 Olivier

Bonjour, la commande lancée pour afficher ton dialogue est _AMLAYER ce qui doit correspondre à une version spécifique des calques pour Mechanical. Essaie de taper CALQUE sur la ligne de commande, tu devrais retrouver tes petits. Olivier

Salut Patrice, Est-ce que s'est stocké directement dans Oracle Spatial, ou bien avec la surcouche ArcSDE? La plupart des utilisateurs, que je connaissais, utilisaient AutoCAD MAP + ArcSDE avec un Oracle simple en dessous. Je ne suis pas sûr que ce soit plus simple de devenir un expert Oracle qu'un expert PostGis :(rires forts): Olivier

Bonjour, La seule solution que j'ai trouvé c'est de rendre le bloc dynamique. Avec le fichier d'exemple de Patrick, rentrer dans l'éditeur et modifier les attributs LIGNE2 et 3 pour utiliser un champ. Lorsque l'on insère le nouveau bloc les attributs ne sont pas mis à jour. Par contre, il suffit de tirer sur une flêche à droite ou à gauche, dans ce cas le bloc devient anonyme (*U) et un REGEN met à jour les lignes 2 et 3. Si on copie ce bloc x fois dans le dessin, que l'on change la valeur de l'attribut LIGNE1 et un REGEN, tout est mis à jour. Olivier Test.zip

Bonjour, Je me permets de me greffer sur le sujet car j'étais justement en train de réfléchir au portage de mes données du format SDF vers PostGis. Je suis une bille sur PostGis, mais je connais un peu MAP donc j'ai fait pas mal de tests en suivant ce fil de discussion, et j'aurais quelques questions/réponses. J'ai fait les tests à partir de MAP 3D 2012 (et 2014) donc PostgreSQL 9.0.19 et PostGis 1.5.5 (environnement Windows). Ma 1ère question est que Postgre existe en 32 et 64 bits mais PostGis uniquement en 32 bits (j'ai bien trouvé un compilation d'un PostGis 1.5.2 64 bits, mais je ne sais pas trop quoi en faire). Pour mes tests, j'ai donc installé tout en 32 bits, ça fonctionne, mais est-ce qu'on est limité en capacité? volume de BDD? performances du serveur? Dans AutoCAD, pour les différences de comportement par le clic droit entre "Créer" qui fonctionne et "Nouvel objet de la géométrie" qui ne fonctionne pas, cela provient du type de géométrie déclarée dans PostGis. Pour mes tests j'ai bêtement chargé des SHP pour alimenter ma base PostGis et dans ce cas, la géométrie déclarée (créée) est de type MULTIPOLYGON. Dans MAP, lorsque l'on fait Créer, ça lance la commande MAPMULTIPOLYGONCREATE qui comme son nom l'indique crée un Multipolygon, puisque la géométrie PostGis est de type MULTIPOLYGON. Par contre lorsque l'on lance la commande "Nouvel objet de la géométrie", il demande de sélectionner un objet. Si on sélectionne 1 seule polyligne, il crée un objet de type POLYGON et pas MULTIPOLYGON, donc il ne peut pas être ajouté à la base PostGis. J'ai fait le test en sélectionnant 2 polylignes disjointes. Dans ce cas, il crée un seul objet MULTIOLYGON qui s'ajoute sans souci à la base PostGis. Dans tous les cas, le champ GID est correctement et automatiquement incrémenté par MAP, il n'y a pas besoin de le saisir (de toute manière je n'y avais pas accès) Comme je suis une bille en Postgre et postGis, j'ai vainement essayé de modifier mon champ "the_geom", ça ne marche pas. Entre les colonnes qui sont liées à des contraintes, je n'y comprends rien du tout. Ca ne solutionne pas le problème, car je ne sais pas comment créer un MULTIPOLYGON à partir d'une simple polyligne (ou MPolygone, j'ai essayé aussi), mais si ça peut faire avancer le schmilblic :) Mes autres questions concernent plutôt Postgre: - Si j'implémente une telle solution sur mon serveur pour la boite, pas de souci. Mais je dois parfois faire des présentations de solutions SIG que l'on pourrait implémenter chez mes clients donc je ne serais plus connecté à mon serveur. Est-il possible de recopier toute une base pour la mettre sur mon portable. J'ai cru comprendre qu'on pouvait faire un Dump de la base, et ensuite j'en fait quoi? J'avais aussi imaginé faire tourner mon serveur PostGis dans une machine virtuelle et la cloner sur mon portable quand je dois travailler en mode déconnecté? - J'arrive à créer et remplir une base vide à partir de "PostGis Shape file and DBF loader", mais je n'arrive pas à la compléter par la suite pour la mettre à jour. Est-ce possible? - Est-ce une bonne idée de partir sous PostGis ou bien une solution type SQL Serveur avec la partie Spatiale (version 2008 Express par ex) serait plus judicieux? Merci Olivier

Bonjour, Je réponds sans Lisp, mais avec Covadis comme tu l'as mis dans ta signature: 1. Tabuler la ligne bleue avec des blocs CovaTabPt grâce à la fonction Cov3D / Profils en travers / Tabulation d'un axe (tabuler à intervalle suffisamment serré pour l'approximation souhaitée 0.50 pour ton fichier par exemple) 2. Étiqueter ces blocs avec les infos Abscisse / déport par rapport à un axe que tu choisis (Ta ligne rouge) => Cov2D / Cotation par étiquette / Coter des points ou des blocs - Choisir "Standard Abscisse / Déport", puis sélectionner tous les blocs précédemment créés, puis sélectionner la poly rouge lorsque Covadis demande un axe 3. Listing d'étiquette pour sortir un tableau Excel et ne conserver que les valeurs Abscisse/Déport => Cov2D / Cotation par étiquette / Listing d'étiquette, éliminer les lignes et( colonnes inutile pour ne garder que Abscisse Déport et enregistrer au format TXT Tabulation 4. Charger ce fichier comme semis de point le X correspondant à l'abscisse, le déport donnant le Y => Cov2D / Point topo / Chargement de semis - format séparateur XY séparateur espace 5. Éventuellement dessiner la polyligne passant par les points Olivier Redresser.zip

Bonjour, Le PCG issu de l'export de Recap n'est pas compatible avec 2012, par contre il se charge sans souci sous 2014 ou 2015. Pour la version 2012, la seule solution c'est de repartir du fichier XYZ et de lui faire faire la conversion en PCG. Personnellement, je n'ai pas vu un gros écart de manipulation entre le PCG et le RCP. La seule différence c'est qu'avec le PCG le rafraichissement des points hors écran n'est pas fait lorsque l'on utilise le PAN ou ZOOM molette pendant une commande de dessin en cours. Je viens de faire des tests à partir d'un .LAS de 600Mo converti en ISD pour MAP 2012 et en RCP pour MAP 2014, superposé avec l'ortho-photo de 450Mo, plus MNT Covadis (DWG 120Mo) en état de terrain externe. Franchement aucune différence de performance. Tout est quasiment fluide. Par contre aucun test sous MAP 2015 tellement elle est lente et catastrophique à utiliser sur ma machine, une "horreur". Olivier

Bonjour, pour attribuer un système de coordonnées, j'utilise la commande MAPCSASSIGN ou depuis 2014, un clic sur le petit triangle noir en bas dans la barre d'état à droite du système de coordonnées. Olivier

Bonjour, dans le code, tu récupères les 2 sommets encadrants le point le plus proche pour calculer la direction du segment. Il suffit d'utiliser la fonction GetFirstDeriv au point obtenu par GetClosestPointTo pour connaître le vecteur correspondant à la tangent (dérivée première). A partir des coordonnées tu en déduis par atan Olivier

Bonjour, il y a la vieille commande CONTMNT qui permet de générer un contour englobant sur un semis de point. Olivier

Il suffit de sélectionner tout le code du message #7 et de faire un copier/coller à la place du contenu de l'ancien fichier .LSP Olivier

Je viens de modifier le code pour forcer l'écriture systématique du fichier DCL (case de dialogue) plutôt que de le réutiliser s'il existait déjà. Olivier

Bonjour, si tu fais une rotation 3D de ta pièce autour de l'axe des X par ex, est-ce que PROPMECA ne te calculerais pas le moment manquant? Olivier

Bonjour, Fonctionne chez moi sur mon MAP 2012 et Excel 2007. Où voit-on l'export XLS, moi je n'ai que TXT, CSV et XML? Olivier

Bonjour, Ci-joint le code modifié pour ajouter a transparence. Je n'ai pas touché à l'entête, n° de version ou autre. ;;-------------------=={ Layer Extractor }==------------------;; ;; ;; ;; Produces a report detailing the layer structure in every ;; ;; drawing in a selected directory (and subdirectories). ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Version: 1.4 28-04-2011 ;; ;;------------------------------------------------------------;; (defun c:LX nil (c:LayerExtract)) (defun c:LayerExtract ( / ;; --=={ Local Functions }==-- *error* _dclist _directorymode _directorytext _fixdir _getlayerproperties _getsavepath _logo _padright _popup _readconfig _replaceentrefs _writeconfig _writedcl _xmloptions ;; --=={ Local Variables }==-- _lxbit _lxcur _lxdir _lxl _lxpad _lxref _lxsl _lxsub acapp acdoc acdocs cfgfname ch data dc dclfname dcltitle df doc ext i l len ll ln lst odbx ofile out p padc savepath sfile shell str sym symlist tc tiles title titles tl val vallist versionnumber x xtitles ;; --=={ Global Variables }==-- ;; -None- ) (vl-load-com) ;; © Lee Mac 2010 (setq VersionNumber "1-4") (setq titles '("Layer" "Colour" "Linetype" "Lineweight" "Plot" "PlotStyle" "On" "Locked" "Frozen" "Frozen VP" "Description" "Transparency")) ;; Headings ;;----------------------------------------------------------;; ;; Local Functions ;; ;;----------------------------------------------------------;; (defun *error* ( msg ) (if dc (unload_dialog dc)) (mapcar (function (lambda ( file ) (if (and file (eq 'FILE (type file))) (close file))) ) (list ofile sfile) ) (mapcar 'LM:ReleaseObject (list Shell odbx)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) ;............................................................; ; gets transparency in percentage (defun getLayerTransparency (layerName / layer transparency) (setq layer (tblobjname "LAYER" layerName)) ; get the XData of AcCmTransparency (setq transparency (cdr (assoc 1071 (cdar (cdr (assoc -3 (entget layer '("AcCmTransparency")))))))) (if (= transparency nil) ; if we did not get a value it must be the default 0% (setq transparency 0) ; if we got a value then calculate from it (progn ; get the lower byte of the value 0..255 ; (100%..0% in the AutoCAD user interface) (setq transparency (lsh (lsh transparency 24) -24)) ; convert the value to a percentage (setq transparency (fix (- 100 (/ transparency 2.55)))) ) ; (progn ) ; (if (itoa transparency) ) ;............................................................; (defun _GetLayerProperties ( doc mode xref / _TF funcs l ) (defun _tf ( v ) (if (eq :vlax-true v) "YES" "NO")) (setq funcs '( (lambda ( x ) (getLayerTransparency (vla-get-name x))) (lambda ( x ) (if (vlax-property-available-p x 'Description) (vla-get-Description x) "")) (lambda ( x ) (_tf (vla-get-ViewportDefault x))) (lambda ( x ) (_tf (vla-get-Freeze x))) (lambda ( x ) (_tf (vla-get-Lock x))) (lambda ( x ) (_tf (vla-get-Layeron x))) (lambda ( x ) (vla-get-PlotStyleName x)) (lambda ( x ) (_tf (vla-get-Plottable x))) (lambda ( x / w ) (if (minusp (setq w (vla-get-lineweight x))) "DEFAULT" (rtos (/ w 100.) 2 2) ) ) (lambda ( x ) (vla-get-Linetype x)) (lambda ( x / tc ) (if (eq acColorMethodByACI (vla-get-ColorMethod (setq tc (vla-get-TrueColor x)))) (itoa (vla-get-Color x)) (vl-prin1-to-string (LM:lst->str (mapcar '(lambda ( p ) (itoa (vlax-get-property tc p))) '(Red Green Blue)) "," ) ) ) ) (lambda ( x ) (vla-get-name x)) ) ) (vlax-for layer (vla-get-Layers doc) (if (or xref (not (wcmatch (vla-get-name layer) "*|*"))) (setq l (cons ( (lambda ( i / result ) (foreach x funcs (if (= (setq i (lsh i -1)) (logand i mode)) (setq result (cons ((eval x) layer) result)) ) ) result ) 2048 ) l ) ) ) ) (vl-sort l '(lambda ( a b ) (< (car a) (car B)))) ) ;............................................................; (defun _PadRight ( st ch ln ) ( (lambda ( l ) (while (< (length l) ln) (setq l (cons ch l))) (vl-list->string (reverse l)) ) (reverse (vl-string->list st)) ) ) ;............................................................; (defun _GetSavePath ( / tmp ) (cond ( (setq tmp (getvar 'ROAMABLEROOTPREFIX)) (or (eq "\\" (substr tmp (strlen tmp))) (setq tmp (strcat tmp "\\")) ) (strcat tmp "Support") ) ( (setq tmp (findfile "ACAD.pat")) (setq tmp (vl-filename-directory tmp)) (and (eq "\\" (substr tmp (strlen tmp))) (setq tmp (substr tmp (1- (strlen tmp)))) ) tmp ) ) ) ;............................................................; (defun _WriteConfig ( filename lst / ofile ) (if (setq ofile (open filename "w")) (progn (foreach x lst (write-line (vl-prin1-to-string x) ofile)) (setq ofile (close ofile)) T ) ) ) ;............................................................; (defun _ReadConfig ( filename lst / ofile ) (if (and (setq filename (findfile filename)) (setq ofile (open filename "r"))) (progn (foreach x lst (set x (read (read-line ofile)))) (setq ofile (close ofile)) T ) ) ) ;............................................................; (defun _WriteDCL ( fname / ofile ) (if T ;;(not (findfile fname)) (if (setq ofile (open fname "w")) (progn (foreach str '( "//--------------------=={ Layer Extract }==-------------------//" "// //" "// Layer Extract Dialog Definition File to be used in //" "// conjunction with Layer Extract LISP program. //" "//------------------------------------------------------------//" "// Author: Lee Mac, Copyright © 2011 - www.lee-mac.com //" "//------------------------------------------------------------//" "" "boxcol : boxed_column { width = 65.0; fixed_width = true; alignment = centered; }" "butt12 : button { width = 12.0; fixed_width = true; alignment = centered; }" "space1 : spacer { height = 0.1; fixed_height = true; }" "pop : popup_list { width = 13.6; fixed_width = true ; alignment = centered; }" "" "layerextract : dialog { key = \"dctitle\"; spacer;" " : text { label = \"Copyright (c) 2011 Lee Mac\"; alignment = right; }" "" " : boxcol { label = \"Fields to Extract\";" " spacer;" "" " : row { alignment = centered; spacer;" "" " : column {" "" " : toggle { key = \"layer\"; label = \"Layer\"; value = \"1\"; is_enabled = false; }" "" " : toggle { key = \"colour\"; label = \"Colour\"; }" "" " : toggle { key = \"linetype\"; label = \"Linetype\"; }" "" " }" "" " : column {" " " " : toggle { key = \"lineweight\"; label = \"Lineweight\"; }" "" " : toggle { key = \"plot\"; label = \"Plot\"; }" "" " : toggle { key = \"plotstyle\"; label = \"Plot Style\"; }" "" " }" "" " : column {" "" " : toggle { key = \"on\"; label = \"On\"; }" "" " : toggle { key = \"locked\"; label = \"Locked\"; }" "" " : toggle { key = \"frozen\"; label = \"Frozen\"; }" " " " }" "" " : column {" "" " : toggle { key = \"frozenvp\"; label = \"Frozen in VP\"; }" "" " : toggle { key = \"description\"; label = \"Description\"; }" "" " : toggle { key = \"transparency\"; label = \"Transparency\"; }" "" ; " : spacer { height = 1.5; fixed_height = true; }" ; " " " }" " " " }" "" " spacer;" " }" " " " spacer;" "" " : boxcol { label = \"Drawing Directory\";" "" " : row {" "" " : column {" "" " space1;" " : text { key = \"dir_text\"; alignment = left; }" " space1;" "" " }" "" " : butt12 { label = \"Browse...\"; key = \"dir\"; }" "" " }" "" " : row {" "" " : toggle { key = \"sub_dir\"; label = \"Include Sub-Directories\"; }" " : toggle { key = \"cur_dwg\"; label = \"Current Drawing Only\" ; }" " " " }" "" " spacer;" " }" "" " spacer;" "" " : boxcol { label = \"Output Options\";" "" " : row {" "" " : column {" "" " space1;" " : text { key = \"out_text\"; alignment = left; }" " space1;" "" " }" "" " : butt12 { label = \"Browse...\"; key = \"browse\"; }" "" " }" "" " : row {" "" " : column {" "" " space1;" " : toggle { key = \"xref\"; label = \"Include XRef Layers\"; alignment = left; }" " space1;" "" " }" "" " : column {" "" " space1;" " : text { key = \"pad_text\"; label = \"Padding Character:\"; alignment = right; }" " space1;" "" " }" "" " : column {" "" " : pop { key = \"pad\"; }" " space1;" "" " }" "" " }" " " " }" "" " spacer;" "" " : row { spacer;" "" " : butt12 { key = \"xml\"; label = \"XML\"; }" "" " : spacer { width = 3.06; fixed_width = true;" " height = 2.06; fixed_height = true; }" "" " ok_cancel;" " " " : image { key = \"logo\"; alignment = centered;" " width = 16.06 ; fixed_width = true;" " height = 2.06 ; fixed_height = true; color = -15; }" " }" "}" "" "xml : dialog { label = \"XML Options\"; spacer;" "" " : row { spacer_1;" "" " : column {" "" " : toggle { key = \"xl\"; label = \"Excel Compatible\"; }" "" " : toggle { key = \"xsl\"; label = \"Create XSL Stylesheet\"; }" "" " }" "" " }" "" " spacer; ok_cancel;" "}" ) (write-line str ofile) ) (setq ofile (close ofile)) (while (not (findfile fname))) t ) ) t ) ) ;............................................................; (defun _Logo ( key ) (start_image key) (mapcar 'vector_image '(022 021 001 000 000 000 000 007 000 000 000 000 001 006 006 006 006 007 043 036 027 036 030 021 021 021 022 022 022 022 021 021 021 028 028 028 027 027 030 029 029 030 052 043 043 043 044 044 046 046 045 045 045 045 052 052 052 051 051 051 051 051 052 062 065 066 068 068 068 068 067 067 075 075 075 074 074 073 066 058 058 059 059 059 059 052 057 057 056 056 056 056 057 058 065 065 065 065 066 095 094 094 092 091 091 091 090 089 089 088 087 086 085 074 074 075 075 076 077 078 079 080 081 082 083 084 085 086 087 088 088 089 090 091 092 093 094 095 074 073 073 072 072 071 071 071 071 071 071 071 072 072 072 073 084 083 082 081 080 079 079 078 077 077 076 076 076 076 076 077 077 078 079 079 080 081 082 083 094 094 095 083 083 082 081 080 079 078 077 076 075 074 084 085 086 087 088 089 089 090 091 091 091 091 092 095 094 093 092 091 090 089 089 088 087 086 085 084) '(020 020 023 023 023 024 024 000 000 000 000 001 001 020 001 001 001 000 002 024 007 015 000 000 000 000 001 001 023 023 023 024 024 024 024 024 023 023 002 001 001 000 000 000 000 000 001 001 007 023 023 023 024 024 024 024 024 023 023 001 001 001 000 010 016 019 021 022 023 024 024 024 024 024 024 023 023 022 004 004 005 005 006 006 007 024 024 024 024 023 023 022 019 016 007 007 006 005 005 022 022 022 017 017 018 018 019 020 020 020 021 021 021 021 022 023 023 023 024 024 024 025 025 025 025 025 025 025 025 024 024 024 023 023 022 022 022 022 007 008 008 009 010 011 012 013 014 015 016 017 018 019 019 020 021 021 021 021 020 020 019 019 018 017 016 015 014 013 012 012 011 010 009 009 008 008 008 007 007 007 007 004 004 004 004 004 004 004 005 005 006 006 007 007 008 008 008 009 009 009 010 011 011 011 011 007 007 007 006 006 005 005 004 004 004 004 004 004) '(021 006 000 000 000 000 021 000 000 000 000 001 001 006 006 006 007 007 036 046 036 030 021 021 021 022 022 022 022 021 021 021 028 028 028 027 027 027 029 029 030 030 043 043 043 044 044 043 046 045 045 045 045 052 052 052 051 051 051 051 051 052 052 065 058 068 068 068 068 067 067 075 075 075 074 074 073 065 058 058 059 059 059 059 051 057 057 056 056 056 056 057 066 062 065 065 065 066 066 094 094 095 091 091 091 090 089 089 088 087 086 085 084 074 075 075 076 077 078 079 080 081 082 083 084 085 086 087 088 088 089 090 091 092 093 094 095 092 073 073 072 072 071 071 071 071 071 071 071 072 072 072 073 074 083 082 081 080 079 079 078 077 077 076 076 076 076 076 077 077 078 079 079 080 081 082 083 084 094 095 094 083 082 081 080 079 078 077 076 075 074 074 085 086 087 088 089 089 090 091 091 091 091 092 095 094 093 092 091 090 089 089 088 087 086 085 084 083) '(020 020 023 023 024 024 024 000 000 000 001 001 023 001 001 001 000 000 015 007 024 002 000 000 000 001 001 023 023 023 024 024 024 024 024 023 023 007 001 001 000 000 000 000 000 001 001 002 023 023 023 024 024 024 024 024 023 023 001 001 001 000 000 016 016 021 022 023 024 024 024 024 024 024 023 023 022 007 004 005 005 006 006 007 022 024 024 024 023 023 022 019 019 010 007 006 005 005 004 022 022 022 017 018 018 019 020 020 020 021 021 021 021 022 023 023 023 024 024 024 025 025 025 025 025 025 025 025 024 024 024 023 023 022 022 022 022 017 008 008 009 010 011 012 013 014 015 016 017 018 019 019 020 021 021 021 021 020 020 019 019 018 017 016 015 014 013 012 012 011 010 009 009 008 008 008 007 007 007 007 007 004 004 004 004 004 004 005 005 006 006 007 007 008 008 008 009 009 009 010 011 011 011 011 007 007 007 006 006 005 005 004 004 004 004 004 004 004) '(178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178) ) (end_image) ) ;............................................................; (defun _FixDir ( s ) (if (eq "\\" (substr s (strlen s))) (substr s 1 (1- (strlen s))) s ) ) ;............................................................; (defun _DirectoryMode ( val ) (foreach x '("sub_dir" "dir" "dir_text") (mode_tile x (atoi val))) ) ;............................................................; (defun _DirectoryText ( key str ) (set_tile key (if str (if (< 50 (strlen str)) (strcat (substr str 1 47) "...") str ) "" ) ) ) ;............................................................; (defun _dcList ( key lst ) (start_list key) (mapcar 'add_list lst) (end_list) ) ;............................................................; (defun _Popup ( title flags msg / WSHShell result ) (setq WSHShell (vlax-create-object "WScript.Shell")) (setq result (vlax-invoke WSHShell 'Popup msg 0 title flags)) (vlax-release-object WSHShell) result ) ;............................................................; (defun _ReplaceEntRefs ( string / _stringsubst ) (defun _stringsubst ( new old string / i nl ) (setq i 0 nl (strlen new)) (while (and (< i (strlen string)) (setq i (vl-string-search old string i))) (setq string (vl-string-subst new old string i) i (+ i nl)) ) string ) (mapcar (function (lambda ( pair ) (setq string (_stringsubst (car pair) (cdr pair) string))) ) '( ("<" . "<") (">" . ">") ("&" . "&") ("'" . "'") (""" . "\"") ) ) string ) ;............................................................; (defun _XMLOptions ( handle / xl xsl ) (cond ( (not (new_dialog "xml" handle)) (princ "\n** Error Loading XML Options Dialog **") ) (t (set_tile "xl" (setq xl _LXL )) (set_tile "xsl" (setq xsl _LXSL)) (action_tile "xl" "(setq xl $value xsl (set_tile \"xsl\" \"0\"))") (action_tile "xsl" "(setq xsl $value xl (set_tile \"xl\" \"0\"))") (if (= 1 (start_dialog)) (setq _LXL xl _LXSL xsl)) ) ) ) ;;----------------------------------------------------------;; ;; Main Routine ;; ;;----------------------------------------------------------;; (setq acapp (vlax-get-acad-object) acdoc (vla-get-ActiveDocument acapp) acdocs (vlax-for doc (vla-get-Documents acapp) (setq acdocs (cons (cons (strcase (vla-get-FullName doc)) doc) acdocs)) ) ) (if (not (vl-file-directory-p (setq SavePath (_GetSavePath)))) (progn (princ "\n** Save Path not Valid **") (exit) ) ) (setq dclfname (strcat SavePath "\\LMAC_LayerExtract_V" VersionNumber ".dcl") cfgfname (strcat SavePath "\\LMAC_LayerExtract_V" VersionNumber ".cfg") dcltitle (strcat "Layer Extractor V" (vl-string-translate "-" "." VersionNumber)) ) (setq SymList '(_LXDir _LXCur _LXSub _LXBit _LXRef _LXPad _LXL _LXSL) ValList (list (_FixDir (getvar 'DWGPREFIX)) "0" "0" 2047 "0" "0" "0" "1") ) (or (findfile cfgfname) (_WriteConfig cfgfname ValList) ) (_ReadConfig cfgfname SymList) (mapcar '(lambda ( sym val ) (or (boundp sym) (set sym val))) SymList ValList) ;............................................................; (cond ( (not (_WriteDCL dclfname)) (princ "\n** Error Writing DCL File **") ) ( (<= (setq dc (load_dialog dclfname)) 0) (princ "\n** Error Loading DCL File **") ) ( (not (new_dialog "layerextract" dc)) (setq dc (unload_dialog dc)) (princ "\n** Error Loading Dialog Interface **") ) (t (setq tiles '("colour" "linetype" "lineweight" "plot" "plotstyle" "on" "locked" "frozen" "frozenvp" "description" "transparency")) (set_tile "dctitle" dcltitle) (_DirectoryText "dir_text" _LXDir) (set_tile "sub_dir" _LXSub) (_DirectoryMode (set_tile "cur_dwg" _LXCur)) (set_tile "out_text" "Browse to Select Output File") (set_tile "xref" _LXref) (_dcList "pad" '("Space [ ]" "Tab [ ]" "Point [ . ]" "Hyphen [ - ]" "Comma [ , ]" "Semi-Colon [ ; ]")) (set_tile "pad" _LXPad) (foreach x '("pad" "pad_text") (mode_tile x 1)) (mode_tile "xml" 1) (_Logo "logo") ( (lambda ( i ) (mapcar (function (lambda ( tile ) (set_tile tile (if (= (setq i (lsh i 1)) (logand _LXBit i)) "1" "0") ) ) ) tiles ) ) 1 ) (action_tile "dir" (vl-prin1-to-string (quote (progn (if (setq tmp (LM:DirectoryDialog "Select Directory of Drawings to Process..." nil 320)) (_DirectoryText "dir_text" (setq _LXDir tmp)) ) ) ) ) ) (action_tile "sub_dir" "(setq _LXSub $value)") (action_tile "cur_dwg" "(_DirectoryMode (setq _LXCur $value))") (action_tile "browse" (vl-prin1-to-string (quote (progn (if (setq tmp (getfiled "Create Output File" "" "txt;csv;xml" 1)) (_DirectoryText "out_text" (setq out tmp)) (if out (_DirectoryText "out_text" out) (set_tile "out_text" "Browse to Select Output File") ) ) (if out (cond ( (eq ".TXT" (setq ext (strcase (vl-filename-extension out)))) (foreach x '("pad" "pad_text") (mode_tile x 0)) (mode_tile "xml" 1) ) ( (eq ".XML" ext) (foreach x '("pad" "pad_text") (mode_tile x 1)) (mode_tile "xml" 0) ) (t (foreach x '("pad" "pad_text") (mode_tile x 1)) (mode_tile "xml" 1) ) ) ) ) ) ) ) (action_tile "xref" "(setq _LXref $value)") (action_tile "pad" "(setq _LXPad $value)") (action_tile "xml" "(_XMLOptions dc)") ( (lambda ( i ) (mapcar (function (lambda ( tile ) (action_tile tile (strcat "(setq _LXBit ((if (eq \"1\" $value) + -) _LXBit " (itoa (setq i (lsh i 1))) " ))") ) ) ) tiles ) ) 1 ) (action_tile "accept" (vl-prin1-to-string (quote (progn (cond ( (not out) (_Popup "Information" 64 "Please Specify an Output File") ) ( (not (setq lst (cond ( (eq "1" _LXCur) (list (cond ( (eq "" (vla-get-FullName acdoc)) (strcat (_FixDir (vla-get-Path acdoc)) "\\" (vla-get-name acdoc)) ) ( (vla-get-FullName acdoc) ) ) ) ) ( (LM:GetAllFiles _LXDir (eq "1" _LXSub) "*.dwg") ) ) ) ) (_Popup "Information" 48 "No Drawing Files Found in the Selected Directory") ) ( (done_dialog 1) ) ) ) ) ) ) (setq df (start_dialog) dc (unload_dialog dc)) ;............................................................; (if (= 1 df) (progn (setq odbx (LM:ObjectDBXDocument)) (foreach dwg lst (if (setq doc (cond ( (eq "1" _LXCur) acdoc ) ( (cdr (assoc (strcase dwg) acdocs)) ) ( (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list odbx dwg)))) odbx ) ) ) (progn (setq data (cons (cons dwg (_GetLayerProperties doc _LXBit (eq "1" _LXref))) data)) (princ (strcat "\n--> Extracted: " (vl-filename-base dwg) ".dwg")) ) (princ (strcat "\n** Error Opening Drawing: " (vl-filename-base dwg) ".dwg")) ) ) (LM:ReleaseObject odbx) (if (setq data (vl-sort data '(lambda ( a b ) (< (car a) (car B)))) l data) (if (setq ofile (open out "w")) (progn ( (lambda ( i ) (setq titles (vl-remove-if-not (function (lambda ( title ) (= (setq i (if (zerop i) 1 (lsh i 1))) (logand i _LXBit)) ) ) titles ) ) ) 0 ) (cond ( (eq ".TXT" (setq ext (strcase (vl-filename-extension out)))) (write-line (strcat "Layer Extraction: " (menucmd "m=$(edtime,$(getvar,DATE),DDDD DD MONTH YYYY HH:MM:SS)") ) ofile ) (setq tl titles l (apply 'append (mapcar 'cdr l)) padC (nth (atoi _LXPad) '(32 9 46 45 44 59))) (while (car (setq x (mapcar 'car l))) (setq ll (cons (+ 5 (apply 'max (mapcar 'strlen (cons (car tl) x)))) ll) tl (cdr tl) l (mapcar 'cdr l)) ) (setq ll (reverse ll)) (foreach x data (write-line (strcat "\nDrawing File: " (car x)) ofile) (foreach item (cons titles (cdr x)) (write-line (vl-string-right-trim (chr padC) (apply 'strcat (mapcar '(lambda ( str len ) (_PadRight str padC len)) item ll) ) ) ofile ) ) ) ) ( (eq ".CSV" ext) (write-line (strcat "Layer Extraction:," (menucmd "m=$(edtime,$(getvar,DATE),DDDD DD MONTH YYYY HH:MM:SS)") ) ofile ) (foreach x data (write-line (strcat "\nDrawing File:," (car x)) ofile) (foreach item (cons titles (cdr x)) (write-line (LM:lst->str item ",") ofile) ) ) ) ( (eq ".XML" ext) (cond ( (eq "0" _LXL) (setq xtitles (mapcar '(lambda ( title ) (vl-string-translate " " "_" (strcase title t))) titles)) (write-line "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>" ofile) (if (eq "1" _LXSL) (write-line (strcat "<?xml-stylesheet type=\"text/xsl\" href=\"" (vl-filename-base out) ".xsl\"?>") ofile) ) (write-line "<extraction>" ofile) (write-line (strcat "\t<title>Layer Extraction: " (menucmd "m=$(edtime,$(getvar,DATE),DDDD DD MONTH YYYY HH:MM:SS)") "</title>" ) ofile ) (foreach x data (write-line "\t<file>" ofile) (write-line (strcat "\t\t<filename>" (_ReplaceEntRefs (car x)) "</filename>") ofile) (foreach item (cdr x) (write-line "\t\t<layer_item>" ofile) (mapcar (function (lambda ( tag value ) (write-line (strcat "\t\t\t<" tag ">" (_ReplaceEntRefs value) "</" tag ">") ofile) ) ) xtitles item ) (write-line "\t\t</layer_item>" ofile) ) (write-line "\t</file>" ofile) ) (write-line "</extraction>" ofile) (if (eq "1" _LXSL) (if (setq sfile (open (strcat (vl-filename-directory out) "\\" (vl-filename-base out) ".xsl") "w")) (progn (mapcar (function (lambda ( x ) (write-line x sfile)) ) (append (list "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>" "<xsl:stylesheet version=\"1.0\" xmlns:xsl=\"http://www.w3.org/1999/XSL/Transform\">" "<xsl:template match=\"/\">" "<html>" "\t<head><title>Layer Extraction</title></head>" "\t<body style=\"font-family:Verdana,Arial;font-size:10pt;background-color:#cccccc;\">" "\t\t<h3><xsl:value-of select=\"extraction/title\"/></h3>" "\t\t<table border=\"1\" cellpadding=\"5\" style=\"border-collapse:collapse;border:1px solid navy;\">" "\t\t\t<xsl:for-each select=\"extraction/file\">" "\t\t\t\t<tr bgcolor=\"#2e2e2e\">" "\t\t\t\t<th colspan=\"12\" style=\"text-align:left;color:silver;\"><xsl:value-of select=\"filename\"/></th>" "\t\t\t\t</tr>" "\t\t\t\t<tr bgcolor=\"#a8c3f3\">" ) (mapcar (function (lambda ( title ) (strcat "\t\t\t\t<th>" title "</th>")) ) titles ) (list "\t\t\t\t</tr>" "\t\t\t\t<xsl:for-each select=\"layer_item\">" "\t\t\t\t\t<tr>" "\t\t\t\t\t<xsl:choose>" "\t\t\t\t\t\t<xsl:when test=\"position() mod 2 = 0\">" "\t\t\t\t\t\t\t<xsl:attribute name=\"bgcolor\">#a8c3f3</xsl:attribute>" "\t\t\t\t\t\t</xsl:when>" "\t\t\t\t\t\t<xsl:otherwise>" "\t\t\t\t\t\t\t<xsl:attribute name=\"bgcolor\">#5c97ff</xsl:attribute>" "\t\t\t\t\t\t</xsl:otherwise>" "\t\t\t\t\t</xsl:choose>" (strcat "\t\t\t\t\t<td style=\"font-weight:bold;\"><xsl:value-of select=\"" (car xtitles) "\"/></td>") ) (mapcar (function (lambda ( title ) (strcat "\t\t\t\t\t<td><xsl:value-of select=\"" title "\"/></td>")) ) (cdr xtitles) ) (list "\t\t\t\t\t</tr>" "\t\t\t\t</xsl:for-each>" "\t\t\t</xsl:for-each>" "\t\t</table>" "\t</body>" "</html>" "</xsl:template>" "</xsl:stylesheet>" ) ) ) (setq sfile (close sfile)) ) (princ "\n** Unable to Create XML StyleSheet (XSL) File **") ) ) ) ( (eq "1" _LXL) (foreach x '( "<?xml version=\"1.0\"?>" "<?mso-application progid=\"Excel.Sheet\"?>" "<Workbook" "xmlns=\"urn:schemas-microsoft-com:office:spreadsheet\"" "xmlns:o=\"urn:schemas-microsoft-com:office:office\"" "xmlns:x=\"urn:schemas-microsoft-com:office:excel\"" "xmlns:ss=\"urn:schemas-microsoft-com:office:spreadsheet\"" "xmlns:html=\"http://www.w3.org/TR/REC-html40\">" ) (write-line x ofile) ) (foreach x data (write-line (strcat "\t<Worksheet ss:Name=\"" (_ReplaceEntRefs (vl-filename-base (car x))) "\">") ofile) (write-line (strcat "\t\t<Table ss:ExpandedColumnCount=\"" (itoa (length titles)) "\"" " ss:ExpandedRowCount=\"" (itoa (1+ (length (cdr x)))) "\" x:FullColumns=\"1\" x:FullRows=\"1\" ss:DefaultRowHeight=\"15\">" ) ofile ) (write-line "\t\t\t<Row>" ofile) (foreach title titles (write-line (strcat "\t\t\t\t<Cell><Data ss:Type=\"String\">" (_ReplaceEntRefs title) "</Data></Cell>") ofile) ) (write-line "\t\t\t</Row>" ofile) (foreach item (cdr x) (write-line "\t\t\t<Row>" ofile) (foreach prop item (write-line (strcat "\t\t\t\t<Cell><Data ss:Type=\"" (if (numberp (read prop)) "Number" "String") "\">" (_ReplaceEntRefs prop) "</Data></Cell>" ) ofile ) ) (write-line "\t\t\t</Row>" ofile) ) (write-line "\t\t</Table>" ofile) (write-line "\t</Worksheet>" ofile) ) (write-line "</Workbook>" ofile) ) ) ) ) (setq ofile (close ofile)) (princ "\n-->>> Extraction Complete.") (_WriteConfig cfgfname (mapcar 'eval SymList)) ) (princ "\n** Error Creating Output File **") ) (princ "\n** No Data to Write to Output File **") ) ) (princ "\n*Cancel*") ) ) ) (princ) ) ;;-------------------=={ Directory Dialog }==-----------------;; ;; ;; ;; Displays a dialog prompting the user to select a folder ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; msg - message to display at top of dialog ;; ;; dir - root directory (or nil) ;; ;; flag - bit coded flag specifying dialog display settings ;; ;;------------------------------------------------------------;; ;; Returns: Selected folder filepath, else nil ;; ;;------------------------------------------------------------;; (defun LM:DirectoryDialog ( msg dir flag / Shell HWND Fold Self Path ac ) (setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application") HWND (vl-catch-all-apply 'vla-get-HWND (list ac)) Fold (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir)) (vlax-release-object Shell) (if Fold (progn (setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path)) (vlax-release-object Self) (vlax-release-object Fold) (and (= "\\" (substr Path (strlen Path))) (setq Path (substr Path 1 (1- (strlen Path))))) ) ) Path ) ;;--------------------=={ Get All Files }==-------------------;; ;; ;; ;; Retrieves all files or those of a specified filetype that ;; ;; reside in a directory (and, optionally, subdirectories) ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; Dir - Directory to search ;; ;; Subs - Boolean, if T, subdirectories are included ;; ;; Filetype - (optional) Filter for filetype (DOS pattern) ;; ;;------------------------------------------------------------;; ;; Returns: List of filenames, else nil if none are found ;; ;;------------------------------------------------------------;; (defun LM:GetAllFiles ( Dir Subs Filetype / GetSubFolders ) (defun GetSubFolders ( folder / _f ) (mapcar (function (lambda ( f ) (setq _f (strcat folder "\\" f)) (cons _f (apply (function append) (GetSubFolders _f))) ) ) (cddr (vl-directory-files folder nil -1)) ) ) (apply (function append) (vl-remove (quote nil) (mapcar (function (lambda ( Filepath ) (mapcar (function (lambda ( Filename ) (strcat Filepath "\\" Filename) ) ) (vl-directory-files Filepath Filetype 1) ) ) ) (append (list Dir) (apply (function append) (if subs (GetSubFolders Dir)))) ) ) ) ) ;;-----------------=={ ObjectDBX Document }==-----------------;; ;; ;; ;; Retrieves a version specific ObjectDBX Document object ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: - None - ;; ;;------------------------------------------------------------;; ;; Returns: VLA ObjectDBX Document object, else nil ;; ;;------------------------------------------------------------;; (defun LM:ObjectDBXDocument ( / acVer ) (vla-GetInterfaceObject (vlax-get-acad-object) (if (< (setq acVer (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument" (strcat "ObjectDBX.AxDbDocument." (itoa acVer)) ) ) ) ;;------------------=={ Release Object }==--------------------;; ;; ;; ;; Releases a VLA Object from memory via plentiful error ;; ;; trapping ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; obj - VLA Object to be released from memory ;; ;;------------------------------------------------------------;; ;; Returns: T if Object Released, else nil ;; ;;------------------------------------------------------------;; (defun LM:ReleaseObject ( obj ) (vl-load-com) (and obj (eq 'VLA-OBJECT (type obj)) (not (vlax-object-released-p obj)) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-release-object) (list obj) ) ) ) ) ) ;;-------------------=={ List to String }==-------------------;; ;; ;; ;; Constructs a string from a list of strings separating ;; ;; each element by a specified delimiter ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; lst - a list of strings to process ;; ;; del - delimiter by which to separate each list element ;; ;;------------------------------------------------------------;; ;; Returns: String containing each string in the list ;; ;;------------------------------------------------------------;; (defun LM:lst->str ( lst del ) (if (cdr lst) (strcat (car lst) del (LM:lst->str (cdr lst) del)) (car lst) ) ) ;;------------------------------------------------------------;; (princ) (princ "\n:: Layer Extractor | Version 1.4 | © Lee Mac 2011 www.lee-mac.com ::") (princ "\n:: Type \"LayerExtract\" or \"LX\" to Invoke ::") (princ) ;;------------------------------------------------------------;; ;; End of File ;; ;;------------------------------------------------------------;; Olivier

Bonjour, sinon Dotsoft a mis à jour son programme qui s'appelle Autoblock (reprogrammé en .Net) qui fonctionne sans souci sous MAP et CIVIL Olivier

Bonjour, a priori, je penche aussi pour un problème Windows. A quel logiciel sont associées les fichiers JPG? Essaie d'installer ou de réinstaller un XNView (par ex) et de lui associer l'extension JPG. Ou au pire ré-associe l'extension JPG à Paint. Olivier

Bonjour, le signe ; permet de simuler la frappe sur la touche Entree c'est le signe \ qui fait une pause Olivier

Bonjour, c'est pas tout automatique, mais si tu lances la commande "Cotation angulaire" ou COTANG et que tu cliques l'arc de cercle dans ta poly, tu obtiens la cotation de ton angle sans autre construction. Olivier

Bonjour, il manque certainement le dossier qui contient tes lisp dans la liste des fichier de Support. Dans ton acaddoc.lsp il y a une ligne (load "LISTES") a priori, le fichier LISTES.LSP n'a pas été trouvé Olivier

Bonjour, Très intéressant, mais cette variable n'est disponible que depuis AutoCAD 2014 et la géolocalisation, mais par contre valable sous toutes les versions y compris AutoCAD et LT, pas forcément besoin d'un MAP ou Civil. Je ne l'ai pas sous Map2012 par exemple, et là je pense que ça nécessite forcément un MAP ou Civil et le bout de Lisp. Olivier

Bonjour, ce lisp permet juste d'automatiser la création d'un script qui crée des slide (fichier SLD) SI tu n'as que quelques blocs à ajouter, ouvre le DWG contenant le bloc, fait un zoom étendu et lance la commande MCLICHE puis sauvegarde ton fichier SLD . Sinon pour que le lisp fonctionne il demande de sélectionner un fichier LISTEDWG.TXT, ça doit être un fichier texte avec un nom de DWG (bloc) à traiter par ligne. L'as-tu bien construit comme cela? Olivier

Bonjour, il faut ajouter la déclaration d'une variable globale dans le ACADDOC.LSP du genre (setq *MAPCS* (ade_projgetwscode)) Puis dans un champ, catégorie "autres" ajouter la "variable Lisp" nommée *MAPCS* Par contre si le système est affecté (ou changé) après ouverture du dessin, il faut soit ré-exécuter la commande liste, soit fermer et ré-ouvrir le dessin pour que la variable soit mise à jour. Olivier

Salut Lili, dans le ZIP, le DWG est toujours du 23/12 et toujours en version DWG 2013 Olivier