Lisps de DenisHen

[DenisHen]

Bonjour à tous.

 

J'ai ajouté "Importation de piqué de point topo".

 

Mais un problème est survenu lors de l'attachement du fichier ZIP (81Ko) contenant le LISP, le DCL et le PDF (mode d'emploi). J'ai pourtant de l'espace disponible sur le site...

 

J'en appel à vous, chers administrateurs, de bien vouloir vérifier, s'il vous plaît, que les attachements fonctionnent bien...

 

Merci à eux.

 

Denis...

[DenisHen]

Bonjour à tous.

 

Aujourd'hui, par soucis de bien déclarer mes variables dans un Lisp, j'ai développé une petite routine en VBA dans un document WORD (.docm) qui justement, les recherche.

 

Ce document inclus une routine VBA qui recherche les variables dans un LISP. Il suffit de copier/coller son code dans la page WORD et de faire [Alt]+[F8] et de lancer la commande "ChercheVariables". Testez-le sur un petit LISP, car plus le code est long, plus la recherche est longue... Voir très longue.

 

ATTENTION, seront considérés tout ce qui n'est pas entre guillemets, commentaires et tout ce qui n'est pas une commande LISP. Donc, jes commandes créées seront considérées comme des variables...

 

Voici le lien pour le télécharger, il faut dézipper les deux fichiers dans le même répertoire (ce lien est valable jusqu'au 31 janvier 2017).

 

Un petit problème est survenu lors de l'attachement de la pièce jointe sur CadXP.

Peut-être un problème lié au site ? ?

 

Je suis, bien sûr, ouvert à toutes discutions...

 

Denis...

[(gile)]

Salut,

 

Juste pour info.

Dans l'éditeur Visual LISP, menu Outils > Options d'environnement > Options générales... > onglet Diagnostic > cocher la case "Rapporter les stats. lors de la vérification syntaxique." > OK.

 

Ensuite quand on fait "Vérifier la fenêtre" (Ctrl+Alt+C) la fenêtre se sortie affiche les résultat du contrôle de la fenêtre active dont les variables globales.

[DenisHen]

Salut (gile).

 

C'est maintenant que tu le dis ? ;)

 

En fait, j'avais lu un truc là-dessus, mais je ne comprenais pas tellement son fonctionnement, j'ai un code :

;;;*************************************
;;; Informations sur la charte en cours 
;;;*************************************
(defun c:CharteInfo (/ Valeur)
 (setq Valeur "Configuration de la charte actuelle : \n")
 (if (/= (vlax-ldata-get "DenisH" "Charte" "") "")
   (setq Valeur (strcat Valeur "\tCharte en cour \t= " (vlax-ldata-get "DenisH" "Charte")) ;_ Fin de strcat
   ) ;_ Fin de setq
 ) ;_ Fin de if
 (if (/= (vlax-ldata-get "DenisH" "CharteCalq" "") "")
   (setq Valeur (strcat Valeur "\n\tCalque en cours \t= " (vlax-ldata-get "DenisH" "CharteCalq")) ;_ Fin de strcat
   ) ;_ Fin de setq
 ) ;_ Fin de if
 (if (/= (vlax-ldata-get "DenisH" "ChartePolice" "") "")
   (setq Valeur (strcat Valeur "\n\tStyle de texte \t= " (vlax-ldata-get "DenisH" "ChartePolice")) ;_ Fin de strcat
   ) ;_ Fin de setq
 ) ;_ Fin de if
 (if (/= (vlax-ldata-get "DenisH" "CharteCalqTxt" "") "")
   (setq Valeur (strcat Valeur "\n\tCalque du texte \t= " (vlax-ldata-get "DenisH" "CharteCalqTxt")) ;_ Fin de strcat
   ) ;_ Fin de setq
 ) ;_ Fin de if
 (if (/= (vlax-ldata-get "DenisH" "CharteTypLign" "") "")
   (setq Valeur (strcat Valeur "\n\tType de ligne \t= " (vlax-ldata-get "DenisH" "CharteTypLign")) ;_ Fin de strcat
   ) ;_ Fin de setq
 ) ;_ Fin de if
 (if (/= (vlax-ldata-get "DenisH" "ChartePoliceHaut" "") "")
   (setq Valeur (strcat Valeur
                        "\n\tHauteur du texte \t= "
                        (rtos (vlax-ldata-get "DenisH" "ChartePoliceHaut") 2 0)
                        " mm"
                ) ;_ Fin de strcat
   ) ;_ Fin de setq
 ) ;_ Fin de if
 (alert Valeur)
 (princ)
) ;_ Fin de defun

 

Mais le "générateur sortie" me donne :

; === Début des statistiques:

; Définition de fonction (avec nombre d'arguments): ((C:CHARTEINFO . 0))

.

 

Et je ne comprenais pas le résultat. C'est pour cela que j'ai fais ma petite routine de recherche de variables...

[DaWeeD_Gab]

Bonjour Denis,

 

J'ai voulu tester le calcul de sommes des polylignes depuis une liste de calque mais lorsque je tape la commande DHSomPoly, autocad me retourne ce message d'erreur :

 

Somme des Polylignes par calques; erreur: no function definition: SET_TILE_LIST

 

comment faire ?

 

Cordialement,

David

[DenisHen]

Salut David.

 

Je ne comprend pas, et comme on ne peut plus joindre un fichier sur notre forum préféré, voici un lien vers la version qui fonctionne chez moi...

 

Denis...

[DaWeeD_Gab]

Avec ce dernier je n'ai plus de message d'erreur mais j'ai ça :

 

Commande: DHSOMPOLY

Somme des Polylignes par calques

Pour un total de : 0.0m

Commande:

 

dans les 2 cas la boite de dialogue (SelectCalque.DCL)

ne s'ouvre pas.

 

Je suis sous Autocad Map 2017.

[DenisHen]

Oops... Je ne sais pas pourquoi, mais j'avais oublié le fichier DCL...

 

Voici les fichiers...

[DaWeeD_Gab]

ça ne veut toujours pas marcher chez moi ! grrrr

même mesage que précedemment en ligne de commande.

La commande Sompoly me retourne bien la somme des polylignes du calque actif

[DenisHen]

La commande Sompoly est de Maître (gile).

 

La commande DHSompoly est le même code avec une sélection de plusieurs calque dans une fenêtre.

 

Est-ce que le fichier SelectCalque.DCL est bien dans un répertoire connu d'AutoCAD ?

[DaWeeD_Gab]

 

Est-ce que le fichier SelectCalque.DCL est bien dans un répertoire connu d'AutoCAD ?

 

Effectivement, non !

ça venait bien de là.

J'ai un dossier "Autocad Lisp" dans mes documents où je stocke les lisp que je télécharge, je l'ai rajouter dans les "chemins de recherche de fichiers de support en cours d'utilisation" et ça fonctionne nickel !

 

merci, bonne journée .

[DenisHen]

Ouf...

 

Content que ça fonctionne...

[DenisHen]

Bonjour à tous.

 

Voilà, grace à un membre de CadXP (je ne sais plus de qui est ce code qui m'a servi de base) et à Maître (gile), voici un lisp qui récupère l'angle d'une ligne ou celui d'un segment d'une polyligne.

 

Cette routine prend en compte la variable "snapang", pour le cas où le plan aurait une rotation avec le curseur parallèle à la fenêtre AutoCAD :

;;; ***************************************************************************
;;; Ce lisp récupère l'angle d'une ligne ou celui d'un segment d'une polyligne.
;;; Il prend en compte la variable "snapang" (rotation du curseur)             
;;; Si aucun segment n'est sélectionné, le texte sera selon l'angle du curseur 
;;; ***************************************************************************
(defun c:AngSegm (/ x_alpha typent e_seg dxf_11 dxf_ent l_2pt)
 (if (setq e_seg (entsel "\tSélectionnez le segment de la polyligne ou [ENTRÉE] pour un texte horizontal : "))
   (progn (setq typent (cdr (assoc 0 (setq dxf_ent (entget (car e_seg))))))
          (cond ((or (eq typent "XLINE") (eq typent "RAY"))
                 (setq dxf_11 (cdr (assoc 11 dxf_ent)))
                 (setq x_alpha (angtos (atan (/ (cadr dxf_11) (car dxf_11)))))
                 (grdraw (trans (cdr (assoc 10 dxf_ent)) 0 1)
                         (polar (trans (cdr (assoc 10 dxf_ent)) 0 1) x_alpha (distance (getvar "vsmin") (getvar "vsmax")))
                         -1
                         1
                 ) ;_ Fin de grdraw
                )
                ((eq typent "LINE")
                 (setq x_alpha (angtos (angle (cdr (assoc 10 dxf_ent)) (cdr (assoc 11 dxf_ent)))))
                 (grdraw (trans (cdr (assoc 10 dxf_ent)) 0 1) (trans (cdr (assoc 11 dxf_ent)) 0 1) -1 1)
                 (if (< (cos (+ (angtof x_alpha))) (cos (getvar "snapang")))
                   (setq x_alpha (angtos (+ (angtof x_alpha) pi) 2 3))
                 ) ;_ Fin de if
                )
                ((or (eq typent "LWPOLYLINE")
                     (and (eq typent "POLYLINE") (zerop (boole 1 118 (cdr (assoc 70 dxf_ent)))))
                 ) ;_ Fin de or
                 (setq l_2pt (near_vertex_arr e_seg))
                 (grdraw (car l_2pt) (cadr l_2pt) -1 1)
                 (if (zerop (caddr l_2pt))
                   (setq x_alpha (angtos (angle (trans (car l_2pt) 1 0) (trans (cadr l_2pt) 1 0))))
                   (progn (princ "\nNe peut obtenir un angle depuis ce type d'objet!"))
                 ) ;_ Fin de if
                )
          ) ;_ Fin de cond
   ) ;_ Fin de progn
 ) ;_ Fin de if
 (if (= e_seg nil)
   (progn (cond ((= (getvar "AUNITS") 0)
                 (setq alpha (- 90 (* (/ (getvar 'snapang) pi) 180))) ;
                )
                ((= (getvar "AUNITS") 2)
                 (setq alpha (- 100 (* (/ (getvar 'snapang) pi) 200))) ;
                )
                ((= (getvar "AUNITS") 3)
                 (setq alpha (- (/ pi 2) (getvar 'snapang))) ;
                )
          ) ;_ Fin de cond
   ) ;_ Fin de progn
   (progn (setq x_alpha (angtof x_alpha))
          (if (< (cos (- x_alpha (getvar 'snapang))) 0.)
            (setq x_alpha (+ x_alpha pi))
          ) ;_ Fin de if
          (setq alpha (angtos x_alpha 2 10))
          (setq alpha (atof (vl-string-translate "   " "dgr" alpha)))
   ) ;_ Fin de progn
 ) ;_ Fin de if
 (princ "\nFin")
 alpha
) ;_ Fin de defun
(defun near_vertex_arr (obj      /        obj      dxf_obj  obj_vlax
                       pt_sel   par      pt_first pt_snd   i
                       bulge    e_next
                      )
 (setq dxf_obj (entget (car obj)))
 (vl-load-com)
 (setq obj_vlax (vlax-ename->vla-object (car obj))
       pt_sel   (vlax-curve-getClosestPointTo
                  obj_vlax
                  (trans (osnap (cadr obj) "_near") 1 0)
                ) ;_ Fin de vlax-curve-getClosestPointTo
       par      (vlax-curve-getParamAtPoint obj_vlax pt_sel)
       pt_first (trans (vlax-curve-getPointAtParam obj_vlax (fix par)) 0 1)
       pt_snd   (trans (vlax-curve-getPointAtParam obj_vlax (1+ (fix par)))
                       0
                       1
                ) ;_ Fin de trans
       i        0
 ) ;_ Fin de setq
 (cond ((eq (cdr (assoc 0 dxf_obj)) "LWPOLYLINE")
        (while (or (/= (caar dxf_obj) 42)
                   (if (< i (fix par))
                     (setq i (1+ i))
                   ) ;_ Fin de if
               ) ;_ Fin de or
          (setq bulge   (cdadr dxf_obj)
                dxf_obj (cdr dxf_obj)
          ) ;_ Fin de setq
        ) ;_ Fin de while
       )
       (T
        (setq e_next (entnext (car obj)))
        (repeat (fix par) (setq e_next (entnext e_next)))
        (setq bulge (cdr (assoc 42 (entget e_next))))
       )
 ) ;_ Fin de cond
 (list pt_first pt_snd bulge)
) ;_ Fin de defun

 

EDIT 1: j'ai modifié le code pour que, si aucun segment n'est sélectionné pour indiquer la direction de ce dernier, l'angle sera celui du curseur, on peut normalement travailler en degrés, grades ou radians.

 

EDIT 2 : résolution (oui, déjà) d'un problème entre les unités.

 

EDIT 3 : Oublie de "near_vertex_arr"

[philous2]

Re.

 

J'ai ajouté à mes routines "Changement de projection d'un DWG".

 

Elle fonctionne sur MAP, mais pour les autres AutoCAD, je n'en sais rien... Si je pouvais avoir un petit retour, ce serait cool... ;)

 

Denis...

Bjr denis,

 

Je suis tombé sur ton post qui peut m'intéresser. Je travaille dans bureau d'études TP sur Autocad MAP 2012.

On est donc souvent confronté à des fichiers de systèmes de coordonnés différents.

c'est quoi ta routine exactement et ou peut-on la télécharger ?

Merci d'avance

A plus

Phil

[je56]

Bonjour Phil,

tu peux aller voir sur la première page du post,Denis met a disposition les lisp qu'il concocte. (D’ailleurs merci Denis :) )

 

Eric

[DenisHen]

Salut.

 

Cette routine permet de changer de projection un fichier. Il y a les 6 zones LAMBERT (1, 2, 3, 4, 2 étendu et 93) ainsi que les coniques conformes.

 

Pour l'utiliser, il faut connaitre le système d'origine et ouvrir un nouveau dessin avant son utilisation.

 

De rien Eric, je dois tellement à CadXP que mon partage n'est qu'un juste retour... ;)

[philous2]

Bonjour Phil,

tu peux aller voir sur la première page du post,Denis met a disposition les lisp qu'il concocte. (D’ailleurs merci Denis :) )

 

Eric

Merci Eric je n'avais pas poussé ma recherche sur la 1ère page

Tu as raison merci Denis.

 

A+

 

Phil

[philous2]

Salut.

 

Cette routine permet de changer de projection un fichier. Il y a les 6 zones LAMBERT (1, 2, 3, 4, 2 étendu et 93) ainsi que les coniques conformes.

 

Pour l'utiliser, il faut connaitre le système d'origine et ouvrir un nouveau dessin avant son utilisation.

 

De rien Eric, je dois tellement à CadXP que mon partage n'est qu'un juste retour... ;)

Encore merci Denis je regarde souvent tes posts toujours très intéressant.

Moi au niveau boulot je suis au bureau d'études routes du Conseil Départemental 22, j'ai souvent des problèmes de changement de coordonnés de fichiers, des vieux et plus récent, principalement du système Lambert 1 en CC48.

A +

 

Phil

[philous2]

Salut.

 

Cette routine permet de changer de projection un fichier. Il y a les 6 zones LAMBERT (1, 2, 3, 4, 2 étendu et 93) ainsi que les coniques conformes.

 

Pour l'utiliser, il faut connaitre le système d'origine et ouvrir un nouveau dessin avant son utilisation.

 

De rien Eric, je dois tellement à CadXP que mon partage n'est qu'un juste retour... ;)

Rebjr Denis,

Quand tu ouvres un nouveau tu le configures avec le nouveau système je suppose.

¨Par exemple, j'ai un fichier en Lambert 1 et je veux le changer en CC48.

j'ouvre donc un nouveau que je configure en CC48 et j'utilise ton lisp pour transformer mon fichier d'origine à transformer en Lambert 1, et ça le fait sans plus, sans aucune autre manip !

Si c'est aussi simple il va m'intéresser ainsi que des collègues de boulot.

[DenisHen]

Re,

 

En fait, tu ouvre un nouveau dessin et tu lances tout de suite mon code.

 

Tous t'est demandé au fur et à mesure...

 

Le mieux est de renommer ton ancien fichier comme ça : NomDuFichier_L1N.dwg" (pour Lambert 1 Nord).

 

Ensuite, mon code changera le L1N en CC48 par exemple.

[philous2]

Re,

 

En fait, tu ouvre un nouveau dessin et tu lances tout de suite mon code.

 

Tous t'est demandé au fur et à mesure...

 

Le mieux est de renommer ton ancien fichier comme ça : NomDuFichier_L1N.dwg" (pour Lambert 1 Nord).

 

Ensuite, mon code changera le L1N en CC48 par exemple.

rep,

 

J'ai commencé à tester ton lisp ça marche pas.

J'ai un soucis. J'ai bien ouvert un nouveau fichier, j'ai lancé ton lisp, j'ai bien eu la 1ère boite de dialogue me demandant le choix de la projection source, ce que j'ai fait, j'ai été cherché mon fichier correspondant qui est bien en Lambert 1 nord. Et c'est là que ça déconne. J'ai ce message comme ligne de commande (fin de la sélection du système source...) et j'ai nombre de dessin source sélectionné = 0, et j'ai toujours la boite de dialogue précédente ouverte dans le choix de la projection source.

J'ai essayé plusieurs fichiers en Lambert 1, même constat, j'ai un soucis quelque part, c'est clair

[philous2]

Re,

 

En fait, tu ouvre un nouveau dessin et tu lances tout de suite mon code.

 

Tous t'est demandé au fur et à mesure...

 

Le mieux est de renommer ton ancien fichier comme ça : NomDuFichier_L1N.dwg" (pour Lambert 1 Nord).

 

Ensuite, mon code changera le L1N en CC48 par exemple.

 

Voilà ce que j'ai comme message d'erreur sur mes différents tests.

Je viens peut-être de comprendre,je n'ai pas renommé mon fichier comme tu l'as indiqué.

 

Message #3: Impossible de changer l'état actif de E:\users\..\FdP 1000è complet

2D.dwg.

Code du message: 1503.

Message #0: Le répertoire E:\users\..\FdP 1000è complet 2D.dwg n'existe pas.

E:\USERS\LEGOFFPH\users\legoffph\Desktop\

Code du message: 3103.

Message #1: Code de système de coordonnées incorrect ou manquant.

Code du message: 2.

Message #4: Impossible de changer l'état actif de E:\users\legoffph\Réseaux

L1N.dwg.

Code du message: 1503.

Message #0: Le répertoire E:\users\legoffph\Réseaux L1N.dwg n'existe pas.

E:\USERS\LEGOFFPH\users\legoffph\

Code du message: 3103.

Message #1: Code de système de coordonnées incorrect ou manquant.

Code du message: 2.

Message #5: Impossible de changer l'état actif de

E:\users\legoffph\Documents\..\L14-111.dwg.

Code du message: 1503.

Message #0: Le répertoire E:\users\legoffph\Documents\..\L14-111.dwg n'existe

pas.

E:\USERS\LEGOFFPH\users\legoffph\Documents\_Travail\_RD768 - Dév.Nord -Est

Plancoët\levé topo plancoët\

Code du message: 3103.

Message #1: Code de système de coordonnées incorrect ou manquant.

Code du message: 2.

Message #6: Impossible de changer l'état actif de E:\users\legoffph\..\Levé

Lemoigne-fdp.dwg.

Code du message: 1503.

Message #0: Le répertoire E:\users\legoffph\..\Levé Lemoigne-fdp.dwg n'existe

pas.

E:\USERS\LEGOFFPH\users\legoffph\Documents\_Travail\_Giratoire rue de

Paris\Topo\

Code du message: 3103.

Message #1: Code de système de coordonnées incorrect ou manquant.

Code du message: 2.

InsUnits...terminé

Projection terminée.

[philous2]

Re,

 

En fait, tu ouvre un nouveau dessin et tu lances tout de suite mon code.

 

Tous t'est demandé au fur et à mesure...

 

Le mieux est de renommer ton ancien fichier comme ça : NomDuFichier_L1N.dwg" (pour Lambert 1 Nord).

 

Ensuite, mon code changera le L1N en CC48 par exemple.

 

Non non rien à faire même en renommant mon fichier

[Olivier Eckmann]

Bonjour,

 

En ayant juste survoler le code, je pense que Denis n'a pas prévu/géré/créé les alias lorsque le dessin à transformer n'est pas sur le lecteur C:

Il va falloir que tu ajoutes un nouvel alias E=E: dans ta configuration de MAP et que tu le rendes courant, explication ICI

Sinon tu as un tutoriel fait par Patrice pour reprojeter des dessins via MAP 2012 (message 25, 26, 27 et 28) de cette discussion . Tu peux lire toute la discussion qui s'étend sur quelques années avec les changements d'interface graphique depuis MAP R3 (basé sur AutoCAD 14) jusqu'à 2012.

 

Olivier

[DenisHen]

Salut à tous.

 

Merci Olivier pour ton aide.

 

Effectivement, j'ai déjà remarqué cela, mais comme chez moi c'est soit C: soit le réseau (\\serveur\\...), j'avais mis ça sur le dos du chemin "réseau"...

 

Notre administrateur réseau nous a interdit de créer des "lecteurs réseaux" à cause des ransomwares qui s'attaquent à tous les lecteur quels qu'ils soient mais pas aux réseaux...

 

Mais je ne connaissais pas les "alias"...

 

Encore merci Olivier... ;)

 

Tiens nous au courant philous2 si c'est ok...