Coordenadas de Puntos

Estimados Colegas del Foro , Encontré un lisp el cual coloca el valor Z de los puntos seleccionados
pero lo que no puedo lograr dada mi limitación en programación es que coloque los valores de
X e Y de los Puntos si alguien puede ayudar a lograrlo, muy agradecido.
Un Saludo
Luis

Código:

;;; Conv_Puntos_Texto.lsp - Aplicación para convertir la coordenada Z puntos (topográficos) en los textos

(defun C:CPT1 (/ AOSMD ADECH ADZIN VALLPRC UNPRC
 TEXTST ENTST STHIGT TEXTSZ TEMPS CORDX
 CORDY CORDZ TXCORDZ PONTO
 )


 ;(command "_.undo" "begin")

(vl-cmdf "_UCS""u")

 (command "_.undo" "inicio")
 (setq AERR *error*)
 (setq AOSMD (getvar "osmode")
 ADECH (getvar "cmdecho")
 ADZIN (getvar "dimzin")
 )
 (setvar "cmdecho" 0)
 (setvar "dimzin" 0)
 (setq VALLPRC (getvar "luprec"))

 (princ "\n»» Seleccionar puntos:\n")
 (setq SSET (ssget '((0 . "POINT"))))
 (setvar "osmode" 0)
 (if SSET
 (progn
 (terpri)
 (princ "\n»» ¿A cuántos lugares decimales? (0/8) ")
 (princ "<")
 (princ VALLPRC)
 (princ ">")
 (setq UNPRC (getint))
 (if (= UNPRC nil)
 (setq UNPRC VALLPRC)
 )
 (setq TEXTST (getvar "TEXTSTYLE"))
 (setq ENTST (tblsearch "style" TEXTST))
 (setq STHIGT (cdr (assoc 40 ENTST)))
 (PRINC STHIGT)
 (setq OSM (getvar "osmode"))
 (if (= STHIGT 0.0)
 (progn
 (princ "\n»» ¿Cuál es la altura del texto? ")
 (setq TEXTSZ (getdist))
 )
 )

 (setq SSLEN (sslength SSET))
 (while (> SSLEN 0)
 (setq TEMPS (ssname SSET (setq SSLEN (1- SSLEN))))
 (setq CORDX (nth 1 (assoc 10 (entget TEMPS))))
 (setq CORDY (nth 2 (assoc 10 (entget TEMPS))))
 (setq CORDZ (nth 3 (assoc 10 (entget TEMPS))))
 (setq TXCORDX (rtos CORDX 2 UNPRC))
 (setq TXCORDY (rtos CORDY 2 UNPRC))
 (setq TXCORDZ (rtos CORDZ 2 UNPRC))

 (setq PONTO (list CORDX CORDY 0.0))
 (if (> STHIGT 0.0)
 (command "_text" PONTO 90 TXCORDZ)
 (command "_text" PONTO TEXTSZ 90 TXCORDZ)
 )
 )
 )
 (princ "\n»» Nenhum ponto seleccionado!")
 )
 (setvar "osmode" AOSMD)
 (setvar "dimzin" ADZIN)
 (command "_.undo" "fin")
)

;;;
;;;
;;;

(defun *error* (msg)

 (setq *error* AERR)
 (setvar "cmdecho" ADECH)
 (setvar "osmode" AOSMD)
 (setvar "dimzin" ADZIN)
 (command "_.undo" "fin")
 (princ (strcat "»» Parada de la aplicación con el error: " msg))
)

(terpri)
(princ "\n»» Comience a escribir la aplicación CPT1 \n")

;;; Final Conv_Puntos_Texto.lsp

Hola a tod@s

Luis Alberto Benítez: Fíjate en http://www.cadtutor.net/forum/showthread.php?95694-Label-points-X-Y-Z&highlight=labeling+point post N° 6 de Marko Ribar que postea una rutina de Yevgeni Elpanov.

La rutina inserta un bloque con las coordenadas XYZ de los puntos seleccionados. El bloque (label leader.dwg) te lo adjunta también Marko Ribar.

Si sólo quieres etiquetar las coord. XY, yo edité label leader.dwg borrando la coord Z y funciona.

Saludos

Este otro lisp también te sirve.

;Coordenadas rotuladas de un punto.
;Rutina de Manuel Monroy. Arqto. mmonroy@mundofree.com
(defun c:crd ()
(setvar "osmode" 33) ; indicamos el tipo de referencia a objeto final

(while
(setq pt1 (getpoint " Señalar punto del que obtener coordenadas cartesianas: "))(terpri)

(setq xPt1 (car Pt1))
(setq yPt1 (cadr Pt1))

(COMMAND "_TEXT" "_j" "_tc" Pt1 "" "" (STRCAT "(" (rtos xpt1 2 2) " , " (rtos ypt1 2 2) ")" ))
))

Labeling x,y,z Coordinates with Leader - David B. Stewart
modify jlc

(defun C:LP(/ PNT1 P1X P1Y STDY STDX STDZ COORDN COORDE COORDZ PTXT)
(setq PNT1 (getpoint "\nPick coordinate point: "))
(setq P1X (car pnt1))
(setq P1Y (cadr pnt1))
(setq P1Z (caddr pnt1))

(setq STDX (rtos P1X 2 4))
(setq STDY (rtos P1Y 2 4))
(setq STDZ (rtos P1Z 2 4))
(setq COORDN (strcat "Y= " STDY ))
(setq COORDE (strcat "X= " STDX ))
(setq COORDZ (strcat "Z= " STDz ))
(setq PTXT (getpoint
"\nPick text location: "))
(command "LEADER" PNT1 PTXT ""COORDE COORDN COORDZ "")
(princ)
)


Gracias por los aportes al tema yo solo quería modificar para que solo de una sola selección de los puntos coloque las coordenadas y no realizar uno por uno.
Un saludo
Luis

Luis Alberto Benitez escribió:Gracias por los aportes al tema yo solo quería modificar para que solo de una sola selección de los puntos coloque las coordenadas y no realizar uno por uno.
Un saludo
Luis

Trata de cambiar esta parte

Código:

(command "_text" PONTO 90 TXCORDZ)
 (command "_text" PONTO TEXTSZ 90 TXCORDZ)

Por esta otra

Código:

 (command "-mtext" PONTO "r" 90 "h" TEXTSZ "j" "TL" "w" "0" (strcat "X=" TXCORDX "\\P" "Y=" TXCORDY "\\P" "Z=" TXCORDZ) "")
 (command "-mtext" PONTO "r" 90 "j" "TL" "w" "0" (strcat "X=" TXCORDX "\\P" "Y=" TXCORDY "\\P" "Z=" TXCORDZ) "")

amc.dicsac Gracias por responder a la consulta, reemplace
en el código y me sale :
Opción no válida.
; error: se ha producido un error dentro de la función *error*Función cancelada
seguiremos intentando modificando tarde o temprano lo lograremos con la ayuda de los maestros del Foro.
Un Saludo
Luis

Luis Alberto Benitez escribió:amc.dicsac Gracias por responder a la consulta, reemplace
en el código y me sale :
Opción no válida.
; error: se ha producido un error dentro de la función *error*Función cancelada
seguiremos intentando modificando tarde o temprano lo lograremos con la ayuda de los maestros del Foro.
Un Saludo
Luis

ok, Yo lo eh resuelto a mi manera espero te sirva

Código:

(defun c:CPT1 (/ *error* var ObjSelect n TEMPS CORDX CORDY CORDZ TXCORDX TXCORDY TXCORDZ PONTO)
    (defun *error* ( msg )
        (mapcar 'setvar var val) ;; restablecemos las variables cuando tecleamos "esc"
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
        (princ (strcat "\nError: " msg)))
        (princ)
    )

 (vl-cmdf "_UCS" "u")
 (setq var '(cmdecho osmode dimzin)
      val (mapcar 'getvar var)
 )
 (mapcar 'setvar var '(0 0 0)) ;; aqui modificamos las variables segun nuestra necesidad
 (setq ObjSelect (LM:ssget "\n>> Selecciona los puntos <exit>: " '(((0 . "Point")))))
 (setq *cant_decimal* (cond ((getint (strcat "\nIngresa cantida de decimales <" (itoa (setq *cant_decimal* (cond ( *cant_decimal* ) ( 4 )))) ">: "))) ( *cant_decimal* )))
 (setq *alt_text* (cond ((getdist (strcat "\nIngresa altura del texto <" (rtos (setq *alt_text* (cond ( *alt_text* ) ( 0.10 ))) 2 2) ">: "))) ( *alt_text* )))
 (setq n (sslength ObjSelect))
 (while (> n 0)
 (setq TEMPS (ssname ObjSelect (setq n (1- n))))
 (setq CORDX (nth 1 (assoc 10 (entget TEMPS))))
 (setq CORDY (nth 2 (assoc 10 (entget TEMPS))))
 (setq CORDZ (nth 3 (assoc 10 (entget TEMPS))))
 (setq TXCORDX (rtos CORDX 2 *cant_decimal*))
 (setq TXCORDY (rtos CORDY 2 *cant_decimal*))
 (setq TXCORDZ (rtos CORDZ 2 *cant_decimal*))
 (setq PONTO (list CORDX CORDY 0.0))
 (2ap_Draw_MText (strcat "X=" TXCORDX "\\P" "Y=" TXCORDY "\\P" "Z=" TXCORDZ) *alt_text* "90"))
 (mapcar 'setvar var val) ;; aqui restablecemos las variablesa
 (princ))

;;-----------------------------------------------------;;
;; Creador de Ntext ---> AX:ProgramLisp                ;;
;; (2ap_Draw_Style "Hola" 0.1 "90")    ;;
;;-----------------------------------------------------;;
(defun 2ap_Draw_MText (s h r)
  (entmakex
      (list (cons 0  "MTEXT")       
            (cons 100 "AcDbEntity")       
            (cons 100 "AcDbMText") 
            (cons 10 PONTO)
            (cons 11 PONTO)
            (cons 71 1)
            (cons 40 h) ;; altura
            (cons  1 s) ;; contenido
       (cons 50 (angtof r)) ;;rotación
      )
  )
)


    ;; ssget  -  Lee Mac
    ;; A wrapper for the ssget function to permit the use of a custom selection prompt
    ;; msg - [str] selection prompt
    ;; arg - [lst] list of ssget arguments
   
    (defun LM:ssget ( msg arg / sel )
        (princ msg)
        (setvar 'nomutt 1)
        (setq sel (vl-catch-all-apply 'ssget arg))
        (setvar 'nomutt 0)
        (if (not (vl-catch-all-error-p sel)) sel)
    )

amc.dicsac el lisp funciona bien
Aquí encontré otro lisp que funciona picando
de a uno

Código:

;;;    rutina "rotula_x_y_z" rotula coordenada x y z
;;;    de un punto indicado reiterablemente
 (princ "\n\t\t****comando rotula_x_y_z por PREXEM....****\n")
(defun c:rotula_x_y_z ( /
         cmdant
         osmant
         pto
         pttext
         rot_z
         )
(setq cmdant (getvar "cmdecho"))
  (setvar "cmdecho" 0)
(setq osmant (getvar "osmode"))
(setvar "osmode" 8);Referencia Punto
(while
  (setq pto
       (getpoint
"\nseleccione un punto para obtener coordenadas  o ENTER para terminar: "
    )
      );setq
(setvar "osmode" osmant)
  (progn
        (setq pttext   (getpoint pto
          "\npunto para insertar rotulo de coordenadas: "
          )
   );setq



         (setq rot_x (rtos (CAR pto)2 4))
         (setq rot_y (rtos (CADR pto)2 4))
         (setq rot_z (rtos (CADDR pto)2 4))

         (setq px (CAR pttext))
         (setq py (CADR pttext))
         (setq pz (CADDR pttext))
 
      (vl-cmdf "_.text" "_j" "D" (LIST px py pz) "1" "90" rot_z)
      (vl-cmdf "_.text" "_j" "D" (LIST px (- py 7.5) pz) "1" "90" rot_y)
      (vl-cmdf "_.text" "_j" "D" (LIST px (- py 16.0) pz) "1" "90" rot_x)
     ;(strcat (rtos dist 2 2)"m"))
 
    (setvar "osmode" 8);Referencia Punto  
  );progn
);while
  (setvar "osmode" osmant)
 (setvar "cmdecho" cmdant)
(princ)
); fin rotula X Y Z


lo ideal seria fusionar con el lisp CPT1
de todas maneras se logro un avance importante.
Un Saludo
Luis

Luis Alberto Benitez escribió:amc.dicsac el lisp funciona bien
Aquí encontré otro lisp que funciona picando
de a uno

Código:

;;;    rutina "rotula_x_y_z" rotula coordenada x y z
;;;    de un punto indicado reiterablemente
 (princ "\n\t\t****comando rotula_x_y_z por PREXEM....****\n")
(defun c:rotula_x_y_z ( /
         cmdant
         osmant
         pto
         pttext
         rot_z
         )
(setq cmdant (getvar "cmdecho"))
  (setvar "cmdecho" 0)
(setq osmant (getvar "osmode"))
(setvar "osmode" 8);Referencia Punto
(while
  (setq pto
       (getpoint
"\nseleccione un punto para obtener coordenadas  o ENTER para terminar: "
    )
      );setq
(setvar "osmode" osmant)
  (progn
        (setq pttext   (getpoint pto
          "\npunto para insertar rotulo de coordenadas: "
          )
   );setq



         (setq rot_x (rtos (CAR pto)2 4))
         (setq rot_y (rtos (CADR pto)2 4))
         (setq rot_z (rtos (CADDR pto)2 4))

         (setq px (CAR pttext))
         (setq py (CADR pttext))
         (setq pz (CADDR pttext))
 
      (vl-cmdf "_.text" "_j" "D" (LIST px py pz) "1" "90" rot_z)
      (vl-cmdf "_.text" "_j" "D" (LIST px (- py 7.5) pz) "1" "90" rot_y)
      (vl-cmdf "_.text" "_j" "D" (LIST px (- py 16.0) pz) "1" "90" rot_x)
     ;(strcat (rtos dist 2 2)"m"))
 
    (setvar "osmode" 8);Referencia Punto  
  );progn
);while
  (setvar "osmode" osmant)
 (setvar "cmdecho" cmdant)
(princ)
); fin rotula X Y Z


lo ideal seria fusionar con el lisp CPT1
de todas maneras se logro un avance importante.
Un Saludo
Luis

Te adjuntos dos lisp, ambos tienes las mismas opciones solamente que el segundo lisp te mueve el texto al lugar que deseas, a diferencia del primero que lo inserta en el lugar que tu picas en pantalla, espero te sea util saludos.

El primer lisp CPT1

Código:

(defun c:CPT1 (/ *error* var pt1 ptx pty ptz ObjSelect n TEMPS CORDX CORDY CORDZ TXCORDX TXCORDY TXCORDZ PONTO)
    (defun *error* ( msg )
        (mapcar 'setvar var val) ;; restablecemos las variables cuando tecleamos "esc"
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
        (princ (strcat "\nError: " msg)))
        (princ)
    )
 (setq var '(cmdecho osmode dimzin)
      val (mapcar 'getvar var)
 )
 (mapcar 'setvar var '(0 0 0)) ;; aqui modificamos las variables segun nuestra necesidad
 (setq *cant_decimal* (cond ((getint (strcat "\nIngresa cantida de decimales <" (itoa (setq *cant_decimal* (cond ( *cant_decimal* ) ( 4 )))) ">: "))) ( *cant_decimal* )))
 (setq *alt_text* (cond ((getdist (strcat "\nIngresa altura del texto <" (rtos (setq *alt_text* (cond ( *alt_text* ) ( 0.10 ))) 2 2) ">: "))) ( *alt_text* )))
 (setq pt1 T)
 (while pt1
 (initget "Selecciona")
 (setq pt1 (getpoint "\nIndica los puntos ó [Selecciona]: ")) 
 (cond
  ( (vl-consp pt1)
    (setq ptx (rtos (car pt1) 2 *cant_decimal*))
    (setq pty (rtos (cadr pt1) 2 *cant_decimal*))
    (setq ptz (rtos (caddr pt1) 2 *cant_decimal*))
    (2ap_Draw_MText pt1 (strcat "X=" ptx "\\P" "Y=" pty "\\P" "Z=" ptz) *alt_text* "90")
  )
 ( (eq 'STR (type pt1))
 (setq ObjSelect (LM:ssget "\n>> Selecciona los puntos <exit>: " '(((0 . "Point")))))
 (setq n (sslength ObjSelect))
 (while (> n 0)
 (setq TEMPS (ssname ObjSelect (setq n (1- n))))
 (setq CORDX (nth 1 (assoc 10 (entget TEMPS))))
 (setq CORDY (nth 2 (assoc 10 (entget TEMPS))))
 (setq CORDZ (nth 3 (assoc 10 (entget TEMPS))))
 (setq TXCORDX (rtos CORDX 2 *cant_decimal*))
 (setq TXCORDY (rtos CORDY 2 *cant_decimal*))
 (setq TXCORDZ (rtos CORDZ 2 *cant_decimal*))
 (setq PONTO (list CORDX CORDY 0.0))
 (2ap_Draw_MText PONTO (strcat "X=" TXCORDX "\\P" "Y=" TXCORDY "\\P" "Z=" TXCORDZ) *alt_text* "90"))
 (mapcar 'setvar var val) ;; aqui restablecemos las variablesa
  )
  )
    )
 (princ))

;;-----------------------------------------------------;;
;; Creador de Ntext ---> AX:ProgramLisp                ;;
;; (2ap_Draw_Style "Hola" 0.1 "90")    ;;
;;-----------------------------------------------------;;
(defun 2ap_Draw_MText (pt s h r)
  (entmakex
      (list (cons 0  "MTEXT")       
            (cons 100 "AcDbEntity")       
            (cons 100 "AcDbMText") 
            (cons 10 pt)
            (cons 11 pt)
            (cons 71 1)
            (cons 40 h) ;; altura
            (cons  1 s) ;; contenido
       (cons 50 (angtof r)) ;;rotación
      )
  )
)


    ;; ssget  -  Lee Mac
    ;; A wrapper for the ssget function to permit the use of a custom selection prompt
    ;; msg - [str] selection prompt
    ;; arg - [lst] list of ssget arguments
   
    (defun LM:ssget ( msg arg / sel )
        (princ msg)
        (setvar 'nomutt 1)
        (setq sel (vl-catch-all-apply 'ssget arg))
        (setvar 'nomutt 0)
        (if (not (vl-catch-all-error-p sel)) sel)
    )

El segundo lisp CPT2

Código:

(defun c:CPT2 (/ *error* var pt1 pt2 ptx pty ptz ObjSelect n TEMPS CORDX CORDY CORDZ TXCORDX TXCORDY TXCORDZ PONTO)
    (defun *error* ( msg )
        (mapcar 'setvar var val) ;; restablecemos las variables cuando tecleamos "esc"
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
        (princ (strcat "\nError: " msg)))
        (princ)
    )
 (setq var '(cmdecho osmode dimzin)
      val (mapcar 'getvar var)
 )
 (setq *cant_decimal* (cond ((getint (strcat "\nIngresa cantida de decimales <" (itoa (setq *cant_decimal* (cond ( *cant_decimal* ) ( 4 )))) ">: "))) ( *cant_decimal* )))
 (setq *alt_text* (cond ((getdist (strcat "\nIngresa altura del texto <" (rtos (setq *alt_text* (cond ( *alt_text* ) ( 0.10 ))) 2 2) ">: "))) ( *alt_text* )))
 (setq pt1 T)
 (while pt1
 (initget "Selecciona")
 (mapcar 'setvar var '(0 513 0)) ;; aqui modificamos las variables segun nuestra necesidad
 (setq pt1 (getpoint "\n>> Indica punto en pantalla ó [Selecciona]: ")) 
 (cond
  ( (vl-consp pt1)
    (initget 32)
    (setq pt2 (getpoint pt1 "\n>> Indica ubicación de texto: "))
    (setq ptx (rtos (car pt1) 2 *cant_decimal*))
    (setq pty (rtos (cadr pt1) 2 *cant_decimal*))
    (setq ptz (rtos (caddr pt1) 2 *cant_decimal*))
    (2ap_Draw_MText pt2 (strcat "X=" ptx "\\P" "Y=" pty "\\P" "Z=" ptz) *alt_text* "90")
  )
 ( (eq 'STR (type pt1))
 (setq ObjSelect (LM:ssget "\nSelecciona los puntos <exit>: " '(((0 . "Point")))))
 (mapcar 'setvar var '(0 0 0)) ;; aqui modificamos las variables segun nuestra necesidad
 (setq n (sslength ObjSelect))
 (while (> n 0)
 (setq TEMPS (ssname ObjSelect (setq n (1- n))))
 (setq CORDX (nth 1 (assoc 10 (entget TEMPS))))
 (setq CORDY (nth 2 (assoc 10 (entget TEMPS))))
 (setq CORDZ (nth 3 (assoc 10 (entget TEMPS))))
 (setq TXCORDX (rtos CORDX 2 *cant_decimal*))
 (setq TXCORDY (rtos CORDY 2 *cant_decimal*))
 (setq TXCORDZ (rtos CORDZ 2 *cant_decimal*))
 (setq PONTO (list CORDX CORDY 0.0))
 (2ap_Draw_MText PONTO (strcat "X=" TXCORDX "\\P" "Y=" TXCORDY "\\P" "Z=" TXCORDZ) *alt_text* "90"))
 (mapcar 'setvar var val) ;; aqui restablecemos las variablesa
  )
  )
    )
 (princ))

;;-----------------------------------------------------;;
;; Creador de Ntext ---> AX:ProgramLisp                ;;
;; (2ap_Draw_Style "Hola" 0.1 "90")    ;;
;;-----------------------------------------------------;;
(defun 2ap_Draw_MText (pt s h r)
  (entmakex
      (list (cons 0  "MTEXT")       
            (cons 100 "AcDbEntity")       
            (cons 100 "AcDbMText") 
            (cons 10 pt)
            (cons 11 pt)
            (cons 71 1)
            (cons 40 h) ;; altura
            (cons  1 s) ;; contenido
       (cons 50 (angtof r)) ;;rotación
      )
  )
)


    ;; ssget  -  Lee Mac
    ;; A wrapper for the ssget function to permit the use of a custom selection prompt
    ;; msg - [str] selection prompt
    ;; arg - [lst] list of ssget arguments
   
    (defun LM:ssget ( msg arg / sel )
        (princ msg)
        (setvar 'nomutt 1)
        (setq sel (vl-catch-all-apply 'ssget arg))
        (setvar 'nomutt 0)
        (if (not (vl-catch-all-error-p sel)) sel)
    )

Bueno aqui teneis otra forma de acotar puntos masivamente

Código:

 ; Modulo para acotación por coordenadas en X ó Y todos los puntos elegidos.
 ; Luis Dominguez Gómez  © 2005
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun entorno  ()
 (if (not (tblobjname "LAYER" "COTAS_LDG"))
  (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(2 . "COTAS_LDG") '(70 . 0)
                '(62 . 2) '(6 . "CONTINUOUS"))))
 (if (not (tblobjname "STYLE" "LDG"))
  (entmake (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") '(2 . "LDG") '(70 . 0)
                '(40 . 0.0) '(41 . 1.0) '(50 . 0.0) '(71 . 0) '(3 . "romans.shx")))))
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun get_oldvar  ()
 (setq lay (getvar 'clayer))
 (setq sty (getvar 'dimtxsty))
 (setq txt (getvar 'dimtxt))
 (setq lrd (getvar 'dimclrd))
 (setq lre (getvar 'dimclre))
 (setq lrt (getvar 'dimclrt))
 (setq gap (getvar 'dimgap))
 (setq ucs (getvar 'ucsicon))
 (setq se1 (getvar 'dimse1))
 (setq se2 (getvar 'dimse2))
 (setq osm (getvar 'osmode)))
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun set_okvar  ()
 (mapcar 'setvar
        (list 'clayer 'dimtxsty 'dimtxt 'dimclrd 'dimclre 'dimclrt 'dimlfac 'dimdsep 'ucsicon 'dimse1 'dimse2 'osmode
              'dimgap 'dimdec)
        (list "cotas_ldg" "ldg" (getvar 'dimtxt) 256 256 256 1.0 "." 3 0 0 0 (/ (getvar 'dimtxt) 4.0) 3)))
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun set_oldvar  ()
 (mapcar 'setvar
        (list 'clayer 'dimtxsty 'dimtxt 'dimclrd 'dimclre 'dimclrt 'dimgap 'ucsicon 'dimse1 'dimse2 'osmode 'dimtmove)
        (list lay sty txt lrd lre lrt gap ucs se1 se2 osm 0)))
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun c:dtdim_punt  (/ conj cant n pins p2x p2y lay sty txt lrd lre lrt gap ucs se1 se2 osm)
 (setvar "cmdecho" 0)
 (entorno)
 (get_oldvar)
 (set_okvar)
 (prompt "\nPunto 0: < origen >")
 (vl-cmdf "_ucs" "_move" "\\")
 (prompt "\nDesignar puntos para acotar: ")
 (setvar "nomutt" 1)
 (setq conj (ssget (list (cons 0 "point"))))
 (setvar "nomutt" 0)
 (setq cant (sslength conj))
 (setq n 0)
 (repeat cant
  (ssname conj n)
  (setq pins (cdr (assoc 10 (entget (ssname conj n)))))
  (setq pins (trans pins 0 1))
  (setq p2x (list (car pins) (+ (cadr pins) (getvar 'dimtxt))))
  (setq p2y (list (+ (car pins) (getvar 'dimtxt)) (cadr pins)))
  (vl-cmdf "_dimordinate" pins p2x)
  (vl-cmdf "_dimordinate" pins p2y)
  (setq n (1+ n)))
 (set_oldvar)
 (prin1))
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo

Un saludo

amc.dicsac y al Maestro Dominguez gracias por los aportes al
Tema.
Un Saludo
Luis

Tratando de mejorar el lisp e incorporado
para que coloque seleccionando todos los puntos de una
el texto pero en un solo texto lo que no puedo es
que enlace los tres textos por separado de los valores de X Y Z

Código:

(defun C:CPT1 (/ AOSMD ADECH ADZIN VALLPRC UNPRC
 TEXTST ENTST STHIGT TEXTSZ TEMPS CORDX
 CORDY CORDZ TXCORDZ PONTO
 )


 ;(command "_.undo" "begin")

(vl-cmdf "_UCS""u")

 (command "_.undo" "inicio")
 (setq AERR *error*)
 (setq AOSMD (getvar "osmode")
 ADECH (getvar "cmdecho")
 ADZIN (getvar "dimzin")
 )
 (setvar "cmdecho" 0)
 (setvar "dimzin" 0)
 (setq VALLPRC (getvar "luprec"))

 (princ "\n»» Seleccionar puntos:\n")
 (setq SSET (ssget '((0 . "POINT"))))
 (setvar "osmode" 0)
 (if SSET
 (progn
 (terpri)
 (princ "\n»» ¿A cuántos lugares decimales? (0/8) ")
 (princ "<")
 (princ VALLPRC)
 (princ ">")
 (setq UNPRC (getint))
 (if (= UNPRC nil)
 (setq UNPRC VALLPRC)
 )
 (setq TEXTST (getvar "TEXTSTYLE"))
 (setq ENTST (tblsearch "style" TEXTST))
 (setq STHIGT (cdr (assoc 40 ENTST)))
 (PRINC STHIGT)
 (setq OSM (getvar "osmode"))
 (if (= STHIGT 0.0)
 (progn
 (princ "\n»» ¿Cuál es la altura del texto? ")
 (setq TEXTSZ (getdist))
 )
 )

 (setq SSLEN (sslength SSET))
 (while (> SSLEN 0)
 (setq TEMPS (ssname SSET (setq SSLEN (1- SSLEN))))
 (setq CORDX (nth 1 (assoc 10 (entget TEMPS))))
 (setq CORDY (nth 2 (assoc 10 (entget TEMPS))))
 (setq CORDZ (nth 3 (assoc 10 (entget TEMPS))))
 (setq TXCORDX (rtos CORDX 2 UNPRC))
 (setq TXCORDY (rtos CORDY 2 UNPRC))
 (setq TXCORDZ (rtos CORDZ 2 UNPRC))

 (setq PONTO (list CORDX CORDY 0.0))
 (if (> STHIGT 0.0)
 (command "_text" PONTO 90 TXCORDZ)
 (command "_Text" PONTO TEXTSZ 90 (strcat TXCORDX "   " TXCORDX "   " TXCORDZ))

 )
 )
 )
 (princ "\n»» Ningún Punto Seleccionado!")
 )
 (setvar "osmode" AOSMD)
 (setvar "dimzin" ADZIN)
 (command "_.undo" "fin")
)

;;;
;;;
;;;

(defun *error* (msg)

 (setq *error* AERR)
 (setvar "cmdecho" ADECH)
 (setvar "osmode" AOSMD)
 (setvar "dimzin" ADZIN)
 (command "_.undo" "fin")
 (princ (strcat "»» Parada de la aplicación con el error: " msg))
)

(terpri)
(princ "\n»» Comience a escribir la aplicación CPT1 \n")

;;; Final Conv_Puntos_Texto.lsp

Un saludo
Luis

Al fin se pudo lograr una solución al tema e aquí el lisp:

Código:

;;; Conv_Puntos_Texto.lsp - Aplicación para convertir la coordenada x y Z de puntos (topográficos) en los textos


(defun C:CPT1 (/ AOSMD ADECH ADZIN VALLPRC UNPRC
 TEXTST ENTST STHIGT TEXTSZ TEMPS CORDX
 CORDY CORDZ TXCORDZ PONTO
 )


 ;(command "_.undo" "begin")

(vl-cmdf "_UCS""u")

 (command "_.undo" "inicio")
 (setq AERR *error*)
 (setq AOSMD (getvar "osmode")
 ADECH (getvar "cmdecho")
 ADZIN (getvar "dimzin")
 )
 (setvar "cmdecho" 0)
 (setvar "dimzin" 0)
 (setq VALLPRC (getvar "luprec"))

 (princ "\n»» Seleccionar puntos:\n")
 (setq SSET (ssget '((0 . "POINT"))))
 (setvar "osmode" 0)
 (if SSET
 (progn
 (terpri)
 (princ "\n»» ¿A cuántos lugares decimales? (0/8) ")
 (princ "<")
 (princ VALLPRC)
 (princ ">")
 (setq UNPRC (getint))
 (if (= UNPRC nil)
 (setq UNPRC VALLPRC)
 )
 (setq TEXTST (getvar "TEXTSTYLE"))
 (setq ENTST (tblsearch "style" TEXTST))
 (setq STHIGT (cdr (assoc 40 ENTST)))
 (PRINC STHIGT)
 (setq OSM (getvar "osmode"))
 (if (= STHIGT 0.0)
 (progn
 (princ "\n»» ¿Cuál es la altura del texto? ")
 (setq TEXTSZ (getdist))
 )
 )

 (setq SSLEN (sslength SSET))
 (while (> SSLEN 0)
 (setq TEMPS (ssname SSET (setq SSLEN (1- SSLEN))))
 (setq CORDX (nth 1 (assoc 10 (entget TEMPS))))
 (setq CORDY (nth 2 (assoc 10 (entget TEMPS))))
 (setq CORDZ (nth 3 (assoc 10 (entget TEMPS))))
 (setq TXCORDX (rtos CORDX 2 UNPRC))
 (setq TXCORDY (rtos CORDY 2 UNPRC))
 (setq TXCORDZ (rtos CORDZ 2 UNPRC))
 (setq PONTO (list CORDX CORDY 0.0))
 (if (> STHIGT 0.0)
(command "_text" PONTO 90 TXCORDZ)
 (command "_text" PONTO TEXTSZ 90 TXCORDX "_text" (list CORDX (+ CORDY 20) 0.0) TEXTSZ 90 TXCORDY "_text" (list CORDX (+ CORDY 40) 0.0) TEXTSZ 90 TXCORDZ)
 )
 )
 )
 (princ "\n»» Ningún Punto Seleccionado!")
 )
 (setvar "osmode" AOSMD)
 (setvar "dimzin" ADZIN)
 (command "_.undo" "fin")
)

;;;
;;;
;;;

(defun *error* (msg)

 (setq *error* AERR)
 (setvar "cmdecho" ADECH)
 (setvar "osmode" AOSMD)
 (setvar "dimzin" ADZIN)
 (command "_.undo" "fin")
 (princ (strcat "»» Parada de la aplicación con el error: " msg))
)

(terpri)
(princ "\n»» Comience a escribir la aplicación CPT1 \n")

;;; Final Conv_Puntos_Texto.lsp

Gracias a los colegas del Foro.
Un Saludo
Luis

Como siempre se presenta un nuevo desafío se trata de que el lisp
funcione cuando tengo un SCP ya que solo funciona cuando tengo
SCU "_UCS" desde ya gracias por los continuos aportes.
Un Saludo
Luis

Como siempre , no has puesto un ejemplo en CAD dwg , luego no se puede dar la solución adecuada a tu pedido.
Esto lo vengo repitiendo desde que participo en los Foros

Para mayor ilustración , se decir.

SIN FINADO, NO HAY ATAUD

Saludos