xdata

lili2006 · le 3 décembre 2007

Bonsoir à toutes et tous,

Bred, j'ai testé au lycée aujourd'hui sur des V2007 full en réseau, pas de problème ??!!

J'ai retesté sur une V2008 sous XP SP2, pas de problème ??!!

Retest sur mon 2008 sous vista, toujours le même message d'erreur, donc ??!!

Comprend pas.

Ce n'est pas cependant dramatique mais "bizarre" tout de même.

Merci encore et bonne soirée.

speedy · le 4 décembre 2007

Bonjour à tous

Merci à lili d'avoir lancé ce sujet qui est trés interressent, j'ai testé le code de Bred (cim..),

fonctionne trés bien avec autocad 2007.

à mon ancien poste j'utilisais Géoconcept, qui faisait tous ça intuitivement, je communiquais avec autocad map par l'intermédiare des fichiers shapes.

Si j'ai bien compris je crée mes xdata des zones selectionnées et ensuite avec cimxl j'exporte ces infos, comment se passe ensuite les requètes dans autocad et est ce possible en modifiant le fichier .csv de mettre à jour Autocad ?

@+

Michel a

lili2006 · le 4 décembre 2007

Bonsoir à toutes et tous,

Merci d'avoir relancé le post speedy, c'était ma prochaine question,...

Une idée ?

Bred · le 7 décembre 2007

Salut,

comment se passe ensuite les requètes dans autocad

Il faut faire un tri des objets selectionnés suivant la demande, ou revoir plus précisement les xdata pour créer des info plus facile à rechercher.

est ce possible en modifiant le fichier .csv de mettre à jour Autocad

C'est possible, mais il faudra lancer une mise à jour manuel dans Aocad (il faudra lui dire).

Mais pour ça il faut aussi référencer dans le tableau quel objets contiens les xdata.

Tous cela est possible, mais il me faut du temps et là je n'en ai pas, désolé.

A suivre ....

lili2006 · le 7 décembre 2007

Bonjour à tous et toutes,

Merci Bred de tes réponses, maintenant on sait que c'est possible !

Tous cela est possible, mais il me faut du temps et là je n'en ai pas, désolé.
A suivre ....

Tu m'as déjà beucoup aidé et t'en remercie encore.

A nsuivre donc avec plaisir,....

@+

Bred · le 8 décembre 2007

Salut,

donc, la suite, 1ère partie :

La liaison Excel->Autocad.

Si les données dans le tableau .csv sont modifiés et que la commande "xlcim" est lancé, les xdata sont (normalement) mis à jour.

