Objetos dentro de bloques

Buen día señores.
Con problemita que, seguramente ya se resolvió en algún momento, pero no he encontrado referencias. Explico:

Me llegan archivos de topografía con bloques ubicados en sus coordenadas. El bloque consta de un círculo que ubica la posición (X,Y) y unos textos que indican el número de punto, la elevación y el "nombre" el punto: Por ejemplo, está el círculo, un texto amarillo con un texto que indica el número de punto, un texto rojo que indica la elevación del punto, y un texto verde que indica el "nombre" del punto.
En primera instancia lo resolví explotando los bloque y leyendo con esta rutina, "sin problemas"

Código:


(vl-load-com)
(defun c:pasaptos()
  (vl-cmdf "_Zoom" "_extents")
  (setq nombre(getvar "dwgname")
        ruta(getvar "dwgprefix"))
  (setq archivo(strcat ruta nombre ".CSV"))
  (setq i 0)
  (setq conj(ssget "_X"(list '(0 . "circle")'(8 . "V-NODE"))))
  (setq cuantos(sslength conj))
  (repeat cuantos
    (setq ent(ssname conj i))
    (setq obj(vlax-ename->vla-object ent))
    (setq zc(vlax-get-property obj 'center))
    (setq centro(vlax-safearray->list(vlax-variant-value zc)))
    (setq xx(car centro) yy(cadr centro))
    (setq pto2(polar centro(* pi 0.0)0.75))
    (setq pto3(polar centro(* pi 1.8)0.75))
    (setq rojo(ssget "_F" (list centro pto2) (list(cons 0 "*text")(cons 62 1))))
    (setq ent(ssname rojo 0))
    (setq obj(vlax-ename->vla-object ent))
    (setq eleva(distof(vlax-get-property obj 'textstring)))
    (setq p1(list xx yy eleva))
    (setq verde(ssget "_F"(list centro pto3)(list(cons 0 "text")(cons 62 3))))
    (setq ent(ssname verde 0))
    (setq obj(vlax-ename->vla-object ent))
    (setq capa(strcat "+"(vlax-get-property obj 'textstring)))
    (ENTMAKE (LIST '(0 . "POINT")'(100 . "AcDbEntity")'(100 . "AcDbPoint")(CONS 10 p1)(cons 8 capa)))
    (setq renglon(strcat (rtos xx 2 3)","(rtos yy 2 3)","(rtos eleva 2 3)","capa))
    (Setq abre(open archivo "a"))
    (write-line renglon abre)
    (close abre)
    (setq i (+ 1 i))
    )
  (startapp "notepad" archivo)
  )


El problema vino cuando vi que existen puntos que están muy cercanos y la lectura de los datos no me da certeza de estar seleccionando el dato correcto, por eso "creo que y pienso que" la solución es leyendo dentro del bloque.

Espero haber sido claro. Anexo dirección de drive con el DWG y la tutina que hice, espero puedan ayudarme, saludos y gracias.

https://drive.google.com/drive/folders/1Q2X6EQqph-1pI9I6e87te40EG6kwaweh?usp=sharing

Podrías usar dattaextraction y seleccionar los bloques, eso te dará toda la información contenida en ellos

; Crea un fichero.txt con todas las ubicaciones de los bloques del dibujo.
;;; Program by Tony Hotchkiss

(defun err (s)
(if (= s "Function cancelled")
(princ "\nBLOCK-LOC - cancelled: ")
(progn (princ "\nBLOCK-LOC - Error: ") (princ s) (terpri))
)
(resetting)
(princ "SYSTEM VARIABLES have been reset\n")
(princ)
)
(defun setv (systvar newval)
(setq x (read (strcat systvar "1")))
(set x (getvar systvar))
(setvar systvar newval)
)
(defun setting ()
(setq oerr *error*)
(setq *error* err)
(setv "CMDECHO" 0)
(setv "BLIPMODE" 0)
)
(defun rsetv (systvar)
(setq x (read (strcat systvar "1")))
(setvar systvar (eval x))
)
(defun resetting () (rsetv "CMDECHO") (rsetv "BLIPMODE") (setq *error* oerr))

(defun dxf (code ename) (cdr (assoc code (entget ename))))

(defun bloc-loc (/ i)
(setq blist (get-blist)
i (- 1)
)
(setq fname (getfiled "Results file" "" "txt" 1))
(setq f1 (open fname "w"))
(write-line "UBICACION de BLOQUES, X-Y-Z COORDENADAS" f1)
(repeat (length blist)
(setq bname (nth (setq i (1+ i)) blist))
(setq ss (ssget "X"
(list '(0 . "INSERT") (cons 2 bname))
)
)
(setq ptlist (extract-block-locations ss))
(write-line bname f1)
(foreach item ptlist
(setq x (rtos (nth 0 item) 2 2)
y (rtos (nth 1 item) 2 2)
z (rtos (nth 2 item) 2 2)
str (strcat x " " y " " z)
)
(write-line str f1)
)
(write-line "" f1)
)
(setq f1 (close f1))
(princ)
)

(defun get-blist (/ i)
(setq ss (ssget "X" '((0 . "INSERT"))))
(if ss
(progn (setq i (- 1)
blist nil
)
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i)))
blkname (dxf 2 en)
)
(if (not (member blkname blist))
(setq blist (append blist (list blkname)))
)
)
)
(progn (alert "No block references found.") (exit))
)
(setq blist (vl-sort blist '<))
)

(defun extract-block-locations (ss / i)
(setq i (- 1)
inspt-list nil
)
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i)))
inspt (dxf 10 en)
inspt-list (append inspt-list (list inspt))
)
)
inspt-list
)

(defun c:blc () (setting) (bloc-loc) (resetting) (princ))

Pues nada, creo que las opciones que te di son para bloques normales o con atributos

Muchas gracias. Ahora si que, la intención es lo que cuenta. Por lo pronto lo resolví de forma "un tanto artesanal" pero funciona. Explico: Tome cada bloque, lo exploté y leí cada elemento y luego borré cada elemento explotado y así con cada bloc, lo malo es que normalmente son 2 o 3 mil puntos, pero mejor eso que a mano.
Como digo, está artesanal, la coloco por si a laguien le sirve o le interesa el tema o si lo pueden mejorar, bienvenido.
Otra vez Gracias

Código:


(vl-load-com)
(defun c:prueba2()
  (setq i 0)
  (setvar 'pdmode 35)
  (vl-cmdf "_Zoom" "_extents")
  (setq nombre(getvar "dwgname")
        ruta(getvar "dwgprefix"))
  (setq archivo(strcat ruta nombre ".CSV"))
  (setq conj(ssget "_X" (list (cons 0 "INSERT"))))
  (setq cuantos(sslength conj))
  (repeat cuantos
    (setq ent(ssname conj i))
    (setq obj(vlax-ename->vla-object ent))
    (setq pto0(vlax-get-property obj 'insertionpoint))
    (setq pto1(vlax-safearray->list(vlax-variant-value pto0)))
    (setq pto2(polar pto1(* pi 0.6)0.23)
          pto3(polar pto1(* pi 1.91)0.7))
    ;(vl-cmdf "_rectangle" pto2 pto3)
    (vlax-invoke-method obj 'explode)
    ;---
    (setq circ(ssget "_X"(list '(0 . "circle")'(8 . "V-NODE"))))
    (setq ent(ssname circ 0))
    (setq obj(vlax-ename->vla-object ent))
    (setq zc(vlax-get-property obj 'center))
    (setq centro(vlax-safearray->list(vlax-variant-value zc)))
    (setq xx(car centro) yy(cadr centro))
    ;---
    (setq pto4(polar centro(* pi 0.0)0.75))
    (setq pto5(polar centro(* pi 1.8)0.75))
    (setq con1(ssget "_X"(list (cons 0 "*text"))));(cons 62 1))))
    (setq paso 0)
    (repeat(sslength con1)
      (setq ent(ssname con1 paso))
      (vl-cmdf "_explode" ent)
      (setq paso(+ paso 1))
      )
    (setq rojo(ssget "_X"(list (cons 0 "text")(cons 62 1))))
    (setq ent(ssname rojo 0))
    (setq obj(vlax-ename->vla-object ent))    
    (setq eleva(distof(vlax-get-property obj 'textstring)))
    (setq p1(list xx yy eleva))
    ;---
    (setq verde(ssget "_X"(list (cons 0 "text")(cons 62 3))))
    (setq ent(ssname verde 0))
    (setq obj(vlax-ename->vla-object ent))
    (setq capa(strcat "+"(vlax-get-property obj 'textstring)))
    (ENTMAKE (LIST '(0 . "POINT")'(100 . "AcDbEntity")'(100 . "AcDbPoint")(CONS 10 p1)(cons 8 capa)))
    (setq renglon(strcat (rtos xx 2 3)","(rtos yy 2 3)","(rtos eleva 2 3)","capa))
    (Setq abre(open archivo "a"))
    (write-line renglon abre)
    (close abre)
    ;---
    (setq borra(ssget "_X" (list '(0 . "circle,line,text"))))
    (vl-cmdf "_erase" borra "")
    (setq i(1+ i))
    )
  (startapp "notepad" archivo)
  )


También podrías pedir que te envíen las tablas con la información e insertarla con varias rutinas que existen. Los bloques con atributos son la solución

Esta función te permite obtener una lista de todos los elementos que componen un bloque. Creo que es lo que necesitas

Código:

(defun foo (your_vla_block / rtn);BY Jonathan Handojo
    (vlax-for x (vla-item (vla-get-blocks (vla-get-document your_vla_block)) (vla-get-effectivename your_vla_block))
        (setq rtn (cons x rtn));lista vla_obj
    )
    (reverse rtn)
)