Jump to content

Lisp donnee d objet - Remplir XYZ

sepacap

By sepacap,
in Autodesk Map

 Share Followers 0

Recommended Posts

sepacap

sepacap 2

Posted
Posted

bonjour je cherche a renseigner les coordonnées x et y en automatique sur des données d'objet avec une lisp

j'ai recuperer cette Lisp mais elle ne fonctionne pas

 

((lambda ( / js ent pt)

(setq js (ssget '((0 . "INSERT") (2 . "TE_BB,Te_Br,Te_E_B,Ad_Br,PEC_C,Cit_S,col,Co_ELS,Co_Br,Ad_Br_AB,Coude_8_ELS,Coude_16_EE,Coude_8_EE,Manch_ELS,Manch,Cd_Em_1/16") (8 . "EQ_SPE"))))

(repeat (setq n (sslength js))

(setq

ent (ssname js (setq n (1- n)))

pt (cdr (assoc 10 (entget ent)))

)

(ade_odsetfield ent "EQ_SPE" "Coord_X" 0 (car pt))

(ade_odsetfield ent "EQ_SPE" "Coord_Y" 0 (cadr pt))

(ade_odsetfield ent "EQ_SPE" "Altitude" 0 (caddr pt))

 

)

))

 

Y aurais t'il une âme charitable pour m'aider ?

Link to post
Share on other sites
lecrabe

lecrabe 65

Posted
Posted

Hello

 

Ton Lisp semble venir de notre "fameux" Bruno (Bonuscad) !?

 

Donc je te propose une bien meilleure version (toujours de Bruno Bonuscad)

Cette routine renseigne 2 champs OD par les Coords XY du point d'insertion du Bloc ...

La routine "Coord2OD_XY" a charger par la commande APPLOAD ...

 

SVP tu nous diras si cela te convient ?

 

ATTENTION : Les objets selectionnes n ayant pas la Table OD correspondante attachee sont forces en couleur = 11

ATTENTION 2 : la routine traite les Blocs et les Points !

 

LA SANTE, Bonne Annee, Bye, lecrabe

 

PS: j'ai la meme version qui remplit XYZ et non pas seulement XY si necessaire !?

 

 


;; 
;; Routine: Coord2OD_XY by Bruno for Patrice
;; 
;; Version 1.2 avec avec qq micro-micro-Modifs ...
;; 
;; Version modifiee pour 2 Coords ONLY X & Y (et non pas X & Y & Z)
;; 

(vl-load-com) 

(defun str2lst (str sep / pos)
(if (setq pos (vl-string-search sep str))
	(cons
		(substr str 1 pos)
		(str2lst (substr str (+ (strlen sep) pos 1)) sep)
	)
	(list str)
)
)


;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste deroulante
;; 1 = liste choix unique
;; 2 = liste choix multipes
;;
;; Retour : la cle de l'option (flag = 0 ou 1) ou la liste des cles des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Presentation" "Choisir une presentation" (mapcar 'cons (layoutlist) (layoutlist)) 1)

(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
(setq
	tmp (vl-filename-mktemp "tmp.dcl")
	file (open tmp "w")
)
(write-line
	(strcat "ListBox:dialog{label=\"" title "\";")
	file
)
(if (and msg (/= msg ""))
	(write-line (strcat ":text{label=\"" msg "\";}") file)
)
(write-line
	(cond
		((= 0 flag) "spacer;:popup_list{key=\"lst\";")
		((= 1 flag) "spacer;:list_box{key=\"lst\";")
		(T "spacer;:list_box{key=\"lst\";multiple_select=true;")
	)
	file
)
(write-line "}spacer;ok_cancel;}" file)
(close file)
(setq dcl_id (load_dialog tmp))
(if (not (new_dialog "ListBox" dcl_id))
	(exit)
)
(start_list "lst")
(mapcar 'add_list (mapcar 'cdr keylab))
(end_list)
(action_tile
	"accept"
	"(or (= (get_tile \"lst\") \"\")
		(if (= 2 flag)
			(progn
				(foreach n (str2lst (get_tile \"lst\") \" \")
					(setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice))
				)
				(setq choice (reverse choice))
			)
			(setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))
		)
	)
	(done_dialog)"
)
(start_dialog)
(unload_dialog dcl_id)
(vl-file-delete tmp)
choice
)


