acad hispano
¿Quieres reaccionar a este mensaje? Regístrate en el foro con unos pocos clics o inicia sesión para continuar.

Ayuda con un lisp

Ir abajo

Ayuda con un lisp Empty Ayuda con un lisp

Mensaje por José Francisco Lun Sep 09, 2019 6:46 pm

Buen día a todos.
Una vez más molestando.
Tengo esta rutina lisp que crea una lista con coordenadas x y de varios puntos.
Una vez creada la lista, busco que desde un punto especifico, me de la dirección y distancia a cada punto de la lista. Lo que pasa es que tengo otros puntos desde los que también ocupo la dirección y distancia a cada punto de la lista. Puede ser desde un punto adicional o más.
El detalle en si es: como salgo del while y hago que termine la rutina?
Por favor, si me pueden ayudar, les agradezco .

Este es un ejemplo de lo que busco que realice la rutina.

https://www.dropbox.com/s/5iz1ncr40ialtyz/Ejemplo%20%282%29.dwg?dl=0

Este es el lisp:

Código:
(defun c:test (/ lista)
  (setvar "CMDECHO" 0)
  (setvar "clayer" "0")         ;capa cero
  (vl-cmdf "_color" "bylayer")
  (vl-cmdf "_UNITS" "2" "4" "1" "0" "90" "_Y")
  (vl-cmdf "setvar" "angdir" "1")
  (vl-cmdf "setvar" "angbase" "270")
  (setq osm (getvar "osmode"))
  (setvar "pdmode" 32)
  (vl-cmdf "_-STYLE" "Romans" "romans.shx" 0 1.0 0 "NO"   "NO" "")
  (vl-cmdf "_-STYLE" "swissk" "swissk.ttf" 0 1.0 0 "NO" "NO")
  (vl-cmdf "_layer" "_m" "Pto Est" "_C" "4" "" "")
  (vl-cmdf "_layer" "_m" "Pto Obs" "_C" "1" "" "")

  (if (= esc nil)
    (setq esc 1000)
  )
  (setq hn (rtos esc 2 0))
  (setq rotu (strcat "Escala 1:" hn " "))
  (setq hn (getreal rotu))
  (if (/= hn nil)
    (setq esc hn)
  )
  (setq   msc  (/ esc 1000)
   msc1 (/ 1000 esc)
   ht  (* 2 msc)
   larg (* 70 msc)
   esp  (* 5 msc)
   d1  (* 35.089 msc)
   d2  (* 35.795 msc)
   d3  (* 12.500 msc)
   d4  (* 35.795 msc)
   d5  (* 60.467 msc)
   d6  (* 20 msc)
   d7  (* 50 msc)
   d8  (* 10.309 msc)
   d9  (* 44.890 msc)
   d0  (* 66.093 msc)
   xd  (* 1.5 msc)
   tp  (/ 1.5 msc1)
  )
  (setq v (getreal "\nPunto Inicial :"))
  (setq w v)
  (setq y v)
  (setvar "pdsize" tp)
  (setq lista nil)
  (setvar "clayer" "Pto Obs")
  (while (and
     (setq pt (getpoint "\nSeleccione el Punto :"))
     (setq cx (nth 0 pt))
     (setq cy (nth 1 pt))
     (setq cx (+ cx xd))
     (setq ptx (list cx cy))
     (vl-cmdf "_osnap" "_off")
     (vl-cmdf "_point" pt)
     (vl-cmdf "_text" ptx ht "90" v)
     (setq lista (cons pt lista))
     (setvar "osmode" osm)
     (setq v (+ v 1))
    )
  )
  (setq lista (reverse lista))
 
  (while
    (setvar "osmode" osm)
    (setq pest (getpoint "\nSeleccione el Punto de Estacion "))
    (setvar "clayer" "Pto Est")
    (vl-cmdf "_point" pest)
    (setvar "clayer" "0")
    (setq nest (getstring "\nNombre de la Estacion :"))
    (vl-cmdf "_osnap" "_off")
    (setq p1 (getpoint "\nDonde quiere la Tabla ?"))
    (setq p2 (polar p1 0 larg))
    (setq ang-rad (angle p1 p2))
    (setq ang1 (- ang-rad 0.07131))
    (setq ang3 (- ang-rad 0.64349))
    (setq ang4 (- ang-rad 0.21109))
    (setq ang5 (- ang-rad 0.12435))
    (setq ang6 (- ang-rad 0.24497))
    (setq ang7 (- ang-rad 0.11066))
    (setq ang8 (- ang-rad 0.24498))
    (setq ang9 (- ang-rad 0.07804))
    (setq ang10 (- ang-rad 0.0530))
    (setq pt1 (polar p1 ang1 d1))
    (setq pt3 (polar p1 ang3 d3))
    (setq pt4 (polar p1 ang4 d4))
    (setq pt5 (polar p1 ang5 d5))
    (setvar "textstyle" "swissk")
    (vl-cmdf "_color" "4")
    (vl-cmdf "_text" "_j" "_mc" pt1 ht   "90" " TABLA DE REPLANTEO ")         
    (vl-cmdf "_color" "3")
    (vl-cmdf "_text" "_j" "_mc" pt3 ht "90" " E  -  PO ")
    (vl-cmdf "_text" "_j" "_mc" pt4 ht "90" " ACIMUT ")
    (vl-cmdf "_text" "_j" "_mc" pt5 ht "90" " DIST. ")
    (setvar "textstyle" "romans")
    (setq a 1)
    (setq d esp)
    (vl-cmdf "_color" 5)
    (vl-cmdf "_line" p1 p2 "")
    (setq p3 (polar p1 4.7124 d))
    (setq p4 (polar p3 0 larg))
    (vl-cmdf "_line" p3 p4 "")
    (setq pl1 (polar p3 ang-rad d6))
    (setq pl2 (polar p3 ang-rad d7))
    (setq x 0)
    (setq d (+ d esp))
    (setq p3 (polar p1 4.7124 d))
    (setq p4 (polar p3 0 larg))
    (vl-cmdf "_line" p3 p4 "")
    (vl-cmdf "_color" "bylayer")
    (foreach x lista
      (setq d (+ d esp))
      (setq pt6 (polar p3 ang8 d8))
      (setq pt7 (polar p3 ang9 d9))
      (setq pt8 (polar p3 ang10 d0))
      (setq p3 (polar p1 4.7124 d))
      (setq p4 (polar p3 0 larg))
      (setq dist (distance pest x))
               ;--------------------------------------------------
      (setq ang-radi (angle pest x))
      (setq ang-radi (- (/ pi 2.0) ang-radi))
      (setq ang-dec (* (/ 180 pi) ang-radi))
      (if (< ang-dec 0)
   (setq ang-dec (+ 360 ang-dec))
      )
      (setq deg (fix ang-dec))
      (setq deg2 (rtos deg 2 0))
      (if (= (strlen deg2) 1)
   (setq degstr (strcat "0" deg2 "°"))
   (setq degstr (strcat deg2 "°"))
      )

      (setq rem1 (- ang-dec deg))
      (setq min1 (* rem1 60))
      (setq min2 (fix min1))
      (setq min3 (rtos min2 2 0))
      (if (= (strlen min3) 1)
   (setq minstr (strcat "0" min3 (chr 39)))
   (setq minstr (strcat min3 (chr 39)))
      )

      (setq sec (- min1 min2))
      (setq sec2 (rtos (* 60 sec) 2 0))
               ;-------------------------INICIA  CONDICIÓN SI SEC2 = "60"
      (if (= sec2 "60")
   (progn
     (setq sec2 "00")
     (setq min22 (+ min2 1))
     (setq min3 (rtos min22 2 0))
     (if (= (strlen min3) 1)
       (setq minstr (strcat "0" min3 (chr 39)))
       (setq minstr (strcat min3 (chr 39)))
     )
   )
      )
               ;-------------------------TERMINA CONDICIÓN SI SEC2 = "60"
      (if (= (strlen sec2) 1)
   (setq secstr (strcat "0" sec2 (chr 34)))
   (setq secstr (strcat sec2 (chr 34)))
      )
      (if (= min3 "60")
   (progn
     (setq minstr (strcat "00" (chr 39)))
     (setq deg22 (+ deg 1))
     (setq deg2 (rtos deg22 2 0))
     (if (= (strlen deg2) 1)
       (setq degstr (strcat "0" deg2 "°"))
       (setq degstr (strcat deg2 "°"))
     )
   )
      )
      (setq ang-final (strcat degstr " " minstr " " secstr))
      (setq linea (strcat nest " - " (rtos w 2 0)))
               ;---------------------------------------------
      (vl-cmdf "_text" "_j" "_mc" pt6 ht "90" linea)
      (vl-cmdf "_text" "_j" "_r" pt7 ht "90" ang-final)
      (vl-cmdf "_text" "_j" "_r" pt8 ht "90" (rtos dist 2 2))
      (vl-cmdf "_line" p3 p4 "")
      (setq a (+ a 1))
      (setq w (+ w 1))
    )
    (setq w y)
    (setq pl3 (polar p3 ang-rad d6))
    (setq pl4 (polar p3 ang-rad d7))
    (vl-cmdf "_color" 5)
    (vl-cmdf "_line" p1 p3 "")
    (vl-cmdf "_line" p2 p4 "")
    (vl-cmdf "_line" pl1 pl3 "")
    (vl-cmdf "_line" pl2 pl4 "")
    (setvar "osmode" osm)
    (vl-cmdf "_color" "bylayer")
  )
  (princ)
)

