Colocar Distancia Acumulada en Polilinea

Ir abajo

Colocar Distancia Acumulada en Polilinea Empty Colocar Distancia Acumulada en Polilinea

Mensaje por Luis Alberto Benitez el Lun Jul 01, 2019 9:51 pm

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)

Luis Alberto Benitez

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

Ver perfil de usuario

Volver arriba Ir abajo

Colocar Distancia Acumulada en Polilinea Empty Re: Colocar Distancia Acumulada en Polilinea

Mensaje por Luis Alberto Benitez el Mar Jul 02, 2019 1:47 am

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

Luis Alberto Benitez

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

Ver perfil de usuario

Volver arriba Ir abajo

Colocar Distancia Acumulada en Polilinea Empty Re: Colocar Distancia Acumulada en Polilinea

Mensaje por jcanizalesc el Mar Jul 02, 2019 5:04 am

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
jcanizalesc
jcanizalesc

Mensajes : 10
Fecha de inscripción : 06/06/2016
Localización : Mexico

Ver perfil de usuario

Volver arriba Ir abajo

Colocar Distancia Acumulada en Polilinea Empty Re: Colocar Distancia Acumulada en Polilinea

Mensaje por Luis Alberto Benitez el Mar Jul 02, 2019 5:01 pm

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

Luis Alberto Benitez

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

Ver perfil de usuario

Volver arriba Ir abajo

Colocar Distancia Acumulada en Polilinea Empty Re: Colocar Distancia Acumulada en Polilinea

Mensaje por jcanizalesc el Miér Jul 03, 2019 4:06 am

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
jcanizalesc

Mensajes : 10
Fecha de inscripción : 06/06/2016
Localización : Mexico

Ver perfil de usuario

Volver arriba Ir abajo

Colocar Distancia Acumulada en Polilinea Empty Re: Colocar Distancia Acumulada en Polilinea

Mensaje por Luis Alberto Benitez el Miér Jul 03, 2019 2:28 pm

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

Luis Alberto Benitez

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

Ver perfil de usuario

Volver arriba Ir abajo

Colocar Distancia Acumulada en Polilinea Empty Re: Colocar Distancia Acumulada en Polilinea

Mensaje por Luis Alberto Benitez el Miér Jul 03, 2019 2:32 pm

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

Luis Alberto Benitez

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

Ver perfil de usuario

Volver arriba Ir abajo

Colocar Distancia Acumulada en Polilinea Empty Re: Colocar Distancia Acumulada en Polilinea

Mensaje por Luis Alberto Benitez el Jue Jul 04, 2019 1:08 am

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)                         ;;
;;----------


Luis Alberto Benitez

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

Ver perfil de usuario

Volver arriba Ir abajo

Colocar Distancia Acumulada en Polilinea Empty Re: Colocar Distancia Acumulada en Polilinea

Mensaje por jcanizalesc el Jue Jul 04, 2019 4:12 am

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
jcanizalesc

Mensajes : 10
Fecha de inscripción : 06/06/2016
Localización : Mexico

Ver perfil de usuario

Volver arriba Ir abajo

Colocar Distancia Acumulada en Polilinea Empty Re: Colocar Distancia Acumulada en Polilinea

Mensaje por Luis Alberto Benitez el Jue Jul 04, 2019 1:45 pm

jcanizalesc.Buen Aporte.Gracias.

Luis Alberto Benitez

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

Ver perfil de usuario

Volver arriba Ir abajo

Colocar Distancia Acumulada en Polilinea Empty Re: Colocar Distancia Acumulada en Polilinea

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba

- Temas similares

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