(attention, ne pas changer la première valeur : celle-ci fait référence à l'objet contenant les xdata)

J'ai aussi modifiez l'écriture et du rangement des xdata (en prévision de la suite...)

donc tout recharger

(commande cim / cimxl et xlcim + routine Set-xData-lili)

A tester.... merci.

;;;
;;;(setq ar1 (vlax-make-safearray vlax-vbInteger '(0 . 3)))
;;;(vlax-safearray-fill ar1 '(1001 1000 1070 1040))
;;;(setq ar2 (vlax-make-safearray vlax-vbVariant '(0 . 3)))
;;;(vlax-safearray-fill ar2 '("myApp" "myString" 777 333.333 ))
;;;
;;;(vla-setXdata oBlock ar1 ar2)



(defun Set-xData-lili (ent lst / VLA-OB XDATA XTYPE)
 (if (equal (type ent) 'ENAME)(setq ent (vlax-ename->vla-object ent)))
 (setq xData (vlax-make-safearray vlax-vbVariant (cons 0 1))
xType (vlax-make-safearray vlax-vbInteger (cons 0 1)))
 (vlax-safearray-fill xData lst)
 (vlax-safearray-fill xType '(1001 1000))
 (vla-setxdata ent xType xData)
)

(defun c:cim (/ ADRESSE ENT LOCALISATION NOM TXT L VLA-OB XDATA XTYPE )
 (setq ent (car (entsel "\n Choisir l'objet dans lequel enregistrer les renseignements :")))
 (if ent
   (progn
     (setq vla-ob (vlax-ename->vla-object ent))
     (vla-getxdata vla-ob "" 'xType 'xData)
     (if (and xType xData)
(progn
  (setq l (mapcar 'vlax-variant-value (vlax-safearray->list xData)))
  (alert (strcat "Xdata Existants : " "\n ENTITE: " (nth 1 l)
		 "\n NOM: " (nth 3 l)"\n ADRESSE: "(nth 5 l)"\n LOCALISATION: "(nth 7 l))))
(progn
  (setq Nom (getstring T "\n Nom :")
	adresse (getstring T "\n Adresse :")
	localisation (getstring T "\n Localisation :"))
  (Set-xData-lili ent (list "ENTITE" (vla-get-handle vla-ob)))
  (Set-xData-lili ent (list "NOM" Nom))
  (Set-xData-lili ent (list "ADRESSE" adresse))
  (Set-xData-lili ent (list "LOCALISATION" localisation))	  
  )
)
     )
   )
 (princ)
)

(defun c:cimxl (/ E F I L SEL XDATA XTYPE)
 (setq sel (ssget) 
f (open "c:\\testcim.csv" "w"))
 (repeat (setq i (sslength sel))
   (setq e (vlax-ename->vla-object (ssname sel (setq i (1- i)))))
   (vla-getxdata e "" 'xType 'xData)
   (if (and xType xData)
     (progn
(setq l (mapcar 'vlax-variant-value (vlax-safearray->list xData)))
(princ (nth 1 l) f)
(princ ";" f)
(princ (nth 3 l) f)
(princ ";" f)
(princ (nth 5 l) f)
(princ ";" f)
(princ (nth 7 l) f)
(princ "\n" f)
)
     )
   )
 (close f)
)

(defun c:xlcim (/ ADRESSE ENT F H L LOCALISATION NOM)
 (setq f (open "c:\\testcim.csv" "r")
l "l")
 (while l
   (setq l (read-line f))
   (if l
     (progn
(setq l (substr l (+ 2 (vl-string-search "\"" l)) (strlen l))
      h (substr l 1 (vl-string-search ";" l))
      ent (handent h))
(if ent
  (if (entget ent)
  (progn
    (setq l (substr l (+ 2 (vl-string-search ";" l)) (strlen l))
	  Nom (substr l 1 (vl-string-search ";" l))
	  l (substr l (+ 2 (vl-string-search ";" l)) (strlen l))
	  adresse (substr l 1 (vl-string-search ";" l))
	  l (substr l (+ 2 (vl-string-search ";" l)) (strlen l))
	  localisation (substr l 1 (vl-string-search ";" l))
	  localisation (substr l 1 (vl-string-search "\"" l)))
    (Set-xData-lili ent (list "ENTITE" h))
    (Set-xData-lili ent (list "NOM" Nom))
    (Set-xData-lili ent (list "ADRESSE" adresse))
    (Set-xData-lili ent (list "LOCALISATION" localisation))
    (princ (strcat "\n Entité " h " Mis à Jour."))
    )
  (alert (strcat "Entité " h " Supprimé !"))
  )
  (alert (strcat "Entité " h " Non trouvé !"))
  )
)
     )
   )
(close f)
(princ)
)

Edit : Test si l'entité existe.

[Edité le 9/12/2007 par Bred]

lili2006 · le 9 décembre 2007

Bonjour à toutes et tous,

Bred, j'ai toujours le même soucis (avec Vista ???!!) =>

Commande: cim
Choisir l'objet dans lequel enregistrer les renseignements :
Nom :M. Personne
Adresse :13, Rue du Test
Localisation :2nd Allée Sud-Est
Commande:
Commande: cimxl
Choix des objets: 1 trouvé(s)
Choix des objets:
; erreur: type d'argument incorrect: FILE nilCommande:

Je vais donc chercher le portable d'un copain qui est sous XP SP2 et ta première routine fonctionnait et revient de suite.

Merci de me proposer une solution.

Dés que j'ai l'ordi, je revient (maxi 12h00 je pense).

A'd't'al.

Bred · le 9 décembre 2007

Salut,

; erreur: type d'argument incorrect: FILE nilCommande:

C'est totalement incompréhensible, vu que le ce code ici fonctionne chez toi.... :casstet: :P

essaye en cheangeant le nome du fichier en "c:\\test.csv"...

Ou encore : avec le bloc note, crées un "c:\\testcim.csv" (vide), et dans l'editeur visual-lisp charge la ligne

(findfile "c:\\testcim.csv")

, cela devrait te retourner "c:\\testcim.csv"

lili2006 · le 9 décembre 2007

Re,

J'ai donc fait un test sur l'autre ordi. Pas de pb pour le début. Par contre, après avoir fait une modif sur Excel et enregistrer, lorsque je repasse sous AutoCAD et que je fais "xlcim", AutoCAD me renvoi =>

Commande: xlcim
Commande inconnue "XLCIM". Appuyez sur F1 pour obtenir de l'aide.

Quant au test que tu proposes, ou devrais-je avoir ?=>

(findfile "c:\\testcim.csv")

Si c'est dans l'éditeur, rien !, si c'est dans le fichier "c:\\testcim.csv" , rien non plus par contre à l'ouverture, j'ai le message Excel avant l'ouverture =>

Impossible de lire le fichier

et juste aprés j'ai bien le fichier (vide) ouvert mais en lecture seule !

Sous XP, il ouvre le fichier .CSV "normalement" mais toujours vide !

Voilà pour les premiers retour.

Merci encore.

Bred · le 9 décembre 2007

Re,

Commande: xlcim
Commande inconnue "XLCIM". Appuyez sur F1 pour obtenir de l'aide.

Cela voudrais dire que tu n'as pas charger le code "XLCIM" ("Commande inconnue")

Quant au test que tu proposes, ou devrais-je avoir ?=>

citation extraite du message original:
(findfile "c:\\testcim.csv")

Essaye de le copier dans la ligne de commande.

... j'vais manger... à tou'Te

lili2006 · le 9 décembre 2007

Re,

J'avais chargé l'ensemble des routines sous le même fichier (xData-lili) et tapes ensuite en ligne de commande soit, " cim ,cimxl ,ou xlcim). Dans le doute, j'ai créeé un fichier Lisp portant le nom "xlcim", que j'ai chargé et voici ce que me retourne AutoCAD =>

Remarque (sur le Lisp (xData-lili), cim & cimxl fonctionne parfaitement sous XP et AutoCAD 2008, ordi de mon ami !!, mais toujours pas sur le mien,..)

Commande: _appload xlcim.LSP correctement chargé(s)
xlcim.LSP correctement chargé(s)
Commande: ; erreur: structure incorrecte de la liste en entrée
Commande: ; erreur: structure incorrecte de la liste en entrée
Commande:
Commande: xlcim
Commande inconnue "XLCIM". Appuyez sur F1 pour obtenir de l'aide.

J'ai peut-être fait une mauvaise manip (ce qui m'surprendrai pas,...!)

Bon apétit alors et à d't'al,...

Bred · le 9 décembre 2007

:casstet: :casstet: :casstet:

J'ai re-testé dans le doute, je n'ai pas de problème....

peut-être ne faut-il pas appeller le lsp "xlcim.LSP", appel-le n'importe comment, mais pas du nom d'une routine (je n'ai jamais testé en fait).

Mais peut-être que vu l'abondance de test que tu fais, tu devrais passer par l'editeur pour charger les lisp "à la main"...

PS : J'ai édité le code précédent afin qu'il fonctionne si l'entité dans le tableau n'a jamais existé.

re-copie le.

lili2006 · le 9 décembre 2007

Re,

Mais peut-être que vu l'abondance de test que tu fais, tu devrais passer par l'editeur pour charger les lisp "à la main"...

C'est bien ce que je fais, pourtant !

Je reteste et revient.

Merci encore Bred

lili2006 · le 9 décembre 2007

Re,

J'ai rechargé le code, l'ensemble fonctionne sauf xlcim aprés modif dans le tableur (j'ai laissé l'extension ".csv", un rapport ?)

J'ai cependant un nouveau message =>

Commande: cim
Choisir l'objet dans lequel enregistrer les renseignements :
Nom :test
Adresse :rue du test
Localisation :Allée 13
Commande:
Commande: cimxl
Choix des objets: 1 trouvé(s)
Choix des objets: 1 trouvé(s), 2 au total
Choix des objets:
nil
Commande:
Commande: xlcim
; erreur: type d'argument incorrect: numberp: nil
Commande

Merci.

Bred · le 9 décembre 2007

Commande: xlcim
; erreur: type d'argument incorrect: numberp: nil

Ha ! Enfin quelque chose de concret ! ;)

Cela veut dire que le programme attends un nombre et à nil à la place...

Fait un Ctrl+F9 au moment de l'erreur, et copie la ligne surligné.

Le problème devrais venir de la récupération des données dans le csv.

Dans l'editeur visual lisp, tu devrais charger ligne par ligne le prog et voir ce que ça te retourne...

(Il faut que je te laissse, là, à plus tard....)

Bred · le 9 décembre 2007

Je m'en vais, mais avant, je pense avoir trouver l'erreur, Re-charge tout :

(defun Set-xData-lili (ent lst / VLA-OB XDATA XTYPE)
 (if (equal (type ent) 'ENAME)(setq ent (vlax-ename->vla-object ent)))
 (setq xData (vlax-make-safearray vlax-vbVariant (cons 0 1))
xType (vlax-make-safearray vlax-vbInteger (cons 0 1)))
 (vlax-safearray-fill xData lst)
 (vlax-safearray-fill xType '(1001 1000))
 (vla-setxdata ent xType xData)
)

(defun c:cim (/ ADRESSE ENT LOCALISATION NOM TXT L VLA-OB XDATA XTYPE )
 (setq ent (car (entsel "\n Choisir l'objet dans lequel enregistrer les renseignements :")))
 (if ent
   (progn
     (setq vla-ob (vlax-ename->vla-object ent))
     (vla-getxdata vla-ob "" 'xType 'xData)
     (if (and xType xData)
(progn
  (setq l (mapcar 'vlax-variant-value (vlax-safearray->list xData)))
  (alert (strcat "Xdata Existants : " "\n ENTITE: " (nth 1 l)
		 "\n NOM: " (nth 3 l)"\n ADRESSE: "(nth 5 l)"\n LOCALISATION: "(nth 7 l))))
(progn
  (setq Nom (getstring T "\n Nom :")
	adresse (getstring T "\n Adresse :")
	localisation (getstring T "\n Localisation :"))
  (Set-xData-lili ent (list "ENTITE" (vla-get-handle vla-ob)))
  (Set-xData-lili ent (list "NOM" Nom))
  (Set-xData-lili ent (list "ADRESSE" adresse))
  (Set-xData-lili ent (list "LOCALISATION" localisation))	  
  )
)
     )
   )
 (princ)
)

(defun c:cimxl (/ E F I L SEL XDATA XTYPE)
 (setq sel (ssget) 
f (open "c:\\testcim.csv" "w"))
 (repeat (setq i (sslength sel))
   (setq e (vlax-ename->vla-object (ssname sel (setq i (1- i)))))
   (vla-getxdata e "" 'xType 'xData)
   (if (and xType xData)
     (progn
(setq l (mapcar 'vlax-variant-value (vlax-safearray->list xData)))
(princ (nth 1 l) f)
(princ ";" f)
(princ (nth 3 l) f)
(princ ";" f)
(princ (nth 5 l) f)
(princ ";" f)
(princ (nth 7 l) f)
(princ "\n" f)
)
     )
   )
 (close f)
)

(defun c:xlcim (/ ADRESSE ENT F H L LOCALISATION NOM)
 (setq f (open "c:\\testcim.csv" "r")
l "l")
 (while l
   (setq l (read-line f))
   (if l
     (progn
(if (vl-string-search "\"" l)
  (setq l (substr l (+ 2 (vl-string-search "\"" l)) (strlen l))))
(setq h (substr l 1 (vl-string-search ";" l))
      ent (handent h))
(if ent
  (if (entget ent)
  (progn
    (setq l (substr l (+ 2 (vl-string-search ";" l)) (strlen l))
	  Nom (substr l 1 (vl-string-search ";" l))
	  l (substr l (+ 2 (vl-string-search ";" l)) (strlen l))
	  adresse (substr l 1 (vl-string-search ";" l))
	  l (substr l (+ 2 (vl-string-search ";" l)) (strlen l))
	  localisation (substr l 1 (vl-string-search ";" l)))
    (if (vl-string-search "\"" l)
      (setq localisation (substr l 1 (vl-string-search "\"" l))))		  
    (Set-xData-lili ent (list "ENTITE" h))
    (Set-xData-lili ent (list "NOM" Nom))
    (Set-xData-lili ent (list "ADRESSE" adresse))
    (Set-xData-lili ent (list "LOCALISATION" localisation))
    (princ (strcat "\n Entité " h " Mis à Jour."))
    )
  (alert (strcat "Entité " h " Supprimé !"))
  )
  (alert (strcat "Entité " h " Non trouvé !"))
  )
)
     )
   )
(close f)
(princ)
)

A plus tard.

lili2006 · le 9 décembre 2007

Re,

ça marche nickel Bred !

Merci beaucoup pour cette première étape (heu, d'ailleurs, c'est quoi les autres ??!!)

Si je veux rajouter des renseignements ou même crééer un autre petit SIG, est-ce que je peux garder la structure de ton code.

Que dois-je rajouter pour une nouvelle requête.

En tous cas, merci beaucoup, je vais pouvoir tester cela à plus grande échelle dés demain.

Au plaisir,

lili2006 · le 9 décembre 2007

Re,

Une question complémentaire. Peux-t'on visualiser les renseignements liés aux entités directement depuis AutoCAD (avec son handle, je suppose,..) ??

Merci d'avance.

bonuscad · le 9 décembre 2007

Lilli2006

Voici un usage que j'ai réaliser avec des XDATA. (rien à voir avec les cimetières)

Tout avec un autocad classique.

La problèmatique du départ, était que j'avais un réseau digitalisé à une échelle IGN.

De ce réseau constitué de tronçons, j'avais les infos littéralles (longueur de polyligne)

D'autre part j'ai une base de donnée non graphique de PR (Point Routier)

Cette base me donne un Point Routier de Départ et de Fin.

L'interval me donne la longueur référencée, et bien sur cela ne correspond pas à la longueur de ma polyligne.

Donc j'ai choisi d'attacher des xdatas pour référencer mon réseau graphique.

Bien que je n'avais pas prévu de diffuser ce code (usage trop spécifique, et je l'ai développer pour mon usage seul)

De plus je ne peux diffuser ma base comme exemple (ces données sont privées)

Donc pour te mettre en situation similaire (enfin a peu près!)

Tu vas copier-coller ce qui suit en ligne de commande dans un dessin vierge.

Affecte des couleurs aux calques crés si tu le désire.

(entmake
'(
(0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "Voirie catégorie-1")
(100 . "AcDbPolyline")
(90 . 11)
(70 . 0)
(43 . 0.0)
(38 . 0.0)
(39 . 0.0)
(10 102480.0 277877.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 103318.0 278436.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.30265)
(10 103997.0 278436.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.108544)
(10 104516.0 277897.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.331346)
(10 105015.0 277698.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.415571)
(10 105314.0 278216.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 105035.0 279248.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.183401)
(10 105154.0 280451.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.0532713)
(10 106605.0 282726.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.333076)
(10 107373.0 282925.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0467885)
(10 109052.0 282413.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.101581)
(210 0.0 0.0 1.0)
)
)
(entmake
'(
(0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "Vorie catégorie-2")
(100 . "AcDbPolyline")
(90 . 7)
(70 . 0)
(43 . 0.0)
(38 . 0.0)
(39 . 0.0)
(10 105032.0 279259.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 105376.0 279129.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.158282)
(10 106313.0 279083.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.327094)
(10 106611.0 278969.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.0154517)
(10 106816.0 278626.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.418097)
(10 107479.0 278443.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.00319695)
(10 108416.0 278992.0)
(40 . 0.0)
(41 . 0.0)
(42 . -1.75664)
(210 0.0 0.0 1.0)
)
)
(entmake
'(
(0 . "LWPOLYLINE")
(5 . "61")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "Vorie catégorie-2")
(100 . "AcDbPolyline")
(90 . 6)
(70 . 0)
(43 . 0.0)
(38 . 0.0)
(39 . 0.0)
(10 105439.0 280991.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 105225.0 281082.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.35606)
(10 105069.0 281378.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.181139)
(10 105310.0 281763.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.351478)
(10 105550.0 282740.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 105368.0 283132.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(210 0.0 0.0 1.0)
)
)
(entmake
'(
(0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "Voirie catégorie-3")
(100 . "AcDbPolyline")
(90 . 13)
(70 . 0)
(43 . 0.0)
(38 . 0.0)
(39 . 0.0)
(10 105894.0 281744.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 106305.0 281545.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.420656)
(10 106368.0 281357.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0188284)
(10 106148.0 280886.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.202276)
(10 106148.0 280667.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.981344)
(10 106462.0 280792.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.28701)
(10 106493.0 280949.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0187065)
(10 106713.0 281200.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.00772862)
(10 107058.0 281639.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.101072)
(10 107309.0 281858.0)
(40 . 0.0)
(41 . 0.0)
(42 . -0.836269)
(10 107466.0 281670.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0617888)
(10 107121.0 281137.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.190835)
(10 107058.0 280291.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.218324)
(210 0.0 0.0 1.0)
)
)
(setvar "dimzin" 0)

Ensuite tu vas utiliser ce qui suit, qui est en fait l'outil qui vas associer les données de l'exemple.

(defun make_blk_pr (/)
 (if (not (tblsearch "LAYER" "PR"))
   (entmake '((0 . "LAYER")
       (100 . "AcDbSymbolTableRecord")
       (100 . "AcDbLayerTableRecord")
       (2 . "PR")
       (70 . 0)
       (62 . 4)
       (370 . -3)
       (6 . "Continuous")
      )
   )
 )
 (if (not (tblsearch "STYLE" "PR"))
   (entmake '((0 . "STYLE")
       (5 . "40")
       (100 . "AcDbSymbolTableRecord")
       (100 . "AcDbTextStyleTableRecord")
       (2 . "PR")
       (70 . 0)
       (40 . 150.0)
       (41 . 0.75)
       (50 . 0.0)
       (71 . 0)
       (42 . 150.0)
       (3 . "Romans.shx")
       (4 . "")
      )
   )
 )
 (if (not (tblsearch "BLOCK" "BLOC_PR"))
   (progn
     (entmake
'((0 . "BLOCK")
  (8 . "0")
  (2 . "BLOC_PR")
  (70 . 2)
  (4 . "")
  (62 . 0)
  (6 . "ByBlock")
  (370 . -2)
  (10 0.0 0.0 0.0)
 )
     )
     (entmake '(
	 (0 . "ATTDEF")
	 (100 . "AcDbEntity")
	 (67 . 0)
	 (410 . "Model")
	 (8 . "0")
	 (62 . 0)
	 (6 . "ByBlock")
	 (370 . -2)
	 (100 . "AcDbText")
	 (10 0.0 250.0 0.0)
	 (40 . 150.0)
	 (1 . "D000")
	 (50 . 0.0)
	 (41 . 0.75)
	 (51 . 0.0)
	 (7 . "PR")
	 (71 . 0)
	 (72 . 0)
	 (11 0.0 200.0 0.0)
	 (210 0.0 0.0 1.0)
	 (100 . "AcDbAttributeDefinition")
	 (3 . "Nom du CD")
	 (2 . "NAME_CD")
	 (70 . 0)
	 (73 . 0)
	 (74 . 1)
	)
     )
     (entmake '(
	 (0 . "ATTDEF")
	 (100 . "AcDbEntity")
	 (67 . 0)
	 (410 . "Model")
	 (8 . "0")
	 (62 . 0)
	 (6 . "ByBlock")
	 (370 . -2)
	 (100 . "AcDbText")
	 (10 0.0 50.0 0.0)
	 (40 . 150.0)
	 (1 . "0.000")
	 (50 . 0.0)
	 (41 . 0.75)
	 (51 . 0.0)
	 (7 . "PR")
	 (71 . 0)
	 (72 . 0)
	 (11 0.0 0.0 0.0)
	 (210 0.0 0.0 1.0)
	 (100 . "AcDbAttributeDefinition")
	 (3 . "Entrez un PR")
	 (2 . "DEF_PR")
	 (70 . 0)
	 (73 . 0)
	 (74 . 1)
	)
     )
     (entmake '(
	(0 . "LWPOLYLINE")
	(100 . "AcDbEntity")
	(67 . 0)
	(410 . "Model")
	(8 . "0")
	(100 . "AcDbPolyline")
	(90 . 4)
	(70 . 1)
	(43 . 0.0)
	(38 . 0.0)
	(39 . 0.0)
	(10 0.0 0.0)
	(40 . 0.0)
	(41 . 0.0)
	(42 . 0.0)
	(10 605.0 0.0)
	(40 . 0.0)
	(41 . 0.0)
	(42 . 0.0)
	(10 605.0 430.0)
	(40 . 0.0)
	(41 . 0.0)
	(42 . 0.0)
	(10 0.0 430.0)
	(40 . 0.0)
	(41 . 0.0)
	(42 . 0.0)
	(210 0.0 0.0 1.0)
	)
     )
     (entmake '((0 . "ENDBLK")
	 (8 . "0")
	 (62 . 0)
	 (6 . "ByBlock")
	 (370 . -2)
	)
     )
   )
 )
 (if (not (tblsearch "BLOCK" "BLOC_PR_REPERE"))
   (progn
     (entmake
'((0 . "BLOCK")
  (8 . "0")
  (2 . "BLOC_PR_REPERE")
  (70 . 0)
  (4 . "")
  (62 . 0)
  (6 . "ByBlock")
  (370 . -2)
  (10 0.0 0.0 0.0)
 )
     )
     (entmake '(
	(0 . "LINE")
	(100 . "AcDbEntity")
	(67 . 0)
	(410 . "Model")
	(8 . "0")
	(100 . "AcDbLine")
	(10 0.0 -50.0 0.0)
	(11 0.0 50.0 0.0)
	(210 0.0 0.0 1.0)
	)
     )
     (entmake '((0 . "ENDBLK")
	 (8 . "0")
	 (62 . 0)
	 (6 . "ByBlock")
	 (370 . -2)
	)
     )
   )
 )
)
(defun reverse_pline (e_lst / v_lst p_lst l_vtx)
 (setq
   p_lst (vl-remove-if-not
    '(lambda (x) (member (car x) '(10 40 41 42)))
    e_lst
  )
   e_lst (vl-remove-if '(lambda (x) (member x p_lst)) e_lst)
 )
 (while p_lst
   (setq
     v_lst (cons (list	(car p_lst)
		(cadr p_lst)
		(caddr p_lst)
		(cadddr p_lst)
	  )
	  v_lst
    )
     p_lst (member (assoc 10 (cdr p_lst)) (cdr p_lst))
   )
 )
 (setq
   l_vtx (last v_lst)
   l_vtx (subst (cons 40 (cdr (assoc 41 (car v_lst))))
	 (assoc 40 l_vtx)
	 l_vtx
  )
   l_vtx (subst (cons 41 (cdr (assoc 40 (car v_lst))))
	 (assoc 41 l_vtx)
	 l_vtx
  )
   l_vtx (subst (cons 42 (- (cdr (assoc 42 (car v_lst)))))
	 (assoc 42 l_vtx)
	 l_vtx
  )
 )
 (setq
   v_lst
    (mapcar
      '(lambda	(x y)
  (setq
    x (subst (cons 40 (cdr (assoc 41 y))) (assoc 40 x) x)
    x (subst (cons 41 (cdr (assoc 40 y))) (assoc 41 x) x)
    x (subst (cons 42 (- (cdr (assoc 42 y)))) (assoc 42 x) x)
  )
)
      v_lst
      (cdr v_lst)
    )
 )
 (if (= (logand 1 (cdr (assoc 70 e_lst))) 1)
   (setq v_lst (append (list l_vtx) v_lst))
   (setq v_lst (append v_lst (list l_vtx)))
 )
 (setq e_lst (append e_lst (apply 'append v_lst)))
 (entmod e_lst)
)
(defun draw_pt (pt / rap)
 (setq rap (/ (getvar "viewsize") 50))
 (foreach n
     (mapcar '(lambda (x)
		(list ((eval (car x)) (car pt) rap)
		      ((eval (cadr x)) (cadr pt) rap)
		)
	      )
	     '((+ +) (+ -) (- +) (- -))
     )
   (grdraw pt n 2)
 )
)
(defun Entsel_Getstring	(msg / ent key kstr)
 (setq	kstr nil
ent  ""
 )
 (princ (strcat msg " / Entrez un texte: "))
 (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32))))
      (/= (car key) 3)
 )
   (if	(eq (car key) 2)
     (if (eq (cadr key) 8)
(progn
  (princ (chr 8))
  (princ (chr 32))
  (princ (chr 8))
  (setq kstr (cdr kstr))
)
(progn
  (setq kstr (cons (cadr key) kstr))
  (princ (chr (cadr key)))
)
     )
   )
 )
 (if (eq (car key) 3)
   (if	(setq ent (nentselp (cadr key)))
     (progn
(setq ent (entget (car ent)))
(if (member (cdr (assoc 0 ent)) '("TEXT" "MTEXT" "ATTRIB"))
  (setq ent (strcase (cdr (assoc 1 ent))))
  (progn (princ "\nObjet n'est pas un Texte!")
	 (entsel_getstring msg)
  )
)
     )
     (progn (princ "\nSélection vide!")
     (setq ent nil)
     (entsel_getstring msg)
     )
   )
   (progn
     (foreach n kstr (setq ent (strcat (chr n) ent)))
     (if (eq ent "")
(progn (princ "\nEntrée invalide!") (entsel_getstring msg))
(strcase ent)
     )
   )
 )
)
(defun Entsel_Getreal (msg / ent key n nbr)
 (setq nbr "")
 (princ (strcat msg " / Entrez une valeur numérique [b]<[/b]0.0>: ")
 )
 (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32))))
      (/= (car key) 25)
      (/= (car key) 3)
 )
   (cond
     ((eq (car key) 2)
      (if (member (cadr key) '(8 46 48 49 50 51 52 53 54 55 56 57))
 (if (eq (cadr key) 8)
   (progn
     (princ (chr 8))
     (princ (chr 32))
     (princ (chr 8))
     (setq nbr (substr nbr 1 (1- (strlen nbr))))
   )
   (progn
     (setq n (chr (cadr key)))
     (princ n)
     (setq nbr (strcat nbr n))
   )
 )
      )
     )
   )
 )
 (if (eq (car key) 3)
   (if	(setq ent (nentselp (cadr key)))
     (progn
(setq ent (entget (car ent)))
(if (member (cdr (assoc 0 ent)) '("TEXT" "MTEXT" "ATTRIB"))
  (progn
    (setq ent (read (cdr (assoc 1 ent))))
    (if	(or (eq (type ent) 'INT) (eq (type ent) 'REAL))
      ent
      (progn (princ "\nLe texte n'est pas valide!")
	     (entsel_getreal msg)
      )
    )
  )
  (progn (princ "\nObjet n'est pas un Texte!")
	 (entsel_getreal msg)
  )
)
     )
     (progn (princ "\nSélection vide!")
     (setq ent nil)
     (entsel_getreal msg)
     )
   )
   (atof nbr)
 )
)
(defun c:attach_pr ( / ent dxf_ent lay_name typ_cd obj_vlax e_length pt_start pt_end ent_txt mnpt mxpt minpt maxpt pt_tmp
		 nam_cd pr_start pr_end length_real pt_w pt1 pt2 pt_x k pr_next dist_next p_f p_n)
 (while
   (null
     (setq
ent (entsel "\nChoisir le CD pour attacher les infos de PR: ")
     )
   )
 )
 (cond
   ((eq (cdr (assoc 0 (setq dxf_ent (entget (car ent)))))
 "LWPOLYLINE"
    )
    (setq lay_name (cdr (assoc 8 dxf_ent)))
    (cond
      ((eq lay_name "Reseau National") (setq typ_cd "RN"))
      ((eq lay_name "Reseau Ossature") (setq typ_cd "RO"))
      ((eq lay_name "Reseau d_Interet Economique et Touristique")
(setq typ_cd "RIET")
      )
      ((eq lay_name "Reseau d_Interet Local") (setq typ_cd "RIL"))
      (T (setq typ_cd "Inconnu"))
    )
    (vl-load-com)
    (setq obj_vlax (vlax-ename->vla-object (car ent)))
    (setq
      e_length	(vlax-curve-getDistAtParam
	  obj_vlax
	  (vlax-curve-getEndParam obj_vlax)
	)
      pt_start	(vlax-curve-getStartPoint obj_vlax)
      pt_end	(vlax-curve-getEndPoint obj_vlax)
      ent_txt	nil
    )
    (vla-GetBoundingBox obj_vlax 'mnpt 'mxpt)
    (setq
      minpt (trans (safearray-value mnpt) 0 1)
      maxpt (trans (safearray-value mxpt) 0 1)
    )
    (command "_.zoom" "_window" "_none" minpt "_none" maxpt "_.zoom"
      "0.75x")
    (redraw (car ent) 3)
    (draw_pt pt_start)
    (initget "Oui Non _Yes No")
    (if
      (eq (getkword
     "\nInverser le départ de la polyligne [Oui/Non]? [b]<[/b]Non>: "
   )
   "Yes"
      )
(setq dxf_ent (reverse_pline dxf_ent) pt_tmp pt_end pt_end pt_start pt_start pt_tmp)
    )
    (setq nam_cd
    (Entsel_Getstring
      "\nChoisir le Texte/Texte Multiligne/Attribut définissant la nomination du CD"
    )
    )
    (setq pr_start
    (*
      1000
      (Entsel_Getreal
	"\nChoisir le Texte/Texte Multiligne/Attribut définissant le PR de début"
      )
    )
    )
    (setq pr_end
    (*
      1000
      (Entsel_Getreal
	"\nChoisir le Texte/Texte Multiligne/Attribut définissant le PR de fin"
      )
    )
    )
    (setq length_real (- pr_end pr_start))
    (if (null (tblsearch "appid" "ID_RESEAU_CD-BONUSCAD$2002"))
      (regapp "ID_RESEAU_CD-BONUSCAD$2002")
    )
    (alert
      (strcat
 "Information attaché à la polyligne mesurant : "
 (rtos e_length 2 0) "m"
 "\n"
 "\nRoute "
 nam_cd
 "\nAttaché au "
 lay_name
 "\nLongueur du tronçon = "
 (rtos (/ length_real 1000.0) 2 3)
 " km"
 "\nDébutant  au PR "
 (rtos (/ pr_start 1000.0) 2 3)
 "\nFinissant au PR "
 (rtos (/ pr_end 1000.0) 2 3)
      )
    )
    (redraw (car ent) 4)
    (entmod
      (append
 dxf_ent
 (list
   (list -3
	 (list
	   "ID_RESEAU_CD-BONUSCAD$2002"
	   (cons 1000 typ_cd)
	   (cons 1002 "{")
	   (cons 1000 nam_cd)
	   (cons 1040 e_length)
	   (cons 1040 length_real)
	   (cons 1040 pr_start)
	   (cons 1040 pr_end)
	   (cons 1002 "}")
	 )
   )
 )
      )
    )
    (if (eq (getvar "attmode") 2)
      (setvar "attmode" 1)
    )
    (if (not (tblsearch "BLOCK" "BLOCK_PR"))
      (make_blk_pr)
    )
    (foreach n	(list (list pt_start pr_start nam_cd) (list pt_end pr_end nam_cd))
(setq pt1 (car n) pt2 (car n))
(while (equal pt2 pt1)
	(setq pt2
		((lambda ( / key pt p1 p2 p3 p4 alpha)
			(princ "\nPosition de l'annotation du PR: ")
			(while (and (setq key (grread T 4 0)) (/= (car key) 3))
				(cond
					((eq (car key) 5)
						(redraw)
						(setq pt (cadr key))
						(setq alpha (angle pt1 pt))
						(cond 
							((and (>= alpha 0.0) (< alpha (/ pi 2)))
								(setq
									p1 pt
									p2 (list (+ (car pt) 605) (cadr pt))
									p3 (list (+ (car pt) 605) (+ (cadr pt) 430))
									p4 (list (car pt) (+ (cadr pt) 430))
									pt_w p1
								)
							)
							((and (>= alpha (/ pi 2)) (< alpha pi))
								(setq
									p1 pt
									p2 (list (car pt) (+ (cadr pt) 430))
									p3 (list (- (car pt) 605) (+ (cadr pt) 430))
									p4 (list (- (car pt) 605) (cadr pt))
									pt_w p4
								)
							)
							((and (>= alpha pi) (< alpha (/ (* 3 pi) 2)))
								(setq
									p1 pt
									p2 (list (- (car pt) 605) (cadr pt))
									p3 (list (- (car pt) 605) (- (cadr pt) 430))
									p4 (list (car pt) (- (cadr pt) 430))
									pt_w p3
								)
							)
							(T
								(setq
									p1 pt
									p2 (list (car pt) (- (cadr pt) 430))
									p3 (list (+ (car pt) 605) (- (cadr pt) 430))
									p4 (list (+ (car pt) 605) (cadr pt))
									pt_w p2
								)
							)
						)
						(grdraw pt1 p1 1)
						(grdraw p1 p2 7)
						(grdraw p2 p3 7)
						(grdraw p3 p4 7)
						(grdraw p4 p1 7)
					)
				)
			)
			(redraw)
			(cadr key)
		))
	)
	(if (equal pt2 pt1)
		(princ "\nLa position est confondue avec l'extrèmité du CD!")
	)
)
(setq pt_x (polar pt1 (angle pt1 pt2) 75.0))
(entmake
	(list
		(cons 0 "LWPOLYLINE")
		(cons 100 "AcDbEntity")
		(assoc 67 dxf_ent)
		(assoc 410 dxf_ent)
		(cons 8 "PR")
		(cons 100 "AcDbPolyline")
		(cons 90 3)
		(cons 70 0)
		(cons 38 (caddr pt1))
		(cons 10 (list (car pt1) (cadr pt1)))
		(cons 40 0.0)
		(cons 41 25.0)
		(cons 42 0.0)
		(cons 10 (list (car pt_x) (cadr pt_x)))
		(cons 40 0.0)
		(cons 41 0.0)
		(cons 42 0.0)
		(cons 10 (list (car pt2) (cadr pt2)))
		(cons 40 0.0)
		(cons 41 0.0)
		(cons 42 0.0)
		(cons 210 '(0.0 0.0 1.0))
	)
)
(entmake
(append
'(
(0 . "INSERT")
(100 . "AcDbEntity")
(8 . "PR")
(100 . "AcDbBlockReference")
)
(list
(assoc 67 dxf_ent)
(assoc 410 dxf_ent)
)
'(
(66 . 1)
(2 . "BLOC_PR")
)
(list (cons 10 pt_w))
'(
(41 . 1.0)
(42 . 1.0)
(43 . 1.0)
(50 . 0.0)
(70 . 0)
(71 . 0)
(44 . 0.0)
(45 . 0.0)
(210 0.0 0.0 1.0)
)
)
)
(entmake
(append
'(
(0 . "ATTRIB")
(100 . "AcDbEntity")
)
(list (assoc 67 dxf_ent))
(list (assoc 410 dxf_ent))
'(
(8 . "0")
(62 . 0)
(6 . "ByBlock")
(370 . -2)
(100 . "AcDbText")
)
(list (cons 10 (list (car pt_w) (+ 50 (cadr pt_w)) 0.0)))
'((40 . 150.0))
(list (cons 1 (rtos (/ (cadr n) 1000.0) 2 3)))
'(
(50 . 0.0)
(41 . 0.75)
(51 . 0.0)
(7 . "PR")
(71 . 0)
(72 . 0)
)
(list (cons 11 pt_w))
'(
(210 0.0 0.0 1.0)
(100 . "AcDbAttribute")
(2 . "DEF_PR")
(70 . 0)
(73 . 0)
(74 . 1)
)
)
)
(entmake
(append
'(
(0 . "ATTRIB")
(100 . "AcDbEntity")
)
(list (assoc 67 dxf_ent))
(list (assoc 410 dxf_ent))
'(
(8 . "PR")
(62 . 0)
(6 . "ByBlock")
(370 . -2)
(100 . "AcDbText")
)
(list (cons 10 (list (car pt_w) (+ 250 (cadr pt_w)) 0.0)))
'((40 . 150.0))
(list (cons 1 (caddr n)))
'(
(50 . 0.0)
(41 . 0.75)
(51 . 0.0)
(7 . "PR")
(71 . 0)
(72 . 0)
)
(list (cons 11 (list (car pt_w) (+ 200 (cadr pt_w)) 0.0)))
'(
(210 0.0 0.0 1.0)
(100 . "AcDbAttribute")
(2 . "NAME_CD")
(70 . 0)
(73 . 0)
(74 . 1)
)
(list (assoc 67 dxf_ent))
(list (assoc 410 dxf_ent))
)
)
      (entmake (append '((0 . "SEQEND") (100 . "AcDbEntity") (8 . "PR"))
   (list (assoc 67 dxf_ent))
   (list (assoc 410 dxf_ent))
))
    )
