Coloca Distancia en Pol

Estimados Colegas del Foro recurro a Uds. para modif. el siguiente Lisp
que conseguí en el antiguo Foro.

Código:

;;; _  _  _                               _  
;;; | || |(_) ___ _ __  __ _  __  __ _  __| |
;;; | __ || |(_-<| '_ \/ _` |/ _|/ _` |/ _` |
;;; |_||_||_|/__/| .__/\__,_|\__|\__,_|\__,_|
;;;             |_|                          
;;;     www.Hispacad.com                          

;;; OPR6.LSP V.2 - 2/10/13

; 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 © 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+ (fix num)))
  (setq num  (fix num))
)
      
                              
  (SETQ NUM$ (ITOA NUM))

  (SETQ RETVAL NUM$)
  ) ; -fin Num2StrPK
;;------------------------ 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))
);c.defun

;;______________________________________________________________________
(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.defun


;;======================================== C:OPR6 ==============================================
;;==============================================================================================
;; Localizar y marcar prograsivas en Curva (polilinea, spline,...)                              
;; Jose L. García G. - Hispacad.com  08/02/2013                                                
;;==============================================================================================
;;==============================================================================================
(defun C:OPR6 ( / ChangeInic oCurve Tmp Punprog LongInEje len hlen DatTangent
         PtPick AngPerp PtAux PtSel oText NewPt PtTxt
         ;|Var OPCIONES|; $CenterTxt$ $HTxt$ $FijarDist$ $DrawLine$ $DrawLineEje$ $ColTxt$ $ColLineRef$ $ColLineEje$
         ;|Especific functions|; OPR6:Draw_Txt OPR6:Draw_Line *error* grd> OPR6:MoveText)
        ;;__________________________________________________________
 ;;funcion de ERROR Interna
 (defun *error* (msg)
 (print (strcat "OPR6 Error: " msg))
 )
 ;;--------------------- OPR6:Draw_Txt -------------------------
 ;; dibuja sTexto                                              
 ;;------------------------------------------------------------
 (defun OPR6: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)
 );c.list
 );c.entmk
 );c.defun
        ;;--------------------- OPR6:Draw_Line ---------------------------
 ;; dibuja linea                                              
 ;;-----------------------------------------------------------
        (defun OPR6: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)
 );c.defun
 ;;--------------------------- OPR6:MoveText -----------------------------------------
 ;;Mover el sTexto Elasticamente en pantalla                                        
 ;;----------------------------------------------------------------------------------
 (defun OPR6: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)
      )
     );c.cond
     (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);;Keys
     (cond
      ((member gr2 '(13 32))   ;; Enter/Space
       nil
      )
      ;;(t (princ (strcat "\nTecla no valida.")))
     )
    )
    );c.cond
   );c.Prg
  );c.if
 flag
 );c.defun
 
 ;;---------------------------- 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)
 ;.................................
 ;;Altura y color de Texto:
(command "TEXTSIZE" 2);                  Altura del Texto
(setvar "CMDECHO" 0)
(command "orto""DES")
(SETVAR "OSMODE" 0)
(SETVAR "OSMODE" 512);Cercano
;(SETVAR "OSMODE" 1);Punto Final
;(SETVAR "OSMODE" 32);Interseccion


 (setq $HTxt$ (getvar "TEXTSIZE"))
 (setq $ColTxt$ 6)
 (setq $CenterTxt$ nil)

 ;;Dibujar linea de referencia:
 (setq $DrawLineRef$ t)
 (setq $ColLineRef$ 4)

 ;;Dibujar linea en el Eje
 (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)
    )
   );c.if
   (initget 0)
   (if (setq Tmp (getreal (strcat "\nProgresiva inicial del Eje <" (rtos *ProgDef* 2) ">: ")))
    (setq *ProgDef* Tmp)
   )
   (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)
      ;;Format Text:


      (setq sTexto (Num2StrPK (+ *ProgDef* hlen) nil))



      (cond
       ((zerop $FijarDist$) ;;Distancia fijada en 0
 (setq NewPt PtPick)
 (setq oText (OPR6:Draw_Txt PtPick $HTxt$ (angle PtPick PtAux) sTexto 1 1 $ColTxt$))
       )
       (t
 (setq oText (OPR6: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 OPR6:MoveText))))
      (not MoveText))
  (vla-delete oText)
  (redraw)
 )
 );c.cond
       )
      );c.cond
      (cond
       ((and oText (not (vlax-erased-p oText)))
 ;;Draw Line Eje:
 (if $DrawLineEje$  
 (OPR6:Draw_Line (polar PtPick AngPerp (/ $LenLineEje$ 2.0))
            (polar PtPick (+ AngPerp pi) (/ $LenLineEje$ 2.0))
            $ColLineEje$)
 );c.if
 (cond
 ((and $DrawLineRef$
       (not (zerop $FijarDist$))
       (> (distance PtPick NewPt) $HTxt$))
  (if $CenterTxt$ (setq NewPt (polar NewPt (angle NewPt PtPick) (/ $HTxt$ 2.0))))
  (OPR6:Draw_Line PtPick NewPt $ColLineRef$)
 )
 )
 (redraw)
 (vl-cmdf "_.undo" "_E")
       )
      );c.cond
     )
    );c.cond
   );;c.while
  );T
 );c.cond
(princ)
)

;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(textpage);Para ver en Cuadro de Texto
(princ "\n:: Comando: \"OPR6\" para Ejecutar")
(princ)



Lo que quiero es colocar la cantidad de Decimales
Espero ayuda para solucionar el mismo.
Un Saludo
Luis

Hay tienes la rutina modificada para que tu le pongas los decimales que desees.

Código:

;; _  _  _                              _ 
;; | || |(_) ___ _ __  __ _  __  __ _  __| |
;; | __ || |(_-<| '_ \/ _` |/ _|/ _` |/ _` |
;; |_||_||_|/__/| .__/\__,_|\__|\__,_|\__,_|
;;              |_|                         
;;    www.Hispacad.com                     
;;; OPR6.LSP V.2 - 2/10/13
 ; 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 © 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))
 (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:OPR6 ==============================================
;; Localizar y marcar prograsivas en Curva (polilinea, spline,...)                             
;; Jose L. García G. - Hispacad.com  08/02/2013                                               
(defun C:OPR6 (/ ChangeInic oCurve Tmp Punprog LongInEje len hlen DatTangent PtPick AngPerp PtAux PtSel oText NewPt PtTxt
              $CenterTxt$ $HTxt$ $FijarDist$ $DrawLine$ $DrawLineEje$ $ColTxt$ $ColLineRef$ $ColLineEje$ OPR6:Draw_Txt
              OPR6:Draw_Line *error* grd> OPR6:MoveText
              )
 ;;__________________________________________________________
 ;;funcion de ERROR Interna
 (defun *error* (msg)
  (print (strcat "OPR6 Error: " msg))
 )
 ;;--------------------- OPR6:Draw_Txt -------------------------
 ;; dibuja sTexto                                             
 ;;------------------------------------------------------------
 (defun OPR6: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)
            )
  )
 )
 ;;--------------------- OPR6:Draw_Line ----------------------
 ;; dibuja linea                                             
 (defun OPR6: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)
 )
 ;;--------------------------- OPR6:MoveText -----------------------------------------
 ;;Mover el Texto Elasticamente en pantalla                                       
 ;;----------------------------------------------------------------------------------
 (defun OPR6: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)
 ;.................................
 ;;Altura y color de Texto:
 (command "TEXTSIZE" 2) ; Altura del Texto
 (setvar "CMDECHO" 0)
 (command "orto" "DES")
 (SETVAR "OSMODE" 0)
 (SETVAR "OSMODE" 512) ;Cercano
 (setq $HTxt$ (getvar "TEXTSIZE"))
 (setq $ColTxt$ 6)
 (setq $CenterTxt$ nil)
 (setq $DrawLineRef$ t)
 (setq $ColLineRef$ 4)
 (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 dec (getint "\nCuantos decimales: ")) ;
  (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 (OPR6:Draw_Txt PtPick $HTxt$ (angle PtPick PtAux) sTexto 1 1 $ColTxt$))
      )
      (t
        (setq oText (OPR6: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 OPR6:MoveText))))
              (not MoveText)
          )
          (vla-delete oText)
          (redraw)
        )
        )
      )
      )
      (cond
      ((and oText (not (vlax-erased-p oText)))
        (if $DrawLineEje$
        (OPR6: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)))
          )
          (OPR6:Draw_Line PtPick NewPt $ColLineRef$)
        )
        )
        (redraw)
        (vl-cmdf "_.undo" "_E")
      )
      )
    )
    )
  )
  )
 )
 (princ)
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(princ "\n:: Comando: \"OPR6\" para Ejecutar")
(princ)



Saludos

Maestro Dominguez gracias por esa pronta respuesta a la requisitoria
el lisp con la modificación Funciona perfectamente espero le sea útil
a otros colegas.
Un Saludo
Luis

Gracias Maestro Dominguez me ha sido de mucha ayuda.
un abrazo
William.