Coloca Distancia en Pol

Ver el tema anterior Ver el tema siguiente Ir abajo

Coloca Distancia en Pol

Mensaje por Luis Alberto Benitez el Sáb Jul 08, 2017 5:19 pm

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

Luis Alberto Benitez

Mensajes : 40
Fecha de inscripción : 29/03/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: Coloca Distancia en Pol

Mensaje por Dominguez el Sáb Jul 08, 2017 10:15 pm

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
avatar
Dominguez

Mensajes : 61
Fecha de inscripción : 20/03/2016
Edad : 67
Localización : Zaragoza (España)

Ver perfil de usuario

Volver arriba Ir abajo

Re: Coloca Distancia en Pol

Mensaje por Luis Alberto Benitez el Dom Jul 09, 2017 12:16 am

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

Luis Alberto Benitez

Mensajes : 40
Fecha de inscripción : 29/03/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: Coloca Distancia en Pol

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.