(defun vl-position-multi (el l / n l_id l_n)
(setq
	n 0
	l_id (mapcar '(lambda (x) (equal x el)) l)
)
(repeat (length l_id)
	(if (car l_id) (setq l_n (cons n l_n)))
	(setq n (1+ n) l_id (cdr l_id))
)
(reverse l_n)
)


(defun c:Coord2OD_XY ( / l_tab tab_source list_field_source l_typ pos l_field tmp choice_fld js n_ok n_nook n_bad n ent dxf_ent pt_ins) 

(setvar "DIMZIN" 0) 

(princ "\nVariable System DIMZIN = 0 : pour ne pas supprimer les Zeros a droite ! ") 
(princ "\nCette routine transfere dans 3 Champs OD (Type Reel imperatif) les 3 Coords XYZ des Blocs / Points selectionnes  ") 
(princ "\nLes objets selectionnes n ayant pas la Table OD correspondante attachee sont forces en couleur = 11 (Rose)       ") 


(cond
	(
		(or
			(numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object))))
			(numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object))))
		)
		(setq l_tab (ade_odtablelist))
		(cond
			(l_tab
				(setq tab_source (listbox "TABLES" "Choix de la table SOURCE" (mapcar 'cons l_tab l_tab) 1))
				(cond
					(tab_source
						(setq
							list_field_source (ade_odtabledefn tab_source)
							l_typ (mapcar 'cdr (mapcar 'caddr (cdaddr list_field_source)))
							pos (vl-position-multi "Real" l_typ)
						)
						(cond
							(pos 

;;									(setq l_field (mapcar '(lambda (x) (nth x (cdaddr list_field_source))) pos) list_field_source nil tmp '("X" "Y" "Z")) 
								(setq l_field (mapcar '(lambda (x) (nth x (cdaddr list_field_source))) pos) list_field_source nil tmp '("X" "Y"    )) 

;;									(repeat 3 
								(repeat 2 

									(setq
										choice_fld
										(listbox "CHAMPS"
											(strcat "Choix du champ SOURCE pour la coordonnee " (car tmp) " de la table " tab_source)
											(mapcar 'cons (mapcar 'cdar l_field) (mapcar 'cdar l_field))
											1
										)
									)
									(if choice_fld
										(setq list_field_source (cons (cons choice_fld (car tmp)) list_field_source) tmp (cdr tmp))
										(exit)
									)
								)
								(princ "\nSelectionner des Insertions de Bloc ou Point : ")
								(setq js (ssget (list '(0 . "POINT,INSERT") (cons 410 (getvar "CTAB")))) n_ok 0 n_nook 0 n_bad 0)
								(cond
									(js
										(repeat (setq n (sslength js))
											(setq ent (ssname js (setq n (1- n))) dxf_ent (entget ent))
											(cond
												(
													(and
														(member (cdr (assoc 0 dxf_ent)) '("POINT" "INSERT"))
														(if (cdr (assoc 2 dxf_ent))
															(/= (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 dxf_ent))))) 4) 4)
															T
														)
													)
													(setq pt_ins
														(if (eq (cdr (assoc 0 dxf_ent)) "INSERT")
															(trans (cdr (assoc 10 dxf_ent)) (cdr (assoc 210 dxf_ent)) 0)
															(cdr (assoc 10 dxf_ent))
														)
													)
													(cond
														((member tab_source (ade_odgettables ent))
															(foreach el list_field_source
																(ade_odsetfield
																	ent
																	tab_source
																	(car el)
																	0
																	(cond
																		((eq (cdr el) "X") (car pt_ins))
																		((eq (cdr el) "Y") (cadr pt_ins)) 
;;																			((eq (cdr el) "Z") (caddr pt_ins)) 
																	)
																)
															)
															(setq n_ok (1+ n_ok))
														)
														(T
															(entmod
																(if (assoc 62 dxf_ent)
																	(subst '(62 . 11) (assoc 62 dxf_ent) dxf_ent)
																	(append dxf_ent '((62 . 11)))
																)
															)
															(setq n_nook (1+ n_nook))
														)
													)
												)
												(T (setq n_bad (1+ n_bad)))
											)
										)
										(princ (strcat "\n" (itoa (sslength js)) " objets POINT ou BLOC selectionnes "))
										(princ (strcat "\n" (itoa n_ok) " objets traites "))
										(princ (strcat "\n" (itoa n_nook) " objets marques non-traites "))
										(princ (strcat "\n" (itoa n_bad) " objets ignores "))
									)
									(T (princ "\nSelection vide ! "))
								)
							)
							(T (princ "\nPas de Champs OD definis en Reel ! "))
						)
					)
					(T (princ "\nAucune Table OD selectionnee ! "))
				)
			)
			(T (princ "\nAucune table definie dans ce dessin ! "))
		)
	)
	(T (princ "\nCette fonction requiert Map 3D ou Civil 3D ! "))
) 

(prin1)
)

Autodesk Expert Elite Team

Link to post
Share on other sites
lecrabe

lecrabe 65

Posted
Posted

Hello

 

Et voici la version qui remplit XYZ

car il me semble que tu veux remplir XYZ et non pas seulement XY !

 

Routine : Coord2OD

 

SVP tu nous diras si cela te convient ?

 

ATTENTION : Les objets selectionnes n ayant pas la Table OD correspondante attachee sont forces en couleur = 11

ATTENTION 2 : la routine traite les Blocs et les Points !

 

LA SANTE, Bonne Annee, Bye, lecrabe

 


;; 
;; Routine: Coord2OD by Bruno for Patrice
;; 
;; Version 1.2 avec avec qq micro-micro-Modifs ...
;; 

(vl-load-com)

(defun str2lst (str sep / pos)
(if (setq pos (vl-string-search sep str))
	(cons
		(substr str 1 pos)
		(str2lst (substr str (+ (strlen sep) pos 1)) sep)
	)
	(list str)
)
)


;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste deroulante
;; 1 = liste choix unique
;; 2 = liste choix multipes
;;
;; Retour : la cle de l'option (flag = 0 ou 1) ou la liste des cles des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Presentation" "Choisir une presentation" (mapcar 'cons (layoutlist) (layoutlist)) 1)

(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
(setq
	tmp (vl-filename-mktemp "tmp.dcl")
	file (open tmp "w")
)
(write-line
	(strcat "ListBox:dialog{label=\"" title "\";")
	file
)
(if (and msg (/= msg ""))
	(write-line (strcat ":text{label=\"" msg "\";}") file)
)
(write-line
	(cond
		((= 0 flag) "spacer;:popup_list{key=\"lst\";")
		((= 1 flag) "spacer;:list_box{key=\"lst\";")
		(T "spacer;:list_box{key=\"lst\";multiple_select=true;")
	)
	file
)
(write-line "}spacer;ok_cancel;}" file)
(close file)
(setq dcl_id (load_dialog tmp))
(if (not (new_dialog "ListBox" dcl_id))
	(exit)
)
(start_list "lst")
(mapcar 'add_list (mapcar 'cdr keylab))
(end_list)
(action_tile
	"accept"
	"(or (= (get_tile \"lst\") \"\")
		(if (= 2 flag)
			(progn
				(foreach n (str2lst (get_tile \"lst\") \" \")
					(setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice))
				)
				(setq choice (reverse choice))
			)
			(setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))
		)
	)
	(done_dialog)"
)
(start_dialog)
(unload_dialog dcl_id)
(vl-file-delete tmp)
choice
)


