Results 1 to 1 of 1

Thread: calcular pk cadenamientos (absicado) a partir de una parcela

  1. #1
    The Silent Type
    Join Date
    2021-06
    Posts
    0

    Default calcular pk cadenamientos (absicado) a partir de una parcela

    Buen día
    requiero complementar la siguiente rutina Lisp así:
    Deseo que la rutina calcule el valor de PK (cadena) en la cual se tienen los siguientes requisitos.
    • a partir de un valor inicial dado por el usuario o que el valor inicial sea seleccionado a partir del contenido de una (anotación) text o mtext ejemplo (k30+920.)
    • Calcular el Pk (cadena) a partir de un punto perpendicular al alineamiento o línea de maestra (lwpolyline).
    • Determinar si, el punto perpendicular está ubicado a la izquierda o a la derecha del alineamiento o la línea maestra (lwpolyline)
    • Generar una etiqueta donde identifique el PK calculado y si este punto perpendicular se encuentra a la izquierda o a la derecha del alineamiento.
    • la etiqueta generada debe tener el siguiente formato “PK ##+###.## m. (L or R)” donde L sea para izquierda y R para derecha según la ubicación del punto perpendicular.
    Adjunto archivo dwg a manera de ejemplo.
    He tratado de programar pero la verdad mis conocimientos son 0 en autolisp y pude llegar hasta el archivo Lisp adjunto .si alguien me puede ayudar a modificarlo, incluyó código de la rutina de lo que desarrolle.
    HTML Code:
    (vl-load-com)
    
    (defun c:pk()
    
    	(setvar "cmdecho" 0)
    	(Setq CambioInicio "No")
    	
    	(initget "Cambiar")
    	(setq ent (entsel "\nSeleccione la polilinea eje [Cambiar inicio de eje]: "))
    	
    	(if (= ent "Cambiar")
    		(progn
    			(Setq CambioInicio "Si")
    			(princ "\nSe ha cambiado el inicio del eje.")
    			(setq ent (car (entsel "\nSeleccione la polilinea eje [Cambiar inicio de eje]: ")))
    			(setq PlineObj (vlax-ename->vla-object ent))
    		)
    		(progn
    			(setq ent (car ent))
    			(setq PlineObj (vlax-ename->vla-object ent))
    		)
    	)
    	
    	(if (null ProgDef)(setq ProgDef 0))
    	(setq ProgInicial (getreal (strcat "\nIngrese progresiva inicial del eje <" (rtos ProgDef 2 2) ">: ")))
    	(if (null ProgInicial)(setq ProgInicial ProgDef))(setq ProgDef ProgInicial)
    	
    	(while 
                    (setq p (getpoint "\nSpecify point :"))
    	        (setq Punprog (vlax-curve-getclosestpointto ent p))   
    		(setq LongitudHallada (vlax-curve-getDistAtPoint PlineObj Punprog))
    		
    		;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    		
    		(if (= CambioInicio "Si")
    			(setq param (vlax-curve-getENDParam PlineObj))
    			(setq param (vlax-curve-getSTARTParam PlineObj))
    		)
    		
    		(setq len   (vlax-curve-getDistAtParam PlineObj param))
    
    		(if (= CambioInicio "Si")
    			(setq hlen (- len LongitudHallada))
    			(setq hlen (+ len LongitudHallada))
    		)
    
    		;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    		
    		(if (not (null LongitudHallada))
    			(progn 
    				(setq PAngTexto (getpoint "\nIndique el punto angulo del texto a insertar: "))
    				(setq AngTexto (angle Punprog PAngTexto))
    				
    				(command "line" Punprog PAngTexto "")
    				(setq entLine (entlast))
    				(setq entLineaVla (vlax-ename->vla-object entLine))
    				
    				;(setq texto (rtos (+ ProgInicial LongitudHallada) 2 2))
    				(setq texto (rtos (+ ProgInicial hlen) 2 2))
    				
    				(command "text" PAngTexto "2.0"  AngTexto texto )
    				
    				(setq entText (entlast))
    				(setq entTextoVla (vlax-ename->vla-object entText))
    				
    				(vla-put-Rotation entTextoVla (vla-get-Angle entLineaVla))
    				
    				;(command "erase" entLine "")
    				;(command "erase" entLine "")
    				;(princ (strcat "\nProgresiva: " (rtos (+ ProgInicial LongitudHallada) 2 2)) )
    			)
    			(ALERT "El punto indicado no debe de encontrarse fuera del eje." )
    		)
    	)
    (setvar "cmdecho" 0)
    (princ)
    
    )
    Attached Files Attached Files

Similar Threads

  1. Replies: 1
    Last Post: 2021-02-25, 05:26 PM
  2. 2016: a partir de una 3DPolyline ... ¿Cómo puedo cambiar la elevación?
    By dafguerrerom704058 in forum Español - AutoCAD Civil 3D
    Replies: 1
    Last Post: 2015-06-28, 07:58 PM
  3. Como aplicar una imagen a una esfera en revit
    By pablomorelli.pm414586 in forum Español - Revit
    Replies: 0
    Last Post: 2013-08-29, 01:39 PM
  4. Replies: 1
    Last Post: 2013-05-01, 03:50 PM
  5. 2011: Como hago una barandilla de muro para una rampa con curva y pintar la rampa
    By ENRIQUE_ARQ22614034 in forum Español - Revit
    Replies: 0
    Last Post: 2012-04-03, 10:18 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •