Reconstruction de points topo.

[Bred]

Bonjour,

afin de réponde à ce message, j'ai réalisé une routine permettant de reconstruire des points topo explosés.

Il faut pour cela au minimum un text de point topo explosé acompagné de son nodal explosé (afin de calculer la différence de coordonnées entre le text et le nod).

Le traitement se fera sur tous les text qui seront dans le même calque.

Pour finir, les points reconstruit seront placé sur le niveau de Z correspondant.

 

Attention : ce prog part du principe que tous les points topo ont été fait avec le même bloc, donc le point d'insertion aura toujour la même position par rapport au text.

 

- Cette routine utilise des routines récupérés sur CadXP - Les auteurs se reconnaitront et je les en remercies)

 

Nota : je vais me faire tirer les oreilles : j'ai mélangé de l'entmake avec du vl .... mais je n'ai pas trouvé la manière de créér un atribut en vl ... :(

 

merci de vos remarques !!!

 

Edit : Modification suivant tous les conseils de (gile) afin de nettoyer le code et réalisation de l'attribut en vl.

 

;;; Transforme pt+txt en point topo + modifie tous les txt en idem dans le plan.;;
;;; + met les points sur le Z correspondant					 ;
(defun c:ass-pt-topo (/ ACDOC BLC-I COORD-BL COORD-NOD COORD-NOD/TXT COORD-PT
	      COORD-PT/TXT COORD-TXT H-TXT LAY-NOD LAY-TXT LST-BLC LST-PT
	      N NOD NOMBLC PT-NOD ROT-TXT SEL SEL-T SPACE TXT VAL VAL-TXT
	      VLA-NOD VLA-TXT X)
 (vl-load-com)
 (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc))