(defun vl-position-multi (el l / n l_id l_n)
(setq
	n 0
	l_id (mapcar '(lambda (x) (equal x el)) l)
)
(repeat (length l_id)
	(if (car l_id) (setq l_n (cons n l_n)))
	(setq n (1+ n) l_id (cdr l_id))
)
(reverse l_n)
)


(defun c:Coord2OD ( / l_tab tab_source list_field_source l_typ pos l_field tmp choice_fld js n_ok n_nook n_bad n ent dxf_ent pt_ins) 

(setvar "DIMZIN" 0) 

(princ "\nVariable System DIMZIN = 0 : pour ne pas supprimer les Zeros a droite ! ") 
(princ "\nCette routine transfere dans 3 Champs OD (Type Reel imperatif) les 3 Coords XYZ des Blocs / Points selectionnes  ") 
(princ "\nLes objets selectionnes n ayant pas la Table OD correspondante attachee sont forces en couleur = 11 (Rose)       ") 


(cond
	(
		(or
			(numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object))))
			(numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object))))
		)
		(setq l_tab (ade_odtablelist))
		(cond
			(l_tab
				(setq tab_source (listbox "TABLES" "Choix de la table SOURCE" (mapcar 'cons l_tab l_tab) 1))
				(cond
					(tab_source
						(setq
							list_field_source (ade_odtabledefn tab_source)
							l_typ (mapcar 'cdr (mapcar 'caddr (cdaddr list_field_source)))
							pos (vl-position-multi "Real" l_typ)
						)
						(cond
							(pos
								(setq l_field (mapcar '(lambda (x) (nth x (cdaddr list_field_source))) pos) list_field_source nil tmp '("X" "Y" "Z"))
								(repeat 3
									(setq
										choice_fld
										(listbox "CHAMPS"
											(strcat "Choix du champ SOURCE pour la coordonnee " (car tmp) " de la table " tab_source)
											(mapcar 'cons (mapcar 'cdar l_field) (mapcar 'cdar l_field))
											1
										)
									)
									(if choice_fld
										(setq list_field_source (cons (cons choice_fld (car tmp)) list_field_source) tmp (cdr tmp))
										(exit)
									)
								)
								(princ "\nSelectionner des Insertions de Bloc ou Point : ")
								(setq js (ssget (list '(0 . "POINT,INSERT") (cons 410 (getvar "CTAB")))) n_ok 0 n_nook 0 n_bad 0)
								(cond
									(js
										(repeat (setq n (sslength js))
											(setq ent (ssname js (setq n (1- n))) dxf_ent (entget ent))
											(cond
												(
													(and
														(member (cdr (assoc 0 dxf_ent)) '("POINT" "INSERT"))
														(if (cdr (assoc 2 dxf_ent))
															(/= (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 dxf_ent))))) 4) 4)
															T
														)
													)
													(setq pt_ins
														(if (eq (cdr (assoc 0 dxf_ent)) "INSERT")
															(trans (cdr (assoc 10 dxf_ent)) (cdr (assoc 210 dxf_ent)) 0)
															(cdr (assoc 10 dxf_ent))
														)
													)
													(cond
														((member tab_source (ade_odgettables ent))
															(foreach el list_field_source
																(ade_odsetfield
																	ent
																	tab_source
																	(car el)
																	0
																	(cond
																		((eq (cdr el) "X") (car pt_ins))
																		((eq (cdr el) "Y") (cadr pt_ins))
																		((eq (cdr el) "Z") (caddr pt_ins))
																	)
																)
															)
															(setq n_ok (1+ n_ok))
														)
														(T
															(entmod
																(if (assoc 62 dxf_ent)
																	(subst '(62 . 11) (assoc 62 dxf_ent) dxf_ent)
																	(append dxf_ent '((62 . 11)))
																)
															)
															(setq n_nook (1+ n_nook))
														)
													)
												)
												(T (setq n_bad (1+ n_bad)))
											)
										)
										(princ (strcat "\n" (itoa (sslength js)) " objets POINT ou BLOC selectionnes "))
										(princ (strcat "\n" (itoa n_ok) " objets traites "))
										(princ (strcat "\n" (itoa n_nook) " objets marques non-traites "))
										(princ (strcat "\n" (itoa n_bad) " objets ignores "))
									)
									(T (princ "\nSelection vide ! "))
								)
							)
							(T (princ "\nPas de Champs OD definis en Reel ! "))
						)
					)
					(T (princ "\nAucune Table OD selectionnee ! "))
				)
			)
			(T (princ "\nAucune table definie dans ce dessin ! "))
		)
	)
	(T (princ "\nCette fonction requiert Map 3D ou Civil 3D ! "))
) 

(prin1)
)

Autodesk Expert Elite Team

Link to post
Share on other sites
sepacap

sepacap 2

Posted
  • Author
Posted

merci de ton aide mais cette lisp ne fonctionne pas chez moi erreur (cette fonction requiert map 3d ou civil alors que j'ai map 3d )

bizarre

 

 

j'ai reussi a utiliser cette lisp

 

((lambda ( / js ent pt)

(setq js (ssget '((0 . "POINT") (8 . "PT_GEN_SUP"))))

(repeat (setq n (sslength js))

(setq

ent (ssname js (setq n (1- n)))

pt (cdr (assoc 10 (entget ent)))

)

(ade_odsetfield ent "PT_GEN_SUP" "Coord_x" 0 (car pt))

(ade_odsetfield ent "PT_GEN_SUP" "Coord_y" 0 (cadr pt))

(ade_odsetfield ent "PT_GEN_SUP" "ALTITUDE" 0 (caddr pt))

 

)

))

 

Cependant j'aimerais pouvoir changer la variable ALTITUDE avec la donnée altitude moins 1

Est ce possible ??

Link to post
Share on other sites
lecrabe

lecrabe 65

Posted
Posted

Hello

 

J ai deja utilise ces routines sur mes multiples MAP 20XX !

 

OK je vais les retester sur mon MAP 2021 et MAP 2016 ... Peut etre ai je mal copie / colle !?

 

LA SANTE, Bye, lecrabe

Autodesk Expert Elite Team

Link to post
Share on other sites
lecrabe

lecrabe 65

Posted
Posted

Hello

 

Je viens de retester la routine "Coord2OD" (donc XYZ)

sur mon MAP 2021 et sur mon MAP 2016 ...

 

Et bien entendu elle fonctionne parfaitement !!

 

Avec des Blocs ayant une table OD EXISTANTE

et au moins 3 champs OD de type flottant/reel EXISTANTS

pour y transferer les Coords XYZ !

 

LA SANTE, Bye, lecrabe

 

PS: Encore MERCI a Bruno Bonuscad pour toutes ses routines !!

Autodesk Expert Elite Team

Link to post
Share on other sites
bonuscad

bonuscad 50

Posted
Posted

cependant j'aimerais pouvoir changer la variable ALTITUDE avec la donnée altitude moins 1 est ce possible ??

Je pense quand changeant cette ligne, ça devrait correspondre à ta demande:

 

(ade_odsetfield ent "PT_GEN_SUP" "ALTITUDE" 0 (caddr pt)) --------->>>> (ade_odsetfield ent "PT_GEN_SUP" "ALTITUDE" 0 (1- (caddr pt) ) )

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Link to post
Share on other sites
Maxime063

Maxime063 2

Posted
Posted

(princ "\nVariable System DIMZIN = 0 : pour ne pas supprimer les Zeros a droite ! ")

(princ "\nCette routine transfere dans 3 Champs OD (Type Reel imperatif) les 3 Coords XYZ des Blocs / Points selectionnes ")

(princ "\nLes objets selectionnes n ayant pas la Table OD correspondante attachee sont forces en couleur = 11 (Rose) ")

 

 

(cond

(

(or

(numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object))))

(numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object))))

)

 

Après avoir tester sur un MAP 3D 2016 j'ai le même résultat avec la condition qui bloque

Link to post
Share on other sites
lecrabe

lecrabe 65

Posted
Posted

Hello

 

SVP pourquoi cela marche chez moi depuis "toujours"

et encore aujourd'hui sur mon MAP 2016 et MAP 2021 !?

 

LA SANTE, Bye, lecrabe

 

PS: MERCI a Maitre Bruno Bonuscad pour la Modif "adequate" !

Autodesk Expert Elite Team

Link to post
Share on other sites
bonuscad

bonuscad 50

Posted
Posted

Après avoir tester sur un MAP 3D 2016 j'ai le même résultat avec la condition qui bloque

 

Afin d'éclaircir la situation, copie-colle l'instruction qui suit directement en ligne de commande et donne le retour, on sera peut être fixé sur le point noir...

 

(vla-get-caption (vlax-get-acad-object))

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Link to post
Share on other sites
sepacap

sepacap 2

Posted
  • Author
Posted

 

Afin d'éclaircir la situation, copie-colle l'instruction qui suit directement en ligne de commande et donne le retour, on sera peut être fixé sur le point noir...

 

(vla-get-caption (vlax-get-acad-object))

 

moi j'ai ca :

Autodesk AutoCAD Map 3D 2020 -

 

Link to post
Share on other sites
bonuscad

bonuscad 50

Posted
Posted

moi j'ai ca :

Autodesk AutoCAD Map 3D 2020 -

 

 

Le retour est correct, alors je pense simplement aux fonctions (vl- qui ne sont pas chargés (étrange sous une version 2020)

Essayes de valider le chargement en tapant la commande (vl-load-com) en ligne de commande, puis de relancer le code.

 

J'ai l'impression que c'est (vl-string-search qui pose problème

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Link to post
Share on other sites
sepacap

sepacap 2

Posted
  • Author
Posted

bonjour

 

pour faire suite a mon dernier problème, j'ai réussi a créer mon annotation!

 

 

cependant, j'ai un soucis concernant mon attribut Zgs

je m'explique , je n'arrive pas a limiter la precision a deux chiffres après la virgule alors que ma donnée d'objet au quelle elle est raccrochée est bien a deux chiffres après la virgule

ci joint un extrait de plan

Doc1.pdf

Link to post
Share on other sites
lecrabe

lecrabe 65

Posted
Posted

Hello

 

Sans réfléchir et sans voir ton DOC, SVP la variable System

DIMZIN = 0

Et tu relances le Lisp de Bruno / Bonuscad ?!

La Santé, Bye, lecrabe

Autodesk Expert Elite Team

Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
×
 Share
Followers 0
Go to topic listing
×
×
  • Create New...