champs et objet

[daemge]

Bonjour à toutes et à tous

 

je me sers souvent des outils champs en allant pointer un objet pour récupérer une surface ou bien des coordonnées.

mon soucis est que parfois longtemps après avoir crée ce champs, j'aimerai pouvoir retrouver l'objet auquel il est lié, et je ne sais pas comment faire.

si vous avez des idées, je suis preneur.

 

Bonne journée

 

Cordialement

[bonuscad]

Bonjour,

J'ai dans ma collection 2 lisp (qui ne sont pas de moi, et je ne sais plus qui sont les auteurs, peut être Lee Mac)Un pour mettre en évidence les entités dont les champs sont dans un tableau et l'autre pour mettre en évidence l'entité liée à un champ dans un MTEXT.

(defun c:Obj_link2table ( / js obj nb_rows nb_columns indx_r indx_c js_ sub id_cell field_obj en ent)
(while (null (setq js (ssget "_:S" '((0 . "ACAD_TABLE"))))))
(setq
	obj (vlax-ename->vla-object (ssname js 0))
	nb_rows (vla-Get-Rows obj)
	nb_columns (vla-Get-Columns obj)
	indx_r 0 indx_c 0
	js_sub (ssadd)
)
(while (<= indx_r (1- nb_rows))
	(if (eq (vla-GetContentType obj indx_r indx_c) 2)
		(cond
			((numberp (vlax-variant-value (vla-GetCellValue obj indx_r indx_c)))
				(setq
					id_cell (vla-GetFieldId obj indx_r indx_c )
					field_obj (vla-ObjectIDToObject (vla-get-ActiveDocument (vlax-get-acad-object)) id_cell)
					en (cdr (assoc 331 (entget (cdr (assoc 360 (entget (vlax-vla-object->ename field_obj)))))))
				)
				(setq js_sub (ssadd en js_sub))
			)
		)
	)
	(setq indx_c (1+ indx_c))
	(if (> indx_c (1- nb_columns)) (setq indx_r (1+ indx_r) indx_c 0))
)
(if js_sub (sssetfirst nil js_sub))
(prin1)
)

(defun c:fieldobject ( / en )
(while
   	(progn (setvar 'ERRNO 0) (setq en (car (nentsel "\nSelect Field: ")))
       	(cond
           	(   (= 7 (getvar 'ERRNO))
               	(princ "\nMissed, try again.")
           	)
           	(   (eq 'ENAME (type en))
               	(if
                   	(and
                       	(wcmatch (cdr (assoc 0 (setq en (entget en)))) "*TEXT,ATTRIB")
                       	(setq en (cdr (assoc 360 en)))
                       	(setq en (dictsearch en "ACAD_FIELD"))
                       	(setq en (dictsearch (cdr (assoc -1 en)) "TEXT"))
                       	(setq en (cdr (assoc 360 en)))
                       	(setq en (cdr (assoc 331 (entget en))))
                   	)
                   	(sssetfirst nil (ssadd en));(redraw en 3)
                   	(princ "\nObject does not contain a Field.")
               	)
           	)
       	)
   	)
)
(princ)
)

 

[daemge]

Bonjour,

J'ai dans ma collection 2 lisp (qui ne sont pas de moi, et je ne sais plus qui sont les auteurs, peut être Lee Mac)Un pour mettre en évidence les entités dont les champs sont dans un tableau et l'autre pour mettre en évidence l'entité liée à un champ dans un MTEXT.

(defun c:Obj_link2table ( / js obj nb_rows nb_columns indx_r indx_c js_ sub id_cell field_obj en ent)
(while (null (setq js (ssget "_:S" '((0 . "ACAD_TABLE"))))))
(setq
	obj (vlax-ename->vla-object (ssname js 0))
	nb_rows (vla-Get-Rows obj)
	nb_columns (vla-Get-Columns obj)
	indx_r 0 indx_c 0
	js_sub (ssadd)
)
(while (<= indx_r (1- nb_rows))
	(if (eq (vla-GetContentType obj indx_r indx_c) 2)
		(cond
			((numberp (vlax-variant-value (vla-GetCellValue obj indx_r indx_c)))
				(setq
					id_cell (vla-GetFieldId obj indx_r indx_c )
					field_obj (vla-ObjectIDToObject (vla-get-ActiveDocument (vlax-get-acad-object)) id_cell)
					en (cdr (assoc 331 (entget (cdr (assoc 360 (entget (vlax-vla-object->ename field_obj)))))))
				)
				(setq js_sub (ssadd en js_sub))
			)
		)
	)
	(setq indx_c (1+ indx_c))
	(if (> indx_c (1- nb_columns)) (setq indx_r (1+ indx_r) indx_c 0))
)
(if js_sub (sssetfirst nil js_sub))
(prin1)
)

(defun c:fieldobject ( / en )
(while
   	(progn (setvar 'ERRNO 0) (setq en (car (nentsel "\nSelect Field: ")))
       	(cond
           	(   (= 7 (getvar 'ERRNO))
               	(princ "\nMissed, try again.")
           	)
           	(   (eq 'ENAME (type en))
               	(if
                   	(and
                       	(wcmatch (cdr (assoc 0 (setq en (entget en)))) "*TEXT,ATTRIB")
                       	(setq en (cdr (assoc 360 en)))
                       	(setq en (dictsearch en "ACAD_FIELD"))
                       	(setq en (dictsearch (cdr (assoc -1 en)) "TEXT"))
                       	(setq en (cdr (assoc 360 en)))
                       	(setq en (cdr (assoc 331 (entget en))))
                   	)
                   	(sssetfirst nil (ssadd en));(redraw en 3)
                   	(princ "\nObject does not contain a Field.")
               	)
           	)
       	)
   	)
)
(princ)
)

 

merci pour cette réponse , je vais tester tout ça

Cdlt