Gracias

José Francisco

Mensajes : 46
Fecha de inscripción : 30/03/2016

Volver arriba Ir abajo

Ayuda con un lisp Empty Re: Ayuda con un lisp

Mensaje por José Francisco Dom Sep 15, 2019 1:33 am

De nuevo, buen día para todos.
De pura suerte he encontrado la solución al problema que tenía, encontré la forma de salir del while:

Código:
(defun c:rep (/ lista pest)
  (setvar "CMDECHO" 0)
  (setvar "clayer" "0")         ;capa cero
  (vl-cmdf "_color" "bylayer")
  (vl-cmdf "_UNITS" "2" "4" "1" "0" "90" "_Y")
  (vl-cmdf "setvar" "angdir" "1")
  (vl-cmdf "setvar" "angbase" "270")
  (setq osm (getvar "osmode"))
  (setvar "osmode" 45)
  (setvar "pdmode" 32)
  (vl-cmdf "_-STYLE" "Romans" "romans.shx" 0 1.0 0 "NO"   "NO" "")
  (vl-cmdf "_-STYLE" "swissk" "swissk.ttf" 0 1.0 0 "NO" "NO")
  (vl-cmdf "_layer" "_m" "Pto Est" "_C" "4" "" "")
  (vl-cmdf "_layer" "_m" "Pto Obs" "_C" "1" "" "")

  (if (= esc nil)
    (setq esc 1000)
  )
  (setq hn (rtos esc 2 0))
  (setq rotu (strcat "Escala 1:" hn " "))
  (setq hn (getreal rotu))
  (if (/= hn nil)
    (setq esc hn)
  )
  (setq   msc  (/ esc 1000)
   msc1 (/ 1000 esc)
   ht  (* 2 msc)
   larg (* 70 msc)
   esp  (* 5 msc)
   d1  (* 35.089 msc)
   d2  (* 35.795 msc)
   d3  (* 12.500 msc)
   d4  (* 35.795 msc)
   d5  (* 60.467 msc)
   d6  (* 20 msc)
   d7  (* 50 msc)
   d8  (* 10.309 msc)
   d9  (* 44.890 msc)
   d0  (* 66.093 msc)
   xd  (* 1.5 msc)
   tp  (/ 1.5 msc1)
  )
  (setq v (getreal "\nPunto Inicial :"))
  (setq w v)
  (setq y v)
  (setvar "pdsize" tp)
  (setq lista nil)
  (setvar "clayer" "Pto Obs")
  (while (and
     (setq pt (getpoint "\nSeleccione el Punto :"))
     (setq cx (nth 0 pt))
     (setq cy (nth 1 pt))
     (setq cx (+ cx xd))
     (setq ptx (list cx cy))
     (vl-cmdf "_osnap" "_off")
     (vl-cmdf "_point" pt)
     (vl-cmdf "_text" ptx ht "90" v)
     (setq lista (cons pt lista))
     (setvar "osmode" 45)
     (setq v (+ v 1))
    )
  )
  (setq lista (reverse lista))
  (setq datos "S")
  (while (= datos "S")
    (setvar "osmode" 45)
    (setq pest (getpoint "\nSeleccione el Punto de Estacion "))
    (if   (/= pest nil)
      (progn
   (setvar "clayer" "Pto Est")
   (vl-cmdf "_point" pest)
   (setvar "clayer" "0")
   (setq nest (getstring "\nNombre de la Estacion :"))
   (vl-cmdf "_osnap" "_off")
   (setq p1 (getpoint "\nDonde quiere la Tabla ?"))
   (setq p2 (polar p1 0 larg))
   (setq ang-rad (angle p1 p2))
   (setq ang1 (- ang-rad 0.07131))
   (setq ang3 (- ang-rad 0.64349))
   (setq ang4 (- ang-rad 0.21109))
   (setq ang5 (- ang-rad 0.12435))
   (setq ang6 (- ang-rad 0.24497))
   (setq ang7 (- ang-rad 0.11066))
   (setq ang8 (- ang-rad 0.24498))
   (setq ang9 (- ang-rad 0.07804))
   (setq ang10 (- ang-rad 0.0530))
   (setq pt1 (polar p1 ang1 d1))
   (setq pt3 (polar p1 ang3 d3))
   (setq pt4 (polar p1 ang4 d4))
   (setq pt5 (polar p1 ang5 d5))
   (setvar "textstyle" "swissk")
   (vl-cmdf "_color" "4")
   (vl-cmdf "_text"   "_j"         "_mc"
       pt1      ht         "90"
       " TABLA DE REPLANTEO "
      )
   (vl-cmdf "_color" "3")
   (vl-cmdf "_text" "_j" "_mc" pt3 ht "90" " E  -  PO ")
   (vl-cmdf "_text" "_j" "_mc" pt4 ht "90" " ACIMUT ")
   (vl-cmdf "_text" "_j" "_mc" pt5 ht "90" " DIST. ")
   (setvar "textstyle" "romans")
   (setq a 1)
   (setq d esp)
   (vl-cmdf "_color" 5)
   (vl-cmdf "_line" p1 p2 "")
   (setq p3 (polar p1 4.7124 d))
   (setq p4 (polar p3 0 larg))
   (vl-cmdf "_line" p3 p4 "")
   (setq pl1 (polar p3 ang-rad d6))
   (setq pl2 (polar p3 ang-rad d7))
   (setq x 0)
   (setq d (+ d esp))
   (setq p3 (polar p1 4.7124 d))
   (setq p4 (polar p3 0 larg))
   (vl-cmdf "_line" p3 p4 "")
   (vl-cmdf "_color" "bylayer")
   (foreach x lista
     (setq d (+ d esp))
     (setq pt6 (polar p3 ang8 d8))
     (setq pt7 (polar p3 ang9 d9))
     (setq pt8 (polar p3 ang10 d0))
     (setq p3 (polar p1 4.7124 d))
     (setq p4 (polar p3 0 larg))
     (setq dist (distance pest x))
               ;--------------------------------------------------
     (setq ang-radi (angle pest x))
     (setq ang-radi (- (/ pi 2.0) ang-radi))
     (setq ang-dec (* (/ 180 pi) ang-radi))
     (if (< ang-dec 0)
       (setq ang-dec (+ 360 ang-dec))
     )
     (setq deg (fix ang-dec))
     (setq deg2 (rtos deg 2 0))
     (if (= (strlen deg2) 1)
       (setq degstr (strcat "0" deg2 "°"))
       (setq degstr (strcat deg2 "°"))
     )

     (setq rem1 (- ang-dec deg))
     (setq min1 (* rem1 60))
     (setq min2 (fix min1))
     (setq min3 (rtos min2 2 0))
     (if (= (strlen min3) 1)
       (setq minstr (strcat "0" min3 (chr 39)))
       (setq minstr (strcat min3 (chr 39)))
     )

     (setq sec (- min1 min2))
     (setq sec2 (rtos (* 60 sec) 2 0))
               ;-------------------------INICIA  CONDICIÓN SI SEC2 = "60"
     (if (= sec2 "60")
       (progn
         (setq sec2 "00")
         (setq min22 (+ min2 1))
         (setq min3 (rtos min22 2 0))
         (if (= (strlen min3) 1)
      (setq minstr (strcat "0" min3 (chr 39)))
      (setq minstr (strcat min3 (chr 39)))
         )
       )
     )
               ;-------------------------TERMINA CONDICIÓN SI SEC2 = "60"
     (if (= (strlen sec2) 1)
       (setq secstr (strcat "0" sec2 (chr 34)))
       (setq secstr (strcat sec2 (chr 34)))
     )
     (if (= min3 "60")
       (progn
         (setq minstr (strcat "00" (chr 39)))
         (setq deg22 (+ deg 1))
         (setq deg2 (rtos deg22 2 0))
         (if (= (strlen deg2) 1)
      (setq degstr (strcat "0" deg2 "°"))
      (setq degstr (strcat deg2 "°"))
         )
       )
     )
     (setq ang-final (strcat degstr " " minstr " " secstr))
     (setq linea (strcat nest " - " (rtos w 2 0)))
               ;---------------------------------------------
     (vl-cmdf "_text" "_j" "_mc" pt6 ht "90" linea)
     (vl-cmdf "_text" "_j" "_r" pt7 ht "90" ang-final)
     (vl-cmdf "_text" "_j" "_r" pt8 ht "90" (rtos dist 2 2))
     (vl-cmdf "_line" p3 p4 "")
     (setq a (+ a 1))
     (setq w (+ w 1))
   )
   (setq w y)
   (setq pl3 (polar p3 ang-rad d6))
   (setq pl4 (polar p3 ang-rad d7))
   (vl-cmdf "_color" 5)
   (vl-cmdf "_line" p1 p3 "")
   (vl-cmdf "_line" p2 p4 "")
   (vl-cmdf "_line" pl1 pl3 "")
   (vl-cmdf "_line" pl2 pl4 "")
   (setvar "osmode" osm)
   (vl-cmdf "_color" "bylayer")
      )
    )
    (if   (null pest)
      (setq datos "N")
    )
  )
  (prin1)
)


Muchas gracias.

José Francisco

Mensajes : 46
Fecha de inscripción : 30/03/2016

Volver arriba Ir abajo

Volver arriba

- Temas similares

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