(setq k (/ e_length length_real))
(setq pr_next (* 1000 (fix (1+ (/ pr_start 1000)))))
(setq dist_next (* k (- pr_next pr_start)))
(if (vlax-curve-getPointAtDist obj_vlax dist_next)
	(setq
		p_f (fix (vlax-curve-getParamAtPoint obj_vlax (vlax-curve-getPointAtDist obj_vlax dist_next)))
		p_n (1+ p_f)
		p_f (vlax-curve-getPointAtParam obj_vlax p_f)
		p_n (vlax-curve-getPointAtParam obj_vlax p_n)
	)
)
(while (< dist_next e_length)
	(entmake
 		(append
   			'(
				(0 . "INSERT")
				(100 . "AcDbEntity")
				(67 . 0)
				(410 . "Model")
				(8 . "PR")
				(100 . "AcDbBlockReference")
				(2 . "BLOC_PR_REPERE")
				(41 . 1.0)
				(42 . 1.0)
				(43 . 1.0)
				(70 . 0)
				(71 . 0)
				(44 . 0.0)
				(45 . 0.0)
				(210 0.0 0.0 1.0)
			)
			(list
				(cons 10 (vlax-curve-getPointAtDist obj_vlax dist_next))
				(cons 50 (angle p_f p_n))
			)
		)
	)
	(setq dist_next (+ (* k 1000) dist_next))
	(if (< dist_next e_length)
	(setq
		p_f (fix (vlax-curve-getParamAtPoint obj_vlax (vlax-curve-getPointAtDist obj_vlax dist_next)))
		p_n (1+ p_f)
		p_f (vlax-curve-getPointAtParam obj_vlax p_f)
		p_n (vlax-curve-getPointAtParam obj_vlax p_n)
	)
	)
)
   )
   (T (princ "\nN'est pas une polyligne optimisée!"))
 )
 (prin1)
)