sel (ssadd)
lst-pt nil)

 (initget 1)
 (setq NomBlc (getstring T "\nNom du Bloc Topo à créer: "))
 
 (while (not (and
      (setq nod (car (entsel "\n Choix du point :")))
      (equal (cdr (assoc 0 (entget nod))) "POINT"))))
 (ssadd nod sel)

 (while (not (and
      (setq txt (car (entsel "\n Choix du Texte :")))
      (equal (cdr (assoc 0 (entget txt))) "TEXT"))))   

 ; Récup valeurs
 (setq vla-nod (vlax-ename->vla-object nod)
lay-nod (vla-get-layer vla-nod)
vla-txt (vlax-ename->vla-object txt)
lay-txt (vla-get-layer vla-txt)
h-txt (vla-get-Height vla-txt)
val-txt (vla-get-TextString vla-txt)
coord-nod (vlax-get vla-nod 'Coordinates)
coord-txt (vlax-get vla-txt 'InsertionPoint)
coord-pt/txt (mapcar '- coord-nod coord-txt)
coord-nod/txt (mapcar '+ coord-txt coord-pt/txt))

 ; création attribut
 (vla-addAttribute Space h-txt acAttributeModePreset "Niveau" (vlax-3d-point (trans coord-txt 1 0)) "Niveau" val-txt)
 (chang_Calque (entlast) lay-txt)
 (ssadd (entlast) sel)  
 ; création Bloc
 (Creatbloc NomBlc coord-nod sel)
 (vla-delete vla-txt)  

 ; Récupère tous text idem dans dessin
 (setq sel-T (ssget "_X" (list (cons 0 "TEXT")(cons 8 lay-txt)))
pt-nod (ssget "_X" (list (cons 0 "POINT")(cons 8 lay-nod))))
 
 (repeat (setq x (sslength sel-T))
   (setq txt (vlax-ename->vla-object (ssname sel-T (setq x (1- x))))
  val-txt (vla-get-TextString txt)
  h-txt (vla-get-Height txt)
  rot-txt (vla-get-Rotation txt)
  coord-txt (vlax-safearray->list
	      (vlax-variant-value
		(vla-get-InsertionPoint txt)))
  coord-pt (mapcar '+ coord-txt coord-pt/txt)
  blc-i (vla-insertblock Space (vlax-3d-point (trans coord-pt 1 0)) NomBlc 1 1 1 0))
   
   (vla-rotate blc-i (vlax-3d-point (trans coord-txt 1 0)) rot-txt)
   (vla-put-TextString (car (vlax-invoke blc-i 'GetAttributes))  val-txt)
   
   (vla-delete txt)    
   
   (princ (strcat "\n Reste " (rtos x) " Blocs à créér."))
   )
 
 (if pt-nod
   (progn
     (repeat (setq n (sslength pt-nod))
(setq lst-pt (append (list (vlax-ename->vla-object (ssname pt-nod (setq n (1- n))))) lst-pt)))
   (foreach n lst-pt (vla-delete n))
     )
   )

  ; Elève sur les Z 
 (setq sel (ssget "_X" (list (cons 2 NomBlc))))
 (repeat (setq n (sslength sel))
(setq lst-blc (append (list (vlax-ename->vla-object (ssname sel (setq n (1- n))))) lst-blc)))

 (foreach n  lst-blc (setq val (atof (vla-get-TextString (car (vlax-invoke n 'GetAttributes))))
   coord-Bl (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint n))))
   (vla-put-InsertionPoint n (vlax-3d-point (list (car coord-Bl)(cadr coord-Bl) val)))
   )  
 (princ)
)

;;;	Création de Bloc Topo 						;
(defun Creatbloc (Nom-B p ss / BLK LST N NBT)  
 (repeat (setq n (sslength ss))
   (setq lst (cons (vlax-ename->vla-object (ssname ss (setq n (1- n)))) lst)))
 
 (setq blk (vla-add (vla-get-blocks AcDoc)
	     (vlax-3d-point p) Nom-B))
 
 (foreach n lst (vla-transformby n (UCS2WCSMatrix)))  
 (vlax-Invoke (vla-get-activedocument (vlax-get-acad-object)) 'CopyObjects lst blk)  
 (foreach n lst (vla-delete n))  
 (vla-insertblock Space (vlax-3d-point (trans p 1 0)) Nom-B 1 1 1
   (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 (trans '(0 0 1) 1 0 T))))
 (princ)
)

;; Doug C. Broad, Jr.							;
;; can be used with vla-transformby to					;
;; UCS2WCSMatrix transform objects from the UCS to the WCS		;
(defun UCS2WCSMatrix ()
 (vlax-tmatrix (append (mapcar '(lambda (vector origin) (append (trans vector 1 0 T) (list origin)))
			(list '(1 0 0) '(0 1 0) '(0 0 1))
			(trans '(0 0 0) 0 1))(list '(0 0 0 1))))
)

;;;	 Routine changement calque de l'objet				;
(defun chang_Calque (Ob Calq) 
 (if (not (tblobjname "LAYER" Calq))
   (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) Calq))
 (vla-put-Lock (vlax-ename->vla-object (tblobjname "LAYER" Calq)) :vlax-false) ;déverouille calque
 (vla-put-layer (vlax-ename->vla-object Ob) Calq)  
)

[Edité le 3/4/2007 par Bred]

 

[Edité le 3/4/2007 par Bred]

[(gile)]

Super !

 

Pour la création d'attributs en vla-, regarde (vla-addAttribute ...).

 

Tu peux faire ton attribut dans l'espace actif (comme pour le point) et l'ajouter au jeu de selection et le copier dans le bloc avec vla-CopyObjects.

Tu peux aussi ajouter l'attribut directement dans le bloc (pareil pour le point avec vla-addPoint).

 

Sinon tu dois pouvoir gagner quelques lignes de code : si les variables AcDoc ou Space sont définies dans la routines principale, même si elle sont déclarées, elles conservent leur valeur dans les sous routines appelée par cette fonction.

[(gile)]

Toujours pour gagner quelques lignes, tu peux remplacer :

 

(setq	coord-nod     (vlax-safearray->list
		(vlax-variant-value
		  (vla-get-Coordinates vla-nod)
		)
	      )
coord-txt     (vlax-safearray->list
		(vlax-variant-value
		  (vla-get-InsertionPoint vla-txt)
		)
	      )
coordX-pt/txt (- (car (vlax-safearray->list
			(vlax-variant-value
			  (vla-get-Coordinates vla-nod)
			)
		      )
		 )
		 (car (vlax-safearray->list
			(vlax-variant-value
			  (vla-get-InsertionPoint vla-txt)
			)
		      )
		 )
	      )
coordY-pt/txt (- (cadr (vlax-safearray->list
			 (vlax-variant-value
			   (vla-get-Coordinates vla-nod)
			 )
		       )
		 )
		 (cadr (vlax-safearray->list
			 (vlax-variant-value
			   (vla-get-InsertionPoint vla-txt)
			 )
		       )
		 )
	      )
coordZ-pt/txt (- (caddr	(vlax-safearray->list
			  (vlax-variant-value
			    (vla-get-Coordinates vla-nod)
			  )
			)
		 )
		 (caddr	(vlax-safearray->list
			  (vlax-variant-value
			    (vla-get-InsertionPoint vla-txt)
			  )
			)
		 )
	      )
coordnod/txt  (list (+ (car coord-txt) coordX-pt/txt)
		    (+ (cadr coord-txt) coordY-pt/txt)
		    (+ (caddr coord-txt) coordZ-pt/txt)
	      )
 ) 

 

par :

 

(setq coord-nod (vlax-get vla-nod 'Coordinates))
(setq coord-txt (vlax-get vla-txt 'InsertionPoint))
(setq coord-pt/txt (mapcar '- coord-nod coord-txt))
(setq coord-nod/txt (mapcar '+ coord-txt coord-pt/txt)) 

 

Et la dernière ligne ne sert à rien :

 

coord-nod/txt = coord-txt + (coord-nod - coord-txt) = coord-nod

 

[Edité le 3/4/2007 par (gile)]

[Bred]

merci (gile)

 

en fait j'avais fait tout ça pour une raison : j'avais pensais avoir remarqué que lorsque je calculais des différences de coordonnées en sortant dabord les coordonnées avec vla-get-Coordinates, elle était moins juste que de calculer toutes de suite le variant... mais quand je regarde mon code maintenant, et après ta remarque, je m'aperçois en fait que je le faisais aussi....)

 

J'ai quand même un doute sur l'éxactitude du calcul de différence entre le point nodal et le text, par rapport au nombre de chiffre après la virgule que l'on récupère ...

[(gile)]

Les résultats sont identiques avec les deux méthodes.

 

Essaye :

 

(setq obj (vlax-ename->vla-object (car (entsel))))

(setq vlax-lst (vlax-get obj 'Coordinates))
(setq vla-lst (vlax-safearray->list (vlax-variant-value (vla-get-coordinates obj))))

(mapcar  'equal vlax-lst vla-lst) 

 

Maintenant il est certain que tout calcul avec des nombres réels risque de faire un peu de précision au niveau de la décimale à laquelle sont arrondis les nombres :

 

par exemple, en calculant au millième :

 

1.246 + 2.327 = 3.573

 

le même calcul au centième

 

1.25 + 2.33 = 3.58

 

mais AutoCAD faisant ces calculs à la 16ème décimale (il me semble), il faut faire vraiment beaucoup d'opérations pourque l'imprecision devienne significative.

[Bred]

En effet, c'est identique...

mais comment faire alors :

j'ai dans le plan que l'on m'a demandé de regarder des coordonnée de point du genre

(465116.0 574565.0 3.799)

Et qui ne me donne qu'un seul chiffre apère la virgule quansd je sort les coordonnées en forme de liste ....

Donc, si je ne dit pas de bétise, lorque je fait un calcul de différence de coordonnée, et que cette différence est de 0.05, ça sera faux !....) :casstet:

[(gile)]

Comme une calculatrice, pour des raisons de place, l'affichage limite le nombre de décimales pour les grand nombres (après on passe en affichage scientifique -puissances de 10) mais les calculs se font toujours avec la précision du calculateur (soit 12 décimales pour la plupart des calculatrices 16 -je crois- pour AutoCAD).

 

Essaye :

 

(setq pt (getpoint))

(mapcar '(lambda (x) (rtos x 2 14)) pt)

[Bred]

OK! OK!!!

En fait j'ai tord de trop regarder les résultats donnés par la console VL ....

Ton exemple est trés parlant, merci !

[Bred]

C'est bon, j'ai vu le truc pour les attributs, merci !

j'edite le code ci-dessus.