Linea con Angulo

Estimados Integrantes del Foro:
Expongo un Lisp que coloca una Linea con un Angulo respecto de otra Linea.
Lo que quiero es unificar el Lisp con el DCL.
Desde ya Gracias por los Continuos Aportes.
Un Saludo
Luis

Código:

;Lisp que coloca la linea con el Angulo a continuación de otra
;tomando el ángulo relativo a esta última.
(defun c:ANG+LINEA ()
(vl-load-com)
(setvar "CMDECHO" 0)
(SETVAR "OSMODE" 0)
(command "orto""DES")
(vl-cmdf "_setvar""angdir""1");Sentido Horario=1,Sentido Antihorario=0
(vl-cmdf "_setvar""angbase""0");Angulo Base Dirección respecto del SCP original=0

;;;CUADRO DE TEXTO

  (princ "\ncurva6")(princ)
  ; Set Default Variables
  (if (not *curva6@);Único nombre de variable global para almacenar información de diálogo
    (setq *curva6@ (list nil "" "" "" ""))
  );if
  (setq Edit1$ (nth 1 *curva6@)
        Edit2$ (nth 2 *curva6@)
        Edit3$ (nth 3 *curva6@)
        Edit4$ (nth 4 *curva6@)
  );setq
  ; diálogo de carga
  (setq Dcl_Id% (load_dialog "curva6.dcl"))
  (new_dialog "curva6" Dcl_Id%)
  ;Ajuste de Diálogo Configuración inicial
  (set_tile "Title" "DATOS DE LA LINEA")
  (set_tile "Text1" "LONGITUD de la Linea                             mts. :")
  (set_tile "Edit1" Edit1$)
  (set_tile "Text2" "GRADOS Sentido Horario(+);Antihorario(-)        :")
  (set_tile "Edit2" Edit2$)
  (set_tile "Text3" "MINUTOS Sentido Horario(+);Antihorario(-)       :")
  (set_tile "Edit3" Edit3$)  
  (set_tile "Text4" "SEGUNDOS Sentido Horario(+);Antihorario(-)   :")
  (set_tile "Edit4" Edit4$)                                        

  ; Dialog Actions
  (action_tile "Edit1" "(setq Edit1$ $value)")
  (action_tile "Edit2" "(setq Edit2$ $value)")
  (action_tile "Edit3" "(setq Edit3$ $value)")
  (action_tile "Edit4" "(setq Edit4$ $value)")
  (action_tile "ok" "(aceptar)")
  (action_tile "cancel" "(exit)")

  (setq Return# (start_dialog))
  
; Descarga Diálogo
  (unload_dialog Dcl_Id%)
  (setq *curva6@ (list nil Edit1$ Edit2$ Edit3$ Edit4$ Return#))

(SETQ dis (atof Edit1$))
(SETQ g (atof Edit2$))
(SETQ m (atof Edit3$))
(SETQ s (atof Edit4$))

(SETVAR "OSMODE" 512)
(princ "\nPunto Cercano al Vertice:")
(terpri)
(SETQ PC (GETPOINT"\Punto Cercano al Vertice:"))
(terpri)
(SETVAR "OSMODE" 0)
(SETVAR "OSMODE" 1)
(princ "\nPunto Final Linea Vertice:")
(terpri)
(SETQ cen (GETPOINT"\Punto Final Linea Vertice:"))
(terpri)
(SETVAR "OSMODE" 0)
(setq m-g (/ m 60))
(setq s-m-g (/ (/ s 60) 60))

 ;Distancia

(setq d (strcat (rtos dis 2 2) "mts ; "))     ;Distancia


 ;Angulo Decimal

(setq degstr (strcat (rtos (abs g) 2 0) "°"))     ;Grados

(setq minstr (strcat (rtos (abs m) 2 0) (chr 39)));Minutos

(setq secstr (strcat (rtos (abs s) 2 0) (chr 34)));Segundos



                                  ;Angulo Sexagesimal

(setq a (+ g m-g s-m-g));Angulo Decimal

(SETQ a1 (* PI (/ a 180.0)));De Angulo Sexagesimal a Radianes

(setq Angus (angle cen pc));Angulo en Radianes

(setq Ang (- angus a1));Angulo en Radianes Respecto de la Linea Seleccionada

(command "_line" cen (polar cen ang dis) "")

(PRINC "\nIndicar Punto de Inserción del Texto:")

      (setq get (getpoint "\nIndicar Punto de Inserción del Texto:"))

      (vl-cmdf "_.TEXT" "_J" "ii" get "2" "0" (strcat d degstr minstr secstr ";" (rtos a 2 4) ";" (rtos a1 2 4) ";" (rtos ang 2 4) ";"(rtos angus 2 4)))

(setvar "HIGHLIGHT" 1);Activa el resaltado de la selección de objetos
(setvar "CMDECHO" 0)
(command "-UNIDADES""2""4""2""5""0""N")
)
(PROMPT
"\n***Nuevo Comando ANG+LINEA  definido***"
)
(PRIN1)


Código:

//---------------------------------------------------------------------------------------------------------
// curva6
//---------------------------------------------------------------------------------------------------------
curva6 : dialog {
  key = "Title";
  label = "    ";//Title$ de archivo LSP
  initial_focus = "Edit1";
  spacer;
  : row {//<
    fixed_width = true;
    : column {
      width = 50;
      fixed_width = true;
      spacer;
      : text {
        key = "Text1";
        label = "";//Text1$ de archivo LSP
      }
    }
    : edit_box {
      key = "Edit1";//Edit1$ de archivo LSP
      edit_width = 5;
      edit_limit=6;
      fixed_width_font = true;
      fixed_width = true;
    }
  }//>
  : row {//<
    fixed_width = true;
    : column {
      width = 50;
      fixed_width = true;
      spacer;
      : text {
        key = "Text2";
        label = "";//Text2$ de archivo LSP
      }
    }
    : edit_box {
      key = "Edit2";//Edit2$ de archivo LSP
      edit_width = 3;
      edit_limit=4;
      fixed_width_font = true;
      fixed_width = true;
    }
  }//>
  : row {//<
    fixed_width = true;
    : column {
      width = 50;
      fixed_width = true;
      spacer;
      : text {
        key = "Text3";
        label = "";//Text3$ de archivo LSP
      }
    }
    : edit_box {
      key = "Edit3";//Edit3$ de archivo LSP
      edit_width = 2;
      edit_limit=3;
      fixed_width_font = true;
      fixed_width = true;
    }
  }//>
: row {//<
    fixed_width = true;
    : column {
      width = 50;
      fixed_width = true;
      spacer;
      : text {
        key = "Text4";
        label = "";//Text4$ de archivo LSP
      }
    }
    : edit_box {
      key = "Edit4";//Edit4$ de archivo LSP
      edit_width = 2;
      edit_limit=3;
      fixed_width_font = true;
      fixed_width = true;
    }
  }//>
  :spacer_1{
       }

  ok_cancel ;
       :spacer_1{
       }
:text {
       label="Luis :copyright: 2019";
       fixed_width_font = true;
       alignment=centered;
       }  
       :spacer_1{
       }
}//curva6


]

Hola...

Creo que esto es lo que quieres (le he hecho algunos cambios para mejora...)

Código:


;;Función de error
(defun anlerr (s)
  ;;1º- Presentar el error si no es "Función cancelada"
  (if (= s "Función cancelada")
    (princ)
    (princ s)
    )
  ;;2º- Borrar el fichero donde se ha escrito temporalmente el DCL.
  (if dcl (vl-file-delete dcl))
  ;;3º- Borrar la línea si se ha dibujado.
  (if lin (entdel lin))
  ;;3º- Dejar las variables como estaban.
  (setvar "CMDECHO" cmd)
  (setvar "OSMODE" osm)
  (setvar "ORTHOMODE" ort)
  (setvar "ANGDIR" agd)
  (setvar "ANGBASE" agb)
  (setvar "HIGHLIGHT" hlg)  
  ;;4º- Dejar la función de *error* como estaba.
  (setq *error* err)
  (princ)
  )

;;Escribir el fichero temporal del DCL                                                                            
;;                                                                                                                
;;OJO:                                                                                                            
;;                                                                                                                
;;Puede darse el caso que no tengas permisos para escribir en las carpetasque usa por defecto "vl-filename-mktemp"
;;En este caso, tendras que buscar las rutas donde puedas escribir (¿tanteo?).                                    
;;                                                                                                                
;;La función devuelve el nombre del dcl escrito con la ruta completa.                                            
(defun wrtdcl (/ dcl fia fib)
  (setq
    dcl '("curva6:dialog{ "
          "key=\"Title\"; label=\"    \";initial_focus=\"Edit1\";spacer; "
          ":row{fixed_width=true; "
          ":column{width=50;fixed_width=true;spacer; "
          ":text{key=\"Text1\";label=\"\";}} "
          ":edit_box{key=\"Edit1\";edit_width=5;edit_limit=6;fixed_width_font=true;fixed_width=true;}} "
          ":row{fixed_width=true; "
          ":column{width=50;fixed_width=true;spacer; "
          ":text{key=\"Text2\";label=\"\";}} "
          ":edit_box{key=\"Edit2\";edit_width=3;edit_limit=4;fixed_width_font=true;fixed_width=true;}} "
          ":row{fixed_width=true; "
          ":column{width=50;fixed_width=true;spacer; "
          ":text{key=\"Text3\";label=\"\";}} "
          ":edit_box{key=\"Edit3\";edit_width=2;edit_limit=3;fixed_width_font=true;fixed_width=true;}} "
          ":row{fixed_width=true; "
          ":column{width=50;fixed_width=true;spacer;:text{key=\"Text4\";label=\"\";}} "
          ":edit_box{key=\"Edit4\";edit_width=2;edit_limit=3;fixed_width_font=true;fixed_width=true;}} "
          ":spacer_1{}ok_cancel;:spacer_1{} "
          ":text{height=1.25;label=\"Luis :copyright: 2019\";fixed_width_font=true;alignment=centered;} "
          ":spacer_1{}} "
          )
    fia (vl-filename-mktemp "curva6.dcl")
    fib (open fia "w")
    )
  (mapcar '(lambda (x) (write-line x fib)) dcl)
  (close fib)
  fia
  )

(defun C:ANG+LINEA
   (/
    a d g m s
    a1 pc
    agb agd ang cen cmd dcl dis err get hlg lin ort osm m-g
    s-m-g angus
    degstr minstr secstr dcl_Id% Edit1$ Edit2$ Edit3$ Edit4$
    Return#
    )
  
  (vl-load-com)
  ;;Ya que se modifican variables, hay que guardar el estado actual para que
  ;;en caso de error o de abandonar el comando, todo quede como al principio.
  ;;He metido una función de error para eso.
  (setq
    err *error*
    *error* anlerr
    ort (getvar "ORTHOMODE")
    cmd (getvar "CMDECHO")
    osm (getvar "OSMODE")
    agb (getvar "ANGBASE")
    agd (getvar "ANGDIR")
    hlg (getvar "HIGHLIGHT")
    )
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setvar "ORTHOMODE" 0)
  (setvar "ANGDIR" 1)
  (setvar "ANGBASE" 0)
  ;;Estas líneas se pueden sustituir por "SETVARS"
   ;(command "orto" "DES")
   ;(vl-cmdf "_setvar" "angdir" "1")
   ;(vl-cmdf "_setvar" "angbase" "0")  
  (setvar "ORTHOMODE" 0)
  (setvar "ANGDIR" 1)
  (setvar "ANGBASE" 0)
  ;;No entiendo para qué estaban estas líneas
   ;(princ "\ncurva6")
 ;(princ)
  ;;He corregido estas líneas (aunque funcionaban...)
  (if (not *curva6@)
    (setq *curva6@ (list nil "" "" "" ""))
    (setq
      Edit1$ (nth 1 *curva6@)
      Edit2$ (nth 2 *curva6@)
      Edit3$ (nth 3 *curva6@)
      Edit4$ (nth 4 *curva6@)
      )
    )
  (setq
    dcl     (wrtdcl)
    dcl_Id% (load_dialog dcl)
    )
  (new_dialog "curva6" dcl_Id%)
  (set_tile "Title" "DATOS DE LA LINEA")
  (set_tile
    "Text1"
    "LONGITUD de la Linea                             mts. :"
    )
  (set_tile "Edit1" Edit1$)
  (set_tile
    "Text2"
    "GRADOS Sentido Horario(+);Antihorario(-)        :"
    )
  (set_tile "Edit2" Edit2$)
  (set_tile
    "Text3"
    "MINUTOS Sentido Horario(+);Antihorario(-)       :"
    )
  (set_tile "Edit3" Edit3$)
  (set_tile
    "Text4"
    "SEGUNDOS Sentido Horario(+);Antihorario(-)   :"
    )
  (set_tile "Edit4" Edit4$)
  (action_tile "Edit1" "(setq Edit1$ $value)")
  (action_tile "Edit2" "(setq Edit2$ $value)")
  (action_tile "Edit3" "(setq Edit3$ $value)")
  (action_tile "Edit4" "(setq Edit4$ $value)")
  (action_tile "ok" "(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")
  ;(action_tile "ok" "(aceptar)")
  ;(action_tile "cancel" "(exit)")
  (setq Return# (start_dialog))
  (unload_dialog Dcl_Id%)
  (cond
    ((= Return# 0))
    (T
     (setq *curva6@ (list nil Edit1$ Edit2$ Edit3$ Edit4$ Return#))
     (setq dis (atof Edit1$))
     (setq g (atof Edit2$))
     (setq m (atof Edit3$))
     (setq s (atof Edit4$))
     (setvar "OSMODE" 512)
     ;;Eliminadas por redundancia
     ;(princ "\nPunto Cercano al Vertice:")
     ;(terpri)
     (setq pc (getpoint "\Punto Cercano al Vertice:"))
     (terpri)
     (setvar "OSMODE" 0)
     (setvar "OSMODE" 1)
     ;;Eliminadas por redundancia
     ;(princ "\nPunto Final Linea Vertice:")
     ;(terpri)
     (setq cen (getpoint "\nPunto Final Linea Vertice:"))
     ;(terpri)
     (setvar "OSMODE" 0)
     (setq m-g (/ m 60))
     (setq s-m-g (/ (/ s 60) 60))
     (setq d (strcat (rtos dis 2 2) "mts ; "))
     (setq degstr (strcat (rtos (abs g) 2 0) "°"))
     (setq minstr (strcat (rtos (abs m) 2 0) (chr 39)))
     (setq secstr (strcat (rtos (abs s) 2 0) (chr 34)))
     (setq a (+ g m-g s-m-g))
     (setq a1 (* pi (/ a 180.0)))
     (setq angus (angle cen pc))
     (setq ang (- angus a1))
     (command "_line" cen (polar cen ang dis) "")
     ;;He metido esta variable para borrar la línea si se anula el
     ;;comando después de dibujarla y antes de insertar el texto.
     (setq lin (entlast))
     ;;Eliminada por redundancia
     ;(princ "\nIndicar Punto de Inserción del Texto:")
     (setq get (getpoint "\nIndicar Punto de Inserción del Texto:"))
     (vl-cmdf
       "_.TEXT"
       "_J"
       "ii"
       get
       "2"
       "0"
       (strcat
         d
         degstr
         minstr
         secstr
         ";"
         (rtos a 2 4)
         ";"
         (rtos a1 2 4)
         ";"
         (rtos ang 2 4)
         ";"
         (rtos angus 2 4)
         )
       )
     )
    )
  ;;Eliminadas por redundancia
   ;(setvar "HIGHLIGHT" 1)
   ;(setvar "CMDECHO" 0)
  ;;Respecto a lo que viena a continuación,
  ;;supongo que estas unidades son las que utilizas.
  ;;Si las tienes predefinidas, volviendo las variables
  ;;a inicio no sería necesario el comando.
  ;;Si lo utiliza otra persona, le estás cambiando
  ;;sus estándares...
   ;(command "-UNIDADES" "2" "4" "2" "5" "0" "N")
  ;;Lo que viene a continuación:
  ;;1º- Borrar el fichero donde se ha escrito temporalmente el DCL.
  (if dcl (vl-file-delete dcl))
  ;;2º- Dejar las variables como estaban.
  (setvar "CMDECHO" cmd)
  (setvar "OSMODE" osm)
  (setvar "ORTHOMODE" ort)
  (setvar "ANGDIR" agd)
  (setvar "ANGBASE" agb)
  (setvar "HIGHLIGHT" hlg)  
  ;;3º- Dejar la función de *error* como estaba.
  (setq *error* err)
  (princ)
  )
(prompt "\n***Nuevo Comando ANG+LINEA  definido***")
(prin1)


Otra forma de unir el DCL con el LSP sería compilarlo como VLX.

Un saludo,

El lisp funciona de una.
Gracias Maestro siempre aportando para con este foro.
Un saludo
Luis