Lance la routine.

Choisis la polyligne la plus longue (qui fait la diagonale)

répond "Non" à l'inversion, nomme la "RN7", PR de début "10.250" , fin "19.375"

et place librement les étiquettes.

Tu continus avec la polyligne coté bas-droit

répond "Oui" "CD375" "15.500" "19.200"

polyligne coté haut-gauche.

"Non" "CD375" (ou tu peux cliquez dans l'étiquette précedente, idem pour le pr qui suit ) "19.200" "21.935"

et la dernière coté haut-droit (avec des lacets)

"Non" "CD22" "0.000" (valeur par défaut) "4.850"

Maintenant voici la routine qui serait l'équivalent d'un liste d'objet

(defun c:id_cd ( / esel ename elist xd_list obj_vlax e_length e_data id_res)
(while
	(not (setq esel (entsel "\nChoisir la Route Départementale à identifier: ")))
)
(setq ename (car esel))
(sssetfirst nil (ssadd ename))
(setq elist (entget ename (list "ID_RESEAU_CD-BONUSCAD$2002")))
(cond
	((setq xd_list (assoc -3 elist))
		(vl-load-com)
		(setq obj_vlax (vlax-ename->vla-object ename))
		(setq e_length (vlax-curve-getDistAtParam obj_vlax (vlax-curve-getEndParam obj_vlax)))
		(setq xd_list (cdr xd_list))
		(setq e_data (mapcar 'cdr (cdr (car xd_list))))
		(cond
			((eq (car e_data) "RN") (setq id_res "Réseau National"))
			((eq (car e_data) "RO") (setq id_res "Réseau Ossature"))
			((eq (car e_data) "RIET") (setq id_res "Réseau d'Intérêt Economique et Touristique (R.I.E.T.)"))
			((eq (car e_data) "RIL") (setq id_res "Réseau d'Intérêt Local (R.I.L.)"))
			((eq (car e_data) "Inconnu") (setq id_res "Réseau non référencé"))
		)
		(alert
			(strcat
				"Information attaché à la polyligne mesurant : " (rtos e_length 2 0) "m"
				"\n"
				"\nRoute " (caddr e_data)
				"\nAttaché au " id_res
				"\nLongueur du tronçon = " (rtos (/ (cadddr (cdr e_data)) 1000.0) 2 3) " km"
				"\nDébutant  au PR " (rtos (/ (cadddr (cddr e_data)) 1000.0) 2 3)
				"\nFinissant au PR " (rtos (/ (cadddr (cdddr e_data)) 1000.0) 2 3)
			)
		)
	)
	(T (alert "\nAucune donnée n'est associée à cette sélection!"))
)
(sssetfirst nil nil)
(prin1)
)

Puis une dernière pour se placer à un endroit précis sur ton réseau. (utile pour se situer)

(defun draw_pt (pt / rap)
(setq rap (/ (getvar "viewsize") 50))
(foreach n
        (mapcar '(lambda (x)
              (list ((eval (car x)) (car pt) rap)
                   ((eval (cadr x)) (cadr pt) rap)
              )
              )
             '((+ +) (+ -) (- +) (- -))
        )
  (grdraw pt n 2)
)
)
(defun c:[b]ou_PR[/b] ( / max_cd num_CD q_PR js n tlen_real tlen_pr lst_CD ent xdlist obj_vlax e_length e_data len_pr PR_start PR_end mnpt mxpt minpt maxpt k dist_pr id_pr)
;     (setq max_cd 906)
;     (initget 7)
;     (while (> (setq num_CD (getint (strcat "\nEntrez le numéro de la route à trouver [b]<[/b]max " (itoa max_cd) ">: "))) max_cd) (initget 7))
;     (setq num_cd (strcat "D" (itoa num_cd)))
    (setq num_cd (strcase (getstring "\nEntrez l'ID de la route à trouver: ")))
    (initget 4)
    (setq q_PR (getreal "\nEntrez le PR recherché [b]<[/b]0.0>: "))
    (if (not q_PR) (setq q_PR 0.0))
    (setq js
         (ssget "_X"
              (list
                   (cons 0 "LWPOLYLINE")
                   (list -3
                        (list
                             "ID_RESEAU_CD-BONUSCAD$2002"
                             (cons 1002 "{")
                             (cons 1000 num_CD)
                             (cons 1002 "}")
                        )
                   )
              )
         )
    )
    (cond
         (js
              (vl-load-com)
              (setq n -1 tlen_real 0.0 tlen_pr 0.0 lst_CD '(("RN" . 0.0) ("RO" . 0.0) ("RIET" . 0.0) ("RIL" . 0.0) ("Inconnu" . 0.0)))
              (repeat (sslength js)
                   (setq ent (entget (ssname js (setq n (1+ n))) (list "ID_RESEAU_CD-BONUSCAD$2002")))
                   (setq xd_list (cdr (assoc -3 ent)))
                   (setq obj_vlax (vlax-ename->vla-object (cdar ent)))
                   (setq e_length (vlax-curve-getDistAtParam obj_vlax (vlax-curve-getEndParam obj_vlax)))
                   (setq tlen_real (+ tlen_real e_length))
                   (setq e_data (mapcar 'cdr (cdr (car xd_list))))
                   (setq len_pr (/ (cadddr (cdr e_data)) 1000.0))
                   (setq tlen_pr (+ tlen_pr len_pr))
                   (setq PR_start (/ (cadddr (cddr e_data)) 1000.0))
                   (setq PR_end (/ (cadddr (cdddr e_data)) 1000.0))
                   (setq lst_CD
                        (subst
                             (cons (car e_data) (+ len_pr (cdr (assoc (car e_data) lst_CD))))
                             (assoc (car e_data) lst_CD)
                             lst_CD
                        )
                   )
                   (if (and (>= q_pr PR_start) ([b]<[/b]= q_pr PR_end))
                        (progn
                             (vla-GetBoundingBox obj_vlax 'mnpt 'mxpt)
                             (setq
                                  minpt (trans (safearray-value mnpt) 0 1)
                                  maxpt (trans (safearray-value mxpt) 0 1)
                             )
                             (setvar "cmdecho" 0)
                             (command "_.zoom" "_window" "_none" minpt "_none" maxpt "_.zoom" "0.75x")
                             (setvar "cmdecho" 1)
                             (setq k (/ (/ e_length 1000.0) len_pr))
                             (setq dist_pr (* k (- q_pr PR_start) 1000.0))
                             (setq id_pr (vlax-curve-getPointAtDist obj_vlax dist_pr))
                             (if id_pr
                                  (draw_pt id_pr)
                             )
                        )
                       
                   )
              )
              (if (null id_pr)
                   (alert (strcat "Le PR " (rtos q_pr 2 3) " n'appartient pas au " num_CD))
              )
              (princ
                   (strcat
                        "\nLa Route de dénomination "
                        num_CD
                        "\nd'une longueur réelle de "
                        (rtos (/ tlen_real 1000.0) 2 3)
                        " km"
                        "\nSe décompose en: "
                   )
              )
              (foreach n lst_CD
                   (if (not (zerop (cdr n))) (princ (strcat "\n" (rtos (cdr n) 2 3) " km en réseau " (car n))))
              )
              (princ (strcat "\nPour une longueur totale de " (rtos tlen_pr 2 3) " km."))
         )
         (T
              (alert
                   (strcat
                        "La Route de dénomination "
                        num_CD
                        " n'a pas été trouvé!"
                   )
              )
         )
    )
    (prin1)
)

J'ai utilisé ceci sur un réseau départemental entier.

Bien sur, j'ai à l'aide d'outils supplémentaire (fait à partie de l'optique de la dernière routine)

Par exemple j'ai pu placer sur mon réseau par imporation d'excel, tous les ouvrages référencé (bloc avec attribut importé) par leur appartenance à un réseau et leur PR respectifs.

Mes xdata me servant à appliquer une correction à chaque tronçon.

Ceci à été réalisé en 1/4 heure par l'ordinateur sur l'ensemble du département (soit environ 11 000 ouvrages), à la main j'aurais rendu le tablier...

[Edité le 9/12/2007 par bonuscad]

lili2006 · le 9 décembre 2007

Rererer,

Peux-t'on visualiser les renseignements liés aux entités directement depuis AutoCAD (avec son handle, je suppose,..) ??

Oups ! Il suffit de le reselectionner, tu me l'avais déjà dis pourtant,...

Désolé.

Autre chose, tu avais également raison Bred, rien à voir avec Vista !

Effectivement, j'ai changé de session, me suis remis administrateur, et là, tout fonctionne à merveille !

Bof, parfois, ne pas chercher à comprendre,....

bonuscad, à toit tout seul tu n'as plus besoin de progiciel, ..!!!

Je fais également du projet routier avec mes étudiants mais largement moins poussé que ce que tu fais toi, à priori.

Merci beaucoup pour cet exemple, je le teste de suite et revient.

D'avance merci de ce partage de connaissances.

A'd't'al, alors,...

lili2006 · le 9 décembre 2007

Re,

bonuscad

Tou à bien fonctionné jusqu'aux requêtes de positionnement =>

CU_PR
Commande: CU_PR
Commande inconnue "CU_PR". Appuyez sur F1 pour obtenir de l'aide.
Commande:

Quelques questions :

Je n'ai rien au bout des flêches, est-ce normal ?,

Que représente les traits perpendiculaire à l'axe ? (le passage des ouvrages d'art ?),

En tous cas, la maitrise des xdatas semblent un atout intéressant si l'on a qu'un AutoCAd de base pour ce genre de travaux.

Chapeau bas pour ce travail et merci de l'avoir partagé ici à titre d'exemple,..

Au plaisir.

bonuscad · le 9 décembre 2007

CU_PR

Rhaaar, j'avais pas vu qu'un smiley s'était glissé c'est C:OU_PR

Je n'ai rien au bout des flêches, est-ce normal ?,

Normalement une étiquette bloc avec attributs, réalisé sous 2002.

Ce ne serait pas un problème d'unité INSUNITS sous version ultérieure....

Je pense que le bloc doit y être, mais tout petit, ou bout de ce rappel perpendiculaire

à toit tout seul tu n'as plus besoin de progiciel, ..!!!

Comme tu le disais si bien ailleurs, je veux être fainéant, mais efficace... ;)

[Edité le 9/12/2007 par bonuscad]

lili2006 · le 9 décembre 2007

Re,

bonuscad, en effet, cela marche mieux avec "OU_PR",

Même en zoooooomant, pas de blocs insérés (ou visible !). Par contre, dans les blocs internes, on le retrouve bien avec ses deux attributs, donc, c'est ok !

Merci encore à tous.

Bonne soirée.

Bred · le 9 décembre 2007

bonuscad... une fois de plus...

OUF ! :o Quel boulot !

Superbe !

Bred · le 9 décembre 2007

Re,

Alors, voilà un prog plus "complet" :

- J'ai modifiés le nom des outils :

Enregistrer Xdata dans objet : L-Xdata

Enregistrer Xdata dans .csv : XdataXL

Mise à jou Xdata par rapport à un .csv : XLXdata

- Afin de rentrer les informations voulus, j'ai détachés la partis renseignement et adapté toutes les autres routines pour que ça fonctionne avec (normalement...)

Tu rajoutes/enlève/modifie ce que tu veux dans la liste (en gras)

Attention : de cette liste dépends le bon fonctionnement de la mise à jour par rapport au .csv ! Donc ne pas la modifier entre une "extraction de Xdata" et une "Mise à jour de Xdata"...

- j'ai rajouter un outils (RXO) qui sort juste les x-data contenus dans l'objet selectionné.

- La création et la liaison à faire avec le .csv se fait maintenant à la demande.

;;; Renseignements (à modifier) pour enregistrement Xdata
(defun Renseignements-XDATA (Q / I LST-F LSTR R)  
 [b]; liste à modifers pour reneignements :
 (setq lstR '("Nom" "Adresse" "Localisation" "taille" "Poids"))[/b]

 (if Q
   (progn
     (setq i -1)
     (repeat (length lstR)
(setq R (getstring T (strcat "\n " (nth (setq i (1+ i)) lstR) " :"))
      lst-F (append lst-F (list (strcase (nth i lstR)) R)))
)
     lst-F
     )
   lstR
   )
)


;;; Requètes
(defun c:R-Xdata (/ I L LST LST-B N S S-T VLA-OB XDATA XTYPE)  
 (princ "\n Recherches des Renseignements :")
 (setq lst (Renseignements-XDATA "Q"))
 (setq s (ssget "_X" (list (list -3 (list (car lst)))))
s-t (ssadd))

 (repeat (setq i (sslength s))
   (setq vla-ob (vlax-ename->vla-object (ssname s (setq i (1- i)))))
   (vla-getxdata vla-ob "" 'xType 'xData)
   (if (and xType xData)
(progn
  (setq l (mapcar 'vlax-variant-value (vlax-safearray->list xData)))
  (repeat (setq n (length (setq lst-B (Renseignements-XDATA nil))))
    (if (equal (strcase (cadr (member (strcase (nth (setq n (1- n)) lst-B)) lst)))
	       (strcase (cadr (member (strcase (nth n lst-B)) l))))
      (ssadd (handent (cadr l)) s-t))
      )
    )
  )
     )
 (if (zerop (getvar "cmdactive"))(sssetfirst nil s-t))
 (if (> (sslength s-t) 1)
   (princ (strcat "\n "(rtos (sslength s-t)) " objets sélectionnés."))
   (princ (strcat "\n "(rtos (sslength s-t)) " objet sélectionné."))
   )
 (princ)
)

;;; Retourne Xdata dans Objet.
(defun c:RXO ()
 (setq ent (car (entsel "\n Choisir l'objet contenant les renseignements :")))
 (if ent
   (if (not (Test-Xdata ent))
     (alert "\n Pas de Xdata dans cette entité.")))
 (princ)
)

;;; Test Existance Xdata
(defun Test-Xdata (ent)  
 (if ent
   (progn
     (setq vla-ob (vlax-ename->vla-object ent))
     (vla-getxdata vla-ob "" 'xType 'xData)
     (if (and xType xData)
(progn
  (setq l (mapcar 'vlax-variant-value (vlax-safearray->list xData))
	i -1
	txtt "")
  (repeat (/ (length l) 2)
    (setq txtt (strcat txtt "\n" (nth (setq i (1+ i)) l) ": " (nth (setq i (1+ i)) l))))
  (alert (strcat "Xdata Existants : " txtt))
  t
) 
)  )  )
)  

;;; Programme Demandant/Donnant la liste Xdata dans entité.
(defun c:L-Xdata (/ ENT I LST-D VLA-OB)
 (setq ent (car (entsel "\n Choisir l'objet dans lequel enregistrer les renseignements :")))
 (if ent
   (progn
     (setq vla-ob (vlax-ename->vla-object ent))
     (vla-getxdata vla-ob "" 'xType 'xData)
     (if (not (Test-Xdata ent))
(progn
  (setq lst-D (Renseignements-XDATA "Q")
	i -1)
  (Set-xData ent (list "ENTITE" (vla-get-handle vla-ob)))
  (repeat (/ (length lst-D) 2)
    (Set-xData ent (list (nth (setq i (1+ i)) lst-D) (nth (setq i (1+ i)) lst-D)))
    )  ) ) ) )
 (princ)
)

;;; Enregistres Xdata des entités selectionnés dans fichier .csv
(defun c:XdataXL (/ E F I L SEL XDATA XTYPE)
 (setq sel (ssget)
f (getfiled "Nom Fichier à enregistrer :" "" "csv" 1)  
f (open f "w"))
 (repeat (setq i (sslength sel))
   (setq e (vlax-ename->vla-object (ssname sel (setq i (1- i)))))
   (vla-getxdata e "" 'xType 'xData)
   (if (and xType xData)
     (progn
(setq l (mapcar 'vlax-variant-value (vlax-safearray->list xData))
      x -1)	
(repeat (/ (length l) 2)
  (princ (nth (setq x (+ x 2)) l) f)
  (princ ";" f)
  )
)
     )
   (princ "\n" f)
   )
 (close f)
)

;;; Récupères les données d'un .csv pour les mettre en Xdata.
(defun c:XLXdata (/ ADRESSE ENT F H L LOCALISATION NOM)
 (setq f (getfiled "Choisir Fichier :" "" "csv" 4)
f (open f "r")
l "l"
R (Renseignements-XDATA nil))
 (while l
   (setq l (read-line f))
   (if l
     (progn
(if (vl-string-search "\"" l)
  (setq l (substr l (+ 2 (vl-string-search "\"" l)) (strlen l)))
  )
(setq h (substr l 1 (vl-string-search ";" l))
      ent (handent h))
(if ent
  (if (entget ent)
    (progn
      (Set-xData ent (list "ENTITE" h))
      
      (setq i -1)	      
      (repeat (length R)
	(setq l (substr l (+ 2 (vl-string-search ";" l)) (strlen l))
	      D (substr l 1 (vl-string-search ";" l)))
	(if (vl-string-search "\"" D)
	  (setq D (substr l 1 (vl-string-search "\"" D))))
	(Set-xData ent (list (strcase (nth (setq i (1+ i)) R)) D))
	)
      (princ (strcat "\n Entité " h " Mis à Jour."))
      )
    (alert (strcat "Entité " h " Supprimé !"))
    )
  (alert (strcat "Entité " h " Non trouvé !"))
  )
)
     )
   )
(close f)
(princ)
)

;;; Routine Enregistrement Xdata dans entité : (Set-xData '("Nom" "Toto"))
(defun Set-xData (ent lst / VLA-OB XDATA XTYPE)
 (if (equal (type ent) 'ENAME)(setq ent (vlax-ename->vla-object ent)))
 (setq xData (vlax-make-safearray vlax-vbVariant (cons 0 1))
xType (vlax-make-safearray vlax-vbInteger (cons 0 1)))
 (vlax-safearray-fill xData lst)
 (vlax-safearray-fill xType '(1001 1000))
 (vla-setxdata ent xType xData)
)

[Edité le 22/12/2007 par Bred]

Connexion

xdata

Messages recommandés

lili2006

Meilleurs contributeurs dans ce sujet

Jours populaires

Meilleurs contributeurs dans ce sujet

Jours populaires

speedy

lili2006

Bred

lili2006

Bred

lili2006

Bred

lili2006

Bred

lili2006

Bred

lili2006

lili2006

Bred

Bred

lili2006

lili2006

bonuscad

lili2006

lili2006

bonuscad

lili2006

Bred

Bred

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante