Colocar Distancia Acumulada en Polilinea

Estimados Integrantes del Foro encontré un lisp para colocar en una polilinea las distancias acumuladas
pero usando el puntero, la modificación con ayuda de Uds. es colocar en forma automática la distancia acumulada en los vértices
de la polilinea desde ya gracias.
Un Saludo

Código:

;; _  _  _                              _  
;; | || |(_) ___ _ __  __ _  __  __ _  __| |
;; | __ || |(_-<| '_ \/ _` |/ _|/ _` |/ _` |
;; |_||_||_|/__/| .__/\__,_|\__|\__,_|\__,_|
;;              |_|                          
;;    www.Hispacad.com                      
;;; OPR9.LSP V.2
 ; Cargar las funciones ActiveX (Visual Lisp)
(vl-load-com)
;;---------------------------- Num2StrPK -------------------------
 ; Coloca Linea Perpendicular al Eje
 ; se Puede Variar la Distancias y Altura del Texto
 ; Eliasp :copyright: 2016
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
;; Jose L. García G. - Hispacad.com                              
;;----------------------------------------------------------------
(DEFUN NUM2STRPK (NUM ADDPK / NUM$ RETVAL DECIMAL)
 (setq decimal (- num (fix num)))
 (if
  (> decimal 0.5)
  (setq num (1+ num))
  (setq num num)
 )
 (setq num$ (rtos num 2 dec));    Cantidad de Decimales
 (SETQ RETVAL NUM$)
)
;;------------------------ ObjPt2VectTan -----------------------------
;;Obtiene el segmento tangente a un objeto mediante un punto.        
;;Jose L. García G. - Hispacad.com                                    
(defun ObjPt2VectTan (vobj pnt / param p1 p2 deriv1)
 (setq p1    (vlax-curve-getClosestPointTo vobj (trans pnt 1 0)) ;punto en curva
      param  (vlax-curve-getParamAtPoint vobj p1)
      deriv1 (vlax-curve-getFirstDeriv vobj param) ;vector de direccion No point
      p2    (mapcar '+ p1 deriv1)
 )
 (if (and p1 p2)
  (list p1 p2)
 )
)
;;______________________________________________________________________
(defun PtPerpToVec (ptCheck p1 p2 / tr)
 (setq tr      (mapcar '- p2 p1)
      p1      (trans p1 0 tr)
      ptCheck (trans ptCheck 0 tr)
 )
 (trans (list (car p1) (cadr p1) (caddr ptCheck)) tr 0)
)
;;----------------------- grdx -------------------------------------
 ; X en pantalla
;;Jose L. García G. - Hispacad.com
(defun grdx (p col size / h)
 (setq h (/ (getvar "viewsize") size))
 (grdraw (list (- (car p) h) (- (cadr p) h))
        (list (+ (car p) h) (+ (cadr p) h))
        col
        0
 )
 (grdraw (list (- (car p) h) (+ (cadr p) h))
        (list (+ (car p) h) (- (cadr p) h))
        col
        0
 )
)
;;======================================== C:OPR9 ==============================================
;; Localizar y marcar prograsivas en Curva (polilinea, spline,...)                              
;; Jose L. García G. - Hispacad.com  08/02/2013                                                
(defun C:OPR9 (/ ChangeInic oCurve Tmp Punprog LongInEje len hlen DatTangent PtPick AngPerp PtAux PtSel oText NewPt PtTxt
              $CenterTxt$ $HTxt$ $FijarDist$ $DrawLine$ $DrawLineEje$ $ColTxt$ $ColLineRef$ $ColLineEje$ OPR9:Draw_Txt
              OPR9:Draw_Line *error* grd> OPR9:MoveText
              )
 ;;__________________________________________________________
 ;;funcion de ERROR Interna
 (defun *error* (msg)
  (print (strcat "OPR9 Error: " msg))
 )
 ;;--------------------- OPR9:Draw_Txt -------------------------
 ;; dibuja sTexto                                              
 ;;------------------------------------------------------------
 (defun OPR9:Draw_Txt (p al ang cad codh codv col)
  (entmakex (list '(0 . "TEXT")
                  (cons 62 col)
                  (cons 40 al) ;  Altura de Texto
                  (cons 1 cad)
                  (cons 50 ang)
                  '(41 . 1.0) ;    Ancho de Texto
                  (cons 72 codh)
                  (cons 10 p)
                  (cons 11 p)
                  (cons 73 codv)
            )
  )
 )
 ;;--------------------- OPR9:Draw_Line ----------------------
 ;; dibuja linea                                              
 (defun OPR9:Draw_Line (p1 p2 col /)
  (entmake (list '(0 . "LINE") (cons 62 col) (cons 10 p1) (cons 11 p2)))
 )
 ;;----------------------- grd> -------------------------------------
 ; > en pantalla                                                    
 ;;Jose L. García G. - Hispacad.com                                  
 ;;------------------------------------------------------------------
 (defun grd> (oCurve p col size Invert / Aux DatTangent h p1 p2)
  (setq DatTangent (ObjPt2VectTan oCurve p))
  (setq p  (car DatTangent)
        Ang (apply 'angle DatTangent)
  )
  (setq Aux (if Invert
            0
            pi
            )
  )
  (setq h (/ (getvar "viewsize") size))
  (setq p1 (polar p (+ (- ang Aux) (/ pi 9)) h)
        p2 (polar p (- (- ang Aux) (/ pi 9)) h)
  )
  (grdraw (trans p 0 1) (trans p1 0 1) col 0)
  (grdraw (trans p 0 1) (trans p2 0 1) col 0)
 )
 ;;--------------------------- OPR9:MoveText -----------------------------------------
 ;;Mover el Texto Elasticamente en pantalla                                        
 ;;----------------------------------------------------------------------------------
 (defun OPR9:MoveText (;|oText oCurve PtPick AngPerp|; / PtOld flag gr1 gr2 xa)
  (setq PtOld PtPick
        NewPt nil
  )
  (while
  (progn (setq gr  (grread t 15 0)
                gr1 (car gr)
                gr2 (cadr gr)
          )
          (cond
          ;; 5 tracking point  ;; 3 "pick" button?
          ((member gr1 '(5 3))
            ;;Punto
            (cond
            (NewPt
              (princ (strcat "\r>>Distancia:["
                            (rtos (if (> $FijarDist$ 0)
                                    $FijarDist$
                                    (distance PtPick NewPt)
                                  )
                                  2
                            )
                            "]; Indique lado: "
                    )
              )

              ;;Borra la linea elástica anterior
              (grdraw (trans PtPick 0 1) (trans NewPt 0 1) -1 -1)
              (setq PtOld NewPt)
            )
            )
            (setq PtAux (polar PtPick AngPerp 1.0))
            (setq NewPt (PtPerpToVec (trans gr2 1 0) PtPick PtAux))
            (if (> $FijarDist$ 0)
            (setq NewPt (polar PtPick (angle PtPick NewPt) $FijarDist$))
            )
            (grdraw (trans PtPick 0 1) (trans NewPt 0 1) -1 -1)
            (vla-put-Rotation oText (angle PtPick NewPt))
            (if (and $DrawLineRef$ (not $CenterTxt$))
            (vla-put-Alignment oText acAlignmentBottomRight)
            (vla-put-Alignment oText acAlignmentMiddleLeft)
            ;; acAlignmentBottomLeft acAlignmentBottomCenter acAlignmentBottomRight
            )
            (vla-move oText (vlax-3D-point PtOld) (vlax-3D-point NewPt))
            (null (setq flag (= gr1 3)))
          )
          ((= 25 gr1)
            nil
          )
          ((= 02 gr1)
            (cond
            ((member gr2 '(13 32))
              nil
            )
            )
          )
          )
  )
  )
  flag
 )
 ;;---------------------------- MAIN ----------------------------------------
 ;;OPCIONES:                              
 ;;Fijar una distancia para el texto:      
 ;; [< 0  = Mover Elástico]                
 ;; [> 0  = indicar solo de lado Curva]    
 ;; [= 0 no mover] fijar en punto indicado
 ;(setq $FijarDist$ -1);Original
  (setq $FijarDist$ -10)
;; Color de Texto y Linea
 (setvar "CMDECHO" 0)
 (command "orto" "DES")
 (SETVAR "OSMODE" 0)
 (SETVAR "OSMODE" 512) ;Referencia a Objetos Cercano
 (setq $ColTxt$ 6)
 (setq $CenterTxt$ nil)
 (setq $DrawLineRef$ t)
 ;(setq $ColLineRef$ 4);                 Linea de Referencia Color 4 (Cian)
 (setq $DrawLineEje$ T)
 (setq $LenLineEje$ 3.0)
 (setq $ColLineEje$ 2)
 (if (not *ProgDef*)
  (setq *ProgDef* 0.0)
 )

 (setq ChangeInic "No")
 (cond
  ((not (setq oCurve (entsel "\nSeleccione Eje: ")))
  (prompt "\nNo ha seleccionado Eje: (polilinea, línea, spline,..)")
  )
  (T
  (setq PtSel  (cadr oCurve)
        oCurve (car oCurve)
  )
  (grd> oCurve PtSel 1 25 nil)
  (initget "Si No")
  (if (setq Tmp (getkword "\nCambiar inicio del Eje [Si/No] <No>: "))
    (progn
    (setq ChangeInic Tmp)
    (redraw)
    (grd> oCurve PtSel 2 25 t)
    )
  )
  (initget 0)
  (if (setq Tmp (getreal (strcat "\nProgresiva inicial del Eje <" (rtos *ProgDef* 2) ">: ")))
    (setq *ProgDef* Tmp)
  )

(setq cmdact0 (getvar "cmdactive"))

(if (not linep_dec0) (setq linep_dec0 0))

(if (setq dec (getint (strcat "\nColocar Cuantos Decimales:   <" (rtos linep_dec0) ">: ")))
(setq linep_dec0 dec)
(setq dec linep_dec0)
)

 ;;Altura de Texto:
(setq cmdact0 (getvar "cmdactive"))
(if (not linep_alt0) (setq linep_alt0 0))
(if (setq alt (getint (strcat "\nColocar Altura del Texto:  <" (rtos linep_alt0) ">: ")))
(setq linep_alt0 alt)
(setq alt linep_alt0)
)
(command "TEXTSIZE" alt) ; Altura del Texto
(setq $HTxt$ (getvar "TEXTSIZE"))

(while
    (setq Punprog (getpoint "\nIndique el punto en Eje: "))
    (setq LongInEje (vlax-curve-getDistAtPoint oCurve
                                              (vlax-curve-getClosestPointTo oCurve (trans Punprog 1 0))
                    )
    )
    (if (= ChangeInic "No")
    (setq param (vlax-curve-GetStartParam oCurve))
    (setq param (vlax-curve-GetEndParam oCurve))
    )
    (setq len (vlax-curve-getDistAtParam oCurve param))
    (if (= ChangeInic "No")
    (setq hlen (+ len LongInEje))
    (setq hlen (- len LongInEje))
    )
    (cond
    ((not hlen)
      (prompt "\nError: No se pudieron obtener datos del punto indicado.")
    )
    ((setq DatTangent (ObjPt2VectTan oCurve Punprog))
      (vl-cmdf "_.undo" "_BE")
      (setq PtPick (car DatTangent))
      (setq AngPerp (apply (if (= ChangeInic "No")
                            '-
                            '+
                          )
                          (list (apply 'angle DatTangent) (/ pi 2))
                    )
      )
      (setq PtAux (polar PtPick AngPerp 1.0))
      (grdx (trans PtPick 0 1) 211 120)
      (setq sTexto (Num2StrPK (+ *ProgDef* hlen) nil))
      (cond
      ((zerop $FijarDist$)
        (setq NewPt PtPick)
        (setq oText (OPR9:Draw_Txt PtPick $HTxt$ (angle PtPick PtAux) sTexto 1 1 $ColTxt$))
      )
      (t
        (setq oText (OPR9:Draw_Txt PtPick $HTxt$ (angle PtPick PtAux) sTexto 0 2 $ColTxt$)
              oText (vlax-ename->vla-object oText)
        )
        (cond
        ((or (vl-catch-all-error-p (setq MoveText (vl-catch-all-apply (function OPR9:MoveText))))
              (not MoveText)
          )
          (vla-delete oText)
          (redraw)
        )
        )
      )
      )
      (cond
      ((and oText (not (vlax-erased-p oText)))
        (if $DrawLineEje$
        (OPR9:Draw_Line (polar PtPick AngPerp (/ $LenLineEje$ 2.0))
                        (polar PtPick (+ AngPerp pi) (/ $LenLineEje$ 2.0))
                        $ColLineEje$
        )
        )
        (cond
        ((and $DrawLineRef$
              (not (zerop $FijarDist$))
              (> (distance PtPick NewPt) $HTxt$)
          )
          (if $CenterTxt$
          (setq NewPt (polar NewPt (angle NewPt PtPick) (/ $HTxt$ 2.0)))
          )
          ;(OPR9:Draw_Line PtPick NewPt $ColLineRef$);         Linea de Referencia Color 4 (Cian)
        )
        )
        (redraw)
        (vl-cmdf "_.undo" "_E")
      )
      )
    )
    )
  )
  )
 )
 (princ)
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(princ "\n::Comando: \"OPR9\" para Ejecutar")
(princ)


Pregunto si hay algún lisp que convierta una polilinea 2d a 3d.
Gracias

Hola un saludo

Descargo el código para analizarlo y ver si te puedo ayudar, y digo "si te puedo ayudar" porque tengo algunos años que no le meto mano al AutoLISP y esto me ayudara a recordarlo y actualizarme con algunas funciones de VLA, VLAX que desconozco su funcionamiento.

Saludos

Gracias jcanizalesc por interiorizarte en el tema en realidad lo que tengo es el lisp
que coloque.
El otro lisp no lo tengo si lo tiene alguien bienvenido sea.
Un Saludo

Por nada Luis.

Con respecto a la pregunta, lo que quieres

es colocar en forma automática la distancia acumulada en los vértices de la polilinea

Hice escuetamente estas lineas de código para saber si ¿es esto lo que buscas, o capte mal la pregunta?.
funciona solo con polilineas livianas y sin arcos.

Saludos

Código:


(defun _texto_ (pto txt alt)
   (entmake
      (list
         (cons 0 "TEXT")
         (cons 10 pto)
         (cons 40 alt)
         (cons 1 txt)
         (cons 210 (list 0.0 0.0 1.0))
      );; list
   );; entmake
);; _texto_


(defun _polilinea_ (pol / lgo pto1 pto2 sub)
   (setq alt_txt(getdist "\nAltura de Texto: "))
   (setq lgo 0)
   (setq pto2 nil)
   (while pol
      (setq sub (car pol))
      (if (equal (car sub) 10)
         (progn
            (setq pto1 (list (cadr sub) (caddr sub)))
            (if (and pto2 (/= pto2 pto1))
               (setq lgo (+ lgo (distance pto1 pto2)))
            );; if
            (_texto_ pto1 (rtos lgo) alt_txt)
         );; progn
      );; if
      (setq pto2 pto1)
      (setq pol (cdr pol))
   );; while
);; _polilinea_


(defun c:sumlgopl (/ ent pol)
   (setq ent (car (entsel "\nSelecciona lwpolyline: ")))
   (setq pol (entget ent))
   (if (equal (cdr (assoc 0 pol)) "LWPOLYLINE")
      (_polilinea_ pol)
   );; if
);; c:sumlgopl


jcanizalesc Muy bueno el lisp funciona para para colocar la distancia
en los vértices de la polilinea para seguir mejorando el mismo se podría colocar una distancia de inicio.
Gracias por el Aporte.
Saludos

También agregar la opción de cantidad de Decimales.

jcanizalesc Aquí modifique para lograr el propósito.
Faltaría Completar con los datos de la Rotación y oblicuidad del texto.
Espero sea de utilidad.
Un Saludo

Código:

;Coloca las Distancias acumuladas en una polilinea 2d
;Autor:jcanizalesc

(defun _texto_ (pto txt alt)
   (entmake
      (list
         (cons 0 "TEXT")
         (cons 10 pto)           ;; Punto donde Insertar Texto
         (cons 11 pto)
         (cons 40 alt)           ;; altura de texto
         (cons 72 1)             ;; justuficacion de texto en Vertical
         (cons 73 2)             ;; justuficacion de texto en horizontal
         (cons 41 0.8)           ;; ancho de texto
         (cons 1 txt)            ;; contenido del texto
         (cons 50 0)             ;; Rotación del Texto
         (cons 51 0)             ;; oblicuidad del texto
        ;(cons  7 "1")           ;; estilo de texto
        ;(cons  8 "TEXTo")  ;; capa del texto
         (cons 210 (list 0.0 0.0 1.0))
      );; list
   );; entmake
);; _texto_
(defun _polilinea_ (pol / lgo pto1 pto2 sub)
(setq alt_txt(getdist "\nAltura de Texto: "))
(TERPRI)
(setq cmdact0 (getvar "cmdactive"))
(PRINC "\nColocar Inicio Prog. :")
(if (not linep_in0) (setq linep_in0 0))
(if (setq lgo (getreal (strcat "\nColocar Inicio Prog. :   <" (rtos linep_in0) ">: ")))
(setq linep_in0 lgo)
(setq lgo linep_in0)
)
(TERPRI)
(setq *cant_decimal* (cond ((getint (strcat "\nIngresa cantida de decimales <" (itoa (setq *cant_decimal* (cond ( *cant_decimal* ) ( 4 )))) ">: "))) ( *cant_decimal* )))
(setq pto2 nil)
   (while pol
      (setq sub (car pol))
      (if (equal (car sub) 10)
         (progn
            (setq pto1 (list (cadr sub) (caddr sub)))
            (if (and pto2 (/= pto2 pto1))
               (setq lgo (+ lgo (distance pto1 pto2)))
            );; if
            (_texto_ pto1 (rtos lgo 2 *cant_decimal*) alt_txt)
         );; progn
      );; if
      (setq pto2 pto1)
      (setq pol (cdr pol))
   );; while
);; _polilinea_
(defun c:sumlgopl (/ ent pol)
   (setq ent (car (entsel "\nSelecciona lwpolyline: ")))
   (setq pol (entget ent))
   (if (equal (cdr (assoc 0 pol)) "LWPOLYLINE")
      (_polilinea_ pol)
   );; if
);; c:sumlgopl
(princ)
(princ "\nLlamar con sumlgopl (Modif.Luis 03-07-2019)")





;;----------------------------------------------;;
;; Combinaciones para la justificaciones:    ;;
;; SIZ: (72 . 0)(73 . 3)                             ;;
;; SC: (72 . 1)(73 . 3)                              ;;
;; SD: (72 . 2)(73 . 3)                              ;;
;; MI: (72 . 0)(73 . 2)                              ;;
;; MC: (72 . 1)(73 . 2)                              ;;
;; MD: (72 . 2)(73 . 2)                             ;;
;; II: (72 . 0)(73 . 1)                               ;;
;; IC: (72 .1)(73 . 1)                                ;;
;; ID: (72 . 2)(73 . 1)                               ;;
;; IZQ: (72 . 0)(73 . 0)                             ;;
;; CEN: (72 . 1)(73 . 0)                             ;;
;; DER: (72 . 2)(73 . 0)                             ;;
;; aLinear: (72 . 3)(73 . 0)                         ;;
;; MED: (72 . 4)(73 . 0)                             ;;
;; aJustar: (72 . 5)(73 . 0)                         ;;
;;----------



Excelente!!!
que bueno que fue de utilidad este pequeño código.
esto de las distancias acumuladas en polilinea me recordó a una rutina que deje en el tintero hace algún tiempo y que expuse en el foro.
acá el enlace
TIMER (temporizador)

Saludos

jcanizalesc.Buen Aporte.Gracias.

Retomando el tema de colocar las distancias con polilineas livianas y sin arcos.
Estoy tratando de realizar con polilineas con arcos si alguien puede aportar al mismo, agradecido.
Un Saludo
Luis

Luis Alberto Benitez escribió:Retomando el tema de colocar las distancias con polilineas livianas y sin arcos.
Estoy tratando de realizar con polilineas con arcos si alguien puede aportar al mismo, agradecido.
Un Saludo
Luis

Hola colegas:
aqui dejo una rutina que seguro servira (rescatando codigo) para poner distancias en vertices de polis con tramos curvos.
Yo no tengo tiempo para dicha modificacion.
un saludo

Código:

 ; Acota todos los tramos de una polilinea, Abierta ó Cerrada (incluso los curvos).
 ; luis Dominguez Gomez :copyright: 2017
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
;; polilinea abierta.
(defun pln_open   (/ ang ent explst ptxt long mid pol)
 (if (equal (cdr (assoc 0 (setq ent (entget (car (entsel "\nSelecciona Polilinea2D: ")))))) "LWPOLYLINE")
  (setq ent (cdr (car ent)))
  (progn (prompt "\nNo es una polilinea 2D: ") (textpage) (exit))
 )
 (setq pol (vlax-ename->vla-object ent))
 (setq explst (vlax-invoke pol 'explode))
 (foreach # explst
  (setq mid (vlax-curve-getpointatdist # (/ (vlax-curve-getdistatparam # (vlax-curve-getendparam #)) 2.0)))
  (setq long (rtos (vlax-curve-getdistatpoint # (vlax-curve-getendpoint #)) 2 3))
  (setq ang (rem (angle (vlax-curve-getstartpoint #) (vlax-curve-getendpoint #)) pi))
  (if (> ang (/ pi 2.0))
  (setq ang (+ pi ang))
  )
  (setq ptxt (polar mid (+ ang (/ pi 2)) (* *altxt* 0.75)))
  (text)
  (vla-delete #)
 )
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun text nil
 (entmake (list   '(0 . "TEXT")
      (cons 1 long)
      '(7 . "TRAMOS")
      (cons 10 ptxt)
      (cons 11 ptxt)
      (cons 40 *altxt*)
      (cons 50 ang)
      '(72 . 1)
      '(73 . 2)
     )
 )
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
;; polilinea cerrada.
(defun pln_clos   (/ ang explst long mid pol poly pto ptxt)
 (setq pto (getpoint "\nIndicar punto interno: "))
 (vl-cmdf "_.boundary" pto "")
 (setq pol (entlast)) ;boundary
 (vl-cmdf "_offset" (* *altxt* 0.75) pol pto "")
 (setq poly (vlax-ename->vla-object (entlast))) ;offset
 (setq pol (vlax-ename->vla-object pol)) ;boundary
 (setq explst (vlax-invoke pol 'explode)) ;
 (foreach # explst
  (setq mid (vlax-curve-getpointatdist # (/ (vlax-curve-getdistatparam # (vlax-curve-getendparam #)) 2.0)))
  (setq ptxt (vlax-curve-getclosestpointto poly mid))
  (setq long (rtos (vlax-curve-getdistatpoint # (vlax-curve-getendpoint #)) 2 3))
  (setq ang (rem (angle (vlax-curve-getstartpoint #) (vlax-curve-getendpoint #)) pi))
  (if (> ang (/ pi 2.0))
  (setq ang (+ pi ang))
  )
  (text)
  (vla-delete #)
 )
 (vla-delete pol) ;boundary
 (vla-delete poly) ;offset
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun c:tp (/ alt mod opc)
 (vl-load-com)
 (setvar 'cmdecho 0)
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (setq mod (getvar 'osmode))
 (setvar 'osmode 0)
 (setvar 'dimzin 1)
 (if (not *altxt*)
  (setq *altxt* (getreal (strcat "\nIndique altura de textos: ")))
  (progn (setq alt (getreal (strcat "\nIndique altura de textos: <" (rtos *altxt* 2 2) ">")))
    (if (/= alt nil)
     (setq *altxt* alt)
    )
  )
 )
 (if (not (tblobjname "STYLE" "TRAMOS"))
  (entmake (list '(0 . "STYLE")   '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") '(2 . "TRAMOS")
       '(70 . 0) '(40 . 0.0) '(41 . 1.0) '(50 . 0.0) '(71 . 0) '(3 . "ARIAL")   '(4 . "")
      )
  )
 )
 (setvar 'textsize *altxt*)
 (initget 7 "A C")
 (setq opc (getkword "Poly <Abierta/Cerrada>: "))
 (if (= opc "A")
  (pln_open)
  (pln_clos)
 )
 (setvar 'osmode mod)
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (prin1)
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(alert "\nComando: < TP > para ejecutar")
(prin1)

Saludos

Gracias Maestro por el aporte al tema
seguiremos mejorando el lisp.
Un Saludo
Luis