CD Actual 9/CDACTUAL9.iso/share/Dos/VARIOS/acad/DLINE.LSP

Text File | 1993-07-19 | 67.7 KB | 2,143 lines

;;;   TRANSREV  08/05/92  By: Jose M. Calahorra
;;;   DLINE.LSP
;;;   Copyright (C) 1990-1992 by Autodesk, Inc.
;;;
;;;   Este programa es propiedad intelectual de Autodesk siendo
;;;   licenciado para su uso bajo los siguientes condiciones:
;;;   - La distribución o publicación del código fuente del programa
;;;   queda totalmente prohibida.
;;;   - La incorporación del código objeto de este programa en sus
;;;   trabajos esta permitida siempre que se cumplan las siguientes
;;;   condiciones:  a) sean diseñados y vayan a ser empleados
;;;   exclusivamente con productos de Autodesk;  b) aparezca la marca
;;;   de propiedad intelectual de Autodesk  ((C) Copyright 1988-1992
;;;   by Autodesk, Inc).
;;;
;;;   AUTODESK SUMINISTRA ESTOS MATERIALES "TAL COMO ESTAN",
;;;   ES DECIR QUE SU SUMINISTRO NO IMPLICA NINGUN TIPO DE GARANTIA,
;;;   NI EXPRESA NI IMPLICITA, INCLUYENDO -PERO SIN LIMITARSE
;;;   A ELLAS- LAS RELATIVAS AL CUMPLIMIENTO DE CRITERIOS COMERCIALES
;;;   Y A LA ADECUACION DE PROPOSITOS PARTICULARES.
;;;
;;;   DESCRIPTION
;;;
;;;     This is a general purpose "double-line/arc" generator.  It performs
;;;     automatic corner intersection cleanups, as well as a number of other
;;;     features described below.
;;;
;;;     The user is prompted for a series of endpoints.  As they are picked
;;;     "DLINE"  segments are drawn on the current layer.  Options are
;;;     available for changing the Width of the DLINE, specifying whether
;;;     or not to Snap to existing lines or arcs, whether or not to
;;;     Break the lines or arcs when snapping to them, and which of the
;;;     following to do:
;;;
;;;     Set the global variable dl:ecp to the values listed below:
;;;
;;;     Value  Meaning
;;;     ---------------------------
;;;       0    No end caps
;;;       1    Start end cap only
;;;       2    Ending end cap only
;;;       3    Both end caps
;;;       4    Auto ON -- Cap any end not on a line or arc.
;;;
;;;     The user may choose to back up as far as the beginning of the command
;;;     by typing "U" or "Undo", both of which operate as AutoCAD's "UNDO 1"
;;;     does.
;;;
;;;     Curved DLINE's are drawn using the AutoCAD ARC command and follow as
;;;     closely as possible its command structure for the various options.
;;;
;;;----------------------------------------------------------------------------
;;;   OPERATION
;;;
;;;     The routine is executed, after loading, by typing either DL or DLINE
;;;     at which time you are presented with the opening line and menu of
;;;     choices:
;;;
;;;       Dline, Version 1.11, (c) 1990-1992 by Autodesk, Inc.
;;;       Break/Caps/Dragline/Offset/Snap/Undo/Width/<start point>:
;;;
;;;     Typing Break allows you to set breaking of lines and arcs found at
;;;     the start and end points of any segment either ON or OFF.
;;;
;;;       Break Dline's at start and end points?  OFF/<ON>:
;;;
;;;     Typing Caps allows you to specify how the DLINE will be finished
;;;     off when exiting the routine, per the values listed above.
;;;
;;;       Draw which endcaps?  Both/End/None/Start/<Auto>:
;;;
;;;     The default of Auto caps an end only if you did not snap to an arc
;;;     or line.
;;;
;;;     Typing Dragline allows you to set the location of the dragline
;;;     relative to the centerline of the two arcs or lines to any value
;;;     between - 1/2 of "tracewid" and + 1/2 of "tracewid".  (There is a
;;;     local variable you may set if you want to experiment with offsets
;;;     outside this range;  the results may not be correct, your choice.
;;;     See the function (dl_sao) for more information.)
;;;
;;;       Set dragline position to Left/Center/Right/<Offset from center = 0.0>:
;;;
;;;     Enter any real number or one of the keywords.  The value in the angle
;;;     brackets is the default value and changes as you change the dragline
;;;     position.
;;;
;;;     Offset allows the first point you enter to be offset from a known
;;;     point.
;;;
;;;       Offset from:  (enter a point)
;;;       Offset toward:    (enter a point)
;;;       Enter the offset distance:   (enter a distance or real number)
;;;
;;;     Snap allows you to set the snapping size and turn snapping ON or OFF.
;;;
;;;       Set snap size or snap On/Off.  Size/OFF/<ON>:
;;;       New snap size (1 - 10):
;;;
;;;     The upper limit may be reset by changing the value of MAXSNP to a
;;;     value other than 10.  Higher values may be necessary for ADI display
;;;     drivers, but generally, you should keep this value somewhere in the
;;;     middle of the allowed range for snapping to work most effectively
;;;     in an uncluttered drawing, and toward the lower end for a more
;;;     cluttered drawing.  You may also use object snap to improve your
;;;     aim.
;;;
;;;     This feature allows you to very quickly "snap" to another line or arc,
;;;     breaking it at the juncture and performing all of the intersection
;;;     cleanups at one time without having to be precisely on the line, i.e.,
;;;     you can be visually one the line and it will work, or you can use
;;;     object snap to be more precise.
;;;
;;;     Undo backs you up one segment in the chain of segments you are drawing,
;;;     stopping when there are no more segments to be undone.  All of the
;;;     necessary points are saved in lists so that the DLINE will close, cap,
;;;     and continue correctly after any number of undo's.
;;;
;;;     Width prompts you for a new width.
;;;
;;;       New DLINE width <1.0000>:
;;;
;;;     You may enter a new width and continue the DLINE in the same direction
;;;     you were drawing before;  if you do this, connecting lines from the
;;;     endpoints of the previous segment are drawn to the start points of
;;;     the new segment.
;;;
;;;     If you press RETURN after closing a DLINE or before creating any
;;;     DLINE's, you will see this message:
;;;
;;;       No continuation point -- please pick a point.
;;;       Break/Caps/Dragline/Offset/Snap/Undo/Width/<start point>:
;;;
;;;     After you pick the first point, you will see this set of options:
;;;
;;;       Arc/Break/CAps/CLose/Dragline/Snap/Undo/Width/<next point>:
;;;
;;;     Picking more points will draw straight DLINE segments until either
;;;     RETURN is pressed or the CLose option is chosen.
;;;
;;;     CLose will close the lines if you have drawn at least two segments.
;;;
;;;     Selecting Arc presents you with another set of choices:
;;;
;;;       Break/CAps/CEnter/CLose/Dragline/Endpoint/Line/Snap/Undo/Width/<second point>:
;;;
;;;     All of the options here are the same as they are for drawing straight
;;;     DLINE's except CEnter, Endpoint, and Line.
;;;
;;;     The default option, CEnter, and Endpoint are modeled after the ARC
;;;     command in AutoCAD and exactly mimic its operation including all of
;;;     the subprompts.  Refer to the AutoCAD reference manual for exact usage.
;;;
;;;     The Line option returns you to drawing straight DLINE segments.
;;;
;;;     Snapping to existing LINE's an ARC's accomplishes all of the trimming
;;;     and extending of lines and arcs necessary, including cases where arcs
;;;     and lines do not intersect.  In these cases a line is drawn from either;
;;;     a point on the arc at the perpendicular point from the center of the
;;;     arc to the line, to the line, or along the line from the centers of the
;;;     two arcs that do not intersect at the points where this line crosses
;;;     the two arcs.  In this way, we ensure that all DLINE's can be closed
;;;     visually.
;;;
;;;     Breaking will not work unless Snapping is turned on.
;;;
;;;----------------------------------------------------------------------------
;;;  GLOBALS:
;;;     dl:osd -- dragline alignment offset from center of two lines or arcs.
;;;     dl:snp -- T if snapping to existing lines and arcs.
;;;     dl:brk -- T if breaking existing lines and arcs.
;;;     dl:ecp -- Bitwise setting of caps when exiting.
;;;     v:stpt -- Continuation point.
;;;----------------------------------------------------------------------------
;;;
;;; ===========================================================================
;;; ===================== load-time error checking ============================
;;;

  (defun ai_abort (app msg)
     (defun *error* (s)
        (if old_error (setq *error* old_error))
        (princ)
     )
     (if msg
       (alert (strcat " Error de la aplicación: "
                      app
                      " \n\n  "
                      msg
                      "  \n"
              )
       )
     )
     (exit)
  )

;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.

  (cond
     (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.

     (  (not (findfile "ai_utils.lsp"))                     ; find it
        (ai_abort "DLINE"
                  (strcat "No encuentro el fichero AI_UTILS.LSP."
                          "\n Verifique el directorio support.")))

     (  (eq "failed" (load "ai_utils" "failed"))            ; load it
        (ai_abort "DLINE" "No puedo cargar el fichero AI_UTILS.LSP"))
  )

  (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
      (ai_abort "DLINE" nil)         ; a Nil <msg> supresses
  )                                    ; ai_abort's alert box dialog.

;;; ==================== end load-time operations ===========================
;;; Main function

(defun dline  (/ strtpt nextpt pt1    pt2    spts   wnames elast
                 uctr   pr     prnum  temp   ans    dir    ipt
                 v      lst    dist   cpt    rad    orad   ftmp
                 spt    ept    pt     en1    en2    npt    cpt1
                 flg    cont   flg2   flgn   ang    tmp    undo_setting
                 brk_e1 brk_e2 bent1  bent2  nn     nnn
                 dl_osm dl_oem dl_oce dl_opb dl_obm dl_ver
                 dl_err dl_oer dl_arc fang   MAXSNP ange
                 savpt1 savpt2 savpt3 savpt4 savpts
              )

  ;; Version number.  Reset this local if you make a change.
  (setq dl_ver "1.11")

  ;; Reset this value higher for ADI drivers.
  (setq MAXSNP 10)

  (setq dl_osm (getvar "osmode")
        dl_oce (getvar "cmdecho")
        dl_opb (getvar "pickbox")
  )
  ;; poner grosor en 0.25
  (if (= (getvar "tracewid") 1) (setvar "tracewid" 0.25))

  ;;
  ;; Internal error handler defined locally
  ;;

  (defun dl_err (s)                   ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
    (if (/= s "Función cancelada")
      (if (= s "quit / exit abort")
        (princ)
        (princ (strcat "\nError: " s))
      )
    )
    (command "_.UNDO" "_EN")
    (ai_undo_off)
    (if dl_oer                        ; If an old error routine exists
      (setq *error* dl_oer)           ; then, reset it
    )
    (if dl_osm (setvar "osmode" dl_osm))
    (if dl_opb (setvar "pickbox" dl_opb))

    ;; Reset command echoing on error
    (if dl_oce (setvar "cmdecho" dl_oce))
    (princ)
  )

  ;; Set our new error handler
  (if (not *DEBUG*)
    (if *error*
      (setq dl_oer *error* *error* dl_err)
      (setq *error* dl_err)
    )
  )

  (setvar "cmdecho" 0)
  (ai_undo_on)                       ; Turn on UNDO
  (command "_.UNDO" "_GROUP")
  (setvar "osmode" 0)
  (if (null dl:opb) (setq dl:opb (getvar "pickbox")))


  (setq nextpt "Straight")

  ;; Get the first segment's start point

  (menucmd "s=dline1")
  (graphscr)
  (princ (strcat "\nDline, Versión " dl_ver ", (c) 1990-1992 por Autodesk, Inc. "))

  (setq cont T)
  (while cont
    (dl_m1)

    ;; Ready to draw successive DLINE segments

    (dl_m2)
  )

  (if dl_osm (setvar "osmode" dl_osm))
  (if dl_opb (setvar "pickbox" dl_opb))

  (ai_undo_off)                      ; Return UNDO to initial state

  ;; Reset command echoing
  (if dl_oce (setvar "cmdecho" dl_oce))
  (menucmd "s=s")
  (princ)
)
;;;
;;; Main function subsection 1.
;;;
;;; dl_m1 == DLine_Main_1
;;;
(defun dl_m1 ()
  (setq temp T
        uctr nil
  )
  (if dl_arc
    (setq nextpt "Arco")
    (setq nextpt "Línea")
  )
  ;; temp set to nil when a valid point is entered.
  (while temp
    (initget "Parte reMates arraStre Desplaza Forzcoor Revoca Grosor")
    (setq strtpt (getpoint
      "\nParte/reMates/arraStre/Desplaza/Forzcoor/Revoca/Grosor/<punto inicial>: "))
    (cond
      ((= strtpt "arraStre")
        (dl_sao)
      )
      ((= strtpt "Parte")
        (initget "ACT DES")
        (setq dl:brk (getkword
          "\n¿Partir Dline en los puntos inicial y final?  DES/<ACT>: "))
        (setq dl:brk (if (= dl:brk "DES") nil T))
      )
      ((= strtpt "Desplaza")
        (dl_ofs)
      )
      ((= strtpt "Forzcoor")
        (dl_sso)
      )
      ((= strtpt "Revoca")
        (princ "\nTodos los segmentos ya revocados. ")
        (setq temp T)
      )
      ((= strtpt "Grosor")
        (initget 6)
        (dl_snw)
        (setq temp T)
      )
      ((null strtpt)
        (if v:stpt
          (setq strtpt v:stpt
                temp   nil
          )
          (progn
            (princ "\nNo hay punto de continuación -- designar un punto. ")
          )
        )
      )
      ((= strtpt "reMates")
        (endcap)
      )
      ;; If none of the above, it must be OK to continue - a point has been
      ;; picked or entered from the keyboard.
      (T
        (setq v:stpt strtpt
              temp   nil
        )
      )
    )
  )
)
;;;
;;; Main function subsection 2.
;;;
;;; dl_m3 == DLine_Main_2
;;;
(defun dl_m2 (/ temp)
  (setq spts (list strtpt)
        uctr 0
  )
  (if dl:snp
    (dl_ved "brk_e1" strtpt)
  )
  ;; Make sure that the offset is not greater than 1/2 of "tracewid", even
  ;; if the user transparently resets it while the command is running.
  (setq temp (/ (getvar "tracewid") 2.0))
  (if (< dl:osd (- temp))
    (setq dl:osd (- temp))
  )
  (if (> dl:osd temp)
    (setq dl:osd temp)
  )

  (while (and nextpt (/= nextpt "CIerra"))
    (if (/= nextpt "Quita")
      (if dl_arc
        (progn
          (menucmd "s=dline2")
          (initget
            "Parte reMates CEntro CIerra arraStre pTofinal Línea Forzcoor Revoca Grosor")
          (setq nextpt (getpoint strtpt (strcat
            "\nParte/reMates/CEntro/CIerra/arraStre/pTofinal/"
            "Línea/Forzcoor/Revoca/Grosor/<segundo punto>: "))
          )
        )
        (progn
          (menucmd "s=dline3")
          (initget "Arco Parte reMates CIerra arraStre Forzcoor Revoca Grosor")
          (setq nextpt (getpoint strtpt
            "\nArco/Parte/reMates/CIerra/arraStre/Forzcoor/Revoca/Grosor/<Siguiente punto>: ")
          )
        )
      )
    )
    (setq v:stpt (last spts))
    (cond
      ((= nextpt "arraStre")
        (dl_sao)
      )
      ((= nextpt "Grosor")
        (dl_snw)

      )
      ((= nextpt "Revoca")
        (cond
          ;;((= uctr 0) (princ "\nNothing to undo. ") )
          ((= uctr 0) (setq nextpt nil) )
          ((> uctr 0)
            (command "_.U")
            (setq spts   (dl_lsu spts 1))
            (setq savpts (dl_lsu savpts 2))
            (setq wnames (dl_lsu wnames 2))
            (setq uctr (- uctr 2))
            (setq strtpt (last spts))
          )
        )
        (if dl:snp
          (if (= uctr 0)
            (dl_ved "brk_e1" strtpt)
          )
        )
      )
      ((= nextpt "Parte")
        (initget "ACT DES")
        (setq dl:brk (getkword
          "\n¿Partir Dline en los puntos inicial y final?  DES/<ACT>: "))
        (setq dl:brk (if (= dl:brk "DES") nil T))

        (if dl:snp
          (dl_ved "brk_e1" strtpt)
        )
        (if dl_arc
          (setq nextpt "Arco")
          (setq nextpt "Línea")
        )
      )
      ((= nextpt "Forzcoor")
        (dl_sso)
      )
      ((= nextpt "Arco")
        (setq dl_arc T)               ; Change to Arc segment prompt.
      )
      ((= nextpt "Línea")
        (setq dl_arc nil)             ; Change to Line segment prompt.
      )
      ((= nextpt "CIerra")
        (dl_cls)
      )
      ((= (type nextpt) 'LIST)
        (dl_ds)
      )
      ((= nextpt "CEntro")
        (dl_ceo)
      )
      ((= nextpt "pTofinal")
        (dl_epo)
      )
      ((= nextpt "reMates")
        (endcap)                      ; Set which caps to draw when exiting.
      )
      (T
        (setq nextpt nil cont nil)
        (if (> uctr 1)
          (if (= (logand 4 dl:ecp) 4)
            (progn
              (if (null brk_e1) (command "_.LINE" savpt1 savpt2 ""))
              (dl_ssp)
              (if (null brk_e2) (command "_.LINE" savpt3 savpt4 ""))
            )
            (progn
              (if (= (logand 1 dl:ecp) 1)
                (command "_.LINE" savpt1 savpt2 "")
              )
              (if (= (logand 2 dl:ecp) 2)
                (progn
                  (dl_ssp)
                  (command "_.LINE" savpt3 savpt4 "")
                )
              )
            )
          )
        )
        (if brk_e1 (setq brk_e1 nil))
        (if brk_e2 (setq brk_e2 nil))
        (command "_.UNDO" "_EN")
      )                               ; end of inner cond
    )                                 ; end of outer cond
  )                                   ; end of while
)
;;; ------------------ End Main Functions ---------------------------
;;; ---------------- Begin Support Functions ------------------------


;;;
;;; Close the DLINE with either straight or arc segments.
;;; If closing with arcs, the minimum number of segments already drawn
;;; is 1, otherwise it is 2.
;;;
;;; dl_cls == DLine_CLose_Segments
;;;
(defun dl_cls ()
  (if (or (and (null dl_arc) (< uctr 4)
               (if (> uctr 1)
                 (/= (dl_val 0 (entlast)) "ARC")
                 (not (> uctr 1))
               )
          )
          (and dl_arc (< uctr 2)))
    (progn
      (princ "\nImposible cerrar -- pocos segmentos. ")
      (if dl_arc
        (setq nextpt "Arc")
        (setq nextpt "Line")
      )
    )
    (progn
      (command "_.UNDO" "_GROUP")
      (setq nextpt (nth 0 spts))
      (if (null dl_arc)
        ;; Close with line segments
        (dl_mlf 3)
        (progn
          (setq tmp (last wnames)
                ange (trans '(1 0 0) (dl_val -1 tmp) 1)
                ange (angle '(0 0 0) ange)
                dir (if (= (dl_val 0 tmp) "LINE")
                      (angle (trans (dl_val 10 tmp) 0 1)
                             (trans (dl_val 11 tmp) 0 1))
                      (progn
                        (setq dir (+ (dl_val 50 tmp) ange)
                              dir (if (> dir (* 2 pi))
                                    (- dir (* 2 pi))
                                    dir
                                  )
                        )
                        (if (equal dir
                                   (setq dir (angle (trans (dl_val 10 tmp)
                                                           (dl_val -1 tmp)
                                                           1)
                                                    strtpt
                                             )
                                   )
                                   0.01)
                          (- dir (/ pi 2))
                          (+ dir (/ pi 2))
                        )
                      )
                    )
          )
          (command "_.ARC"
                   strtpt
                   "_E"
                   nextpt
                   "_D"
                   (* dir (/ 180 pi))
          )
          ;; Close with arc segments
          (dl_mlf 4)
        )
      )
      ;; set nextpt to "CLose" which will cause an exit.
      (setq nextpt "CIerra"
            v:stpt nil
            cont   nil
      )
    )
  )
)
;;;
;;; A point was entered, do either an arc or line segment.
;;;
;;; dl_ds == DLine_Do_Segment
;;;
(defun dl_ds ()
  (if (equal strtpt nextpt 0.0001)
    (progn
      (princ "\nLos puntos coinciden -- intentar de nuevo. ")
      (if dl_arc
        (setq nextpt "Arc")
        (setq nextpt "Line")
      )
    )
    (progn
      (command "_.UNDO" "_GROUP")
      (setq nextpt (list (car nextpt) (cadr nextpt) (caddr strtpt)))
      (if dl_arc
        (progn
          (command "_.ARC" strtpt nextpt)
          (prompt "\nPunto final: ")
          (command pause)
          (setq nextpt (getvar "lastpoint")
                v:stpt nextpt)
          (setq temp (entlast))
          ;; Delete the last arc segment so we can find the line or
          ;; arc under it.
          (entdel temp)
          (if dl:snp
            (dl_ved "brk_e2" nextpt)
          )
          ;; Restore the arc previously deleted.
          (entdel temp)
          ;; Draw the arc segments.
          (dl_mlf 2)
        )
        (progn
          (setq v:stpt nextpt)
          (if dl:snp
            (dl_ved "brk_e2" nextpt)
          )
          (if (and brk_e1 (eq brk_e1 brk_e2) (= (dl_val 0 brk_e1) "LINE"))
            (progn
              (princ "\nEl segundo punto no puede estar en el mismo segmento de línea. ")
              (setq brk_e2 nil)
            )
            ;; Draw the line segments.
            (dl_mlf 1)
          )
        )
      )
      (if brk_e2 (setq nextpt "Quit"))
    )
  )
)
;;;
;;; The CEnter option for drawing arc segments was selected.
;;;
;;; dl_ceo == DLine_CEnter_Option
;;;
(defun dl_ceo ()
  (command "_.UNDO" "_GROUP")
  (setq temp T)
  (while temp
    (initget 1)
    (setq cpt (getpoint strtpt "\nCEntro: "))
    (if (<= (distance cpt strtpt) (- (/ (getvar "tracewid") 2.0) dl:osd))
      (progn
        (princ
        "\nEl radio definido por el centro designado es damasiado pequeño ")
        (princ "\npara el grosor actual de Dline.  ")
        (princ "Designar otro punto.")
      )
      (setq temp nil)
    )
  )
  ;; Start the ARC command so that we can get visual dragging.
  (command "_.ARC" strtpt "_C" cpt)
  (initget "Angulo Longitud punto Final")
  (setq nextpt (getkword "\nAngulo/Longitud de cuerda/<punto Final>: "))
  (cond
    ((= nextpt "Angulo")
      (prompt "\nAngulo incluido: ")
      (command "_A" pause)
      (setq nextpt (dl_vnp)
            v:stpt nextpt
      )
      ;; Draw the arc segments.
      (dl_mlf 2)
    )
    ((= nextpt "Longitud")
      (prompt "\nLongitud de cuerda: ")
      (command "_L" pause)
      (setq nextpt (dl_vnp)
            v:stpt nextpt
      )
      ;; Draw the arc segments.
      (dl_mlf 2)
    )
    (T
      (prompt "\nPunto final: ")
      (command pause)
      (setq nextpt (dl_vnp)
            v:stpt nextpt
      )
      ;; Draw the arc segments.
      (dl_mlf 2)
    )
  )
)
;;;
;;; Endpoint option was selected.
;;;
;;; dl_epo == DLine_End_Point_Option
;;;
(defun dl_epo ()
  (command "_.UNDO" "_GROUP")
  (initget 1)
  (setq cpt (getpoint "\nPunto final: "))
  ;; Start the ARC command so that we can get visual dragging.
  (command "_.ARC" strtpt "_E" cpt)
  (initget "Angulo Dirección Radio Centro")
  (setq nextpt (getkword "\nAngulo/Dirección/Radio/<Centro>: "))
  (cond
    ((= nextpt "Angulo")
      (prompt "\nAngulo incluido: ")
      (command "_A" pause)
      (setq nextpt (dl_vnp)
            v:stpt nextpt
      )
      ;; Draw the arc segments.
      (dl_mlf 2)
    )
    ((= nextpt "Dirección")
      (prompt "\nDirección de tangente: ")
      (command "_D" pause)
      (setq nextpt (dl_vnp)
            v:stpt nextpt
      )
      ;; Draw the arc segments.
      (dl_mlf 2)
    )
    ((= nextpt "Radio")
      (setq temp T)
      (while temp
        (initget 1)
        (setq rad (getdist cpt "\nRadio: "))

        (if (or (<= rad (/ (getvar "tracewid") 2.0))
                (< rad (/ (distance strtpt cpt) 2.0)))
          (progn
            (princ "\nRadio introducido menor que la 1/2 ")
            (princ "del grosor de Dline o no es válido")
            (princ "\npara los extremos designados.  ")
            (princ "Introducir un radio mayor que ")
            (if (< (/ (getvar "tracewid") 2.0)
                   (/ (distance strtpt cpt) 2.0))
              (princ (rtos (/ (distance strtpt cpt) 2.0)))
              (princ (rtos (/ (getvar "tracewid") 2.0)))
            )
            (princ ". ")
          )
          (setq temp nil)
        )
      )
      (command "_R" rad)
      (setq nextpt (dl_vnp)
            v:stpt nextpt
      )
      ;; Draw the arc segments.
      (dl_mlf 2)
    )
    (T
      (prompt "\nCentro: ")
      (command pause)
      (setq nextpt (dl_vnp)
            v:stpt nextpt
      )
      ;; Draw the arc segments.
      (dl_mlf 2)
    )
  )
)
;;;
;;; Set the ending save points for capping the DLINE.
;;;
;;; dl_ssp == DLine_Set_Save_Points
;;;
(defun dl_ssp ( / temp)
  (setq temp (length savpts))
  (if (> temp 1)
    (progn
      (setq savpt3 (nth (- temp 2) savpts)
            savpt4 (nth (- temp 1) savpts)
      )
    )
  )
)
;;;
;;; Set the alignment of the "ghost" line to one of the following values:
;;;
;;;   Left   == -1/2 of width (Real number)
;;;           > -1/2 of width (Real number)
;;;   Center == 0.0
;;;           < +1/2 of width (Real number)
;;;   Right  == +1/2 of width (Real number)
;;;
;;; All of the alignment options are taken as if you are standing at the
;;; start point of the line or arc looking toward the end point, with
;;; left and negative values being on the left, center or 0.0 being
;;; directly in line, and right or positive on the right.
;;;
;;; Entering a real number equal to 1/2 of the width sets an absolute offset
;;; distance from the centerline, while specifying the same offset distance
;;; with the keywords tells the routine to change the offset distance to
;;; match 1/2 of the width, whenever it is changed.
;;;
;;; NOTE:  If you wish to allow the dragline to be positioned outside
;;;      of the two arcs or lines being created, you may set the local
;;;      variable "dragos" = T, on the 4th line of the defun, which
;;;      checks that the offset value entered is not greater or less
;;;      than + or - TRACEWID / 2.
;;;
;;;      You should be aware that the results of allowing this to occur
;;;      may not be obvious or necessarily correct.  Specifically, when
;;;      drawing lines with a width of 1 and an offset of 4, if you draw
;;;      segments as follows, the lines will cross back on themselves.
;;;
;;;      dl 0,0,0 10,0,0 10,5 then 5,5
;;;
;;;      However, this can be quite useful for creating parallel DLINE's.
;;;
;;; dl_sao == DLine_Set_Alignment_Option
;;;
(defun dl_sao (/ temp dragos)
  (initget "Izquierda Centro Derecha")
  (setq temp dl:osd)
  ;;(setq dragos T)                   ; See note above.
  (setq dl:osd (getreal (strcat
    "\nEstablecer posición de arrastre Izquierda/Centro/Derecha/<Distancia del centro = "
    (rtos dl:osd) ">: ")))
  (cond
    ((= dl:osd "Izquierda")
      (setq dl:aln 1
            dl:osd (- (/ (getvar "tracewid") 2.0))
      )
    )
    ((= dl:osd "Centro")
      (setq dl:aln 0
            dl:osd 0.0
      )
    )
    ((= dl:osd "Derecha")
      (setq dl:aln 2
            dl:osd (/ (getvar "tracewid") 2.0)
      )
    )
    ((= (type dl:osd) 'REAL)
      (if dragos
        (setq dl:aln nil)
        (progn
          (setq dl:aln nil)
          (if (> dl:osd (/ (getvar "tracewid") 2.0))
            (progn
              (princ "\nEl valor se encuentra fuera de rango.  Redefinir en ")
              (princ (/ (getvar "tracewid") 2.0))
              (setq dl:osd (/ (getvar "tracewid") 2.0))
            )
          )
          (if (< dl:osd (- (/ (getvar "tracewid") 2.0)))
            (progn
              (princ "\nEl valor se encuentra fuera de rango.  Redefinir en ")
              (princ (- (/ (getvar "tracewid") 2.0)))
              (setq dl:osd (- (/ (getvar "tracewid") 2.0)))
            )
          )
        )
      )
    )
    (T
      (setq dl:osd temp)
    )
  )
)
;;;
;;; Set a new DLINE width.
;;;
;;; dl_snw == DLine_Set_New_Width
;;;
(defun dl_snw ()
  (initget 6)
  (setvar "tracewid"
    (if (setq temp (getdist (strcat
      "\nNuevo grosor de DLINE <" (rtos (getvar "tracewid")) ">: ")))
      temp
      (getvar "tracewid")
    )
  )
  (if dl:aln
    (cond
      ((= dl:aln 1) ; left aligned
        (setq dl:osd (- (/ (getvar "tracewid") 2.0)))
      )
      ((= dl:aln 2) ; right aligned
        (setq dl:osd (/ (getvar "tracewid") 2.0))
      )
      (T
        (princ)     ; center aligned
      )
    )
  )
)
;;;
;;; Get an offset from a given point to the start point toward a second
;;; point.  The distance between the two points is the default, but any
;;; positive distance may be entered.  If a negative number is entered,
;;; it is used as a percentage distance from the "Offset from" point
;;; toward the "Offset toward" point, i.e., if -75 is entered, a point
;;; 75% of the distance between the two points listed above is returned.
;;;
;;;
;;; dl_ofs == DLine_OFfset_Startpoint
;;;
(defun dl_ofs ()
  (menucmd "s=osnapb")
  (initget 1)
  (setq strtpt (getpoint "\nDesplaza de: "))
  (initget 1)
  (setq nextpt (getpoint strtpt "\nDesplaza hacia: "))

  (setq dist (getdist strtpt (strcat
    "\nDistancia de desplazamiento <" (rtos (distance strtpt nextpt))
    ">: ")))
  (setq dist (if (or (= dist "") (null dist))
               (distance strtpt nextpt)
               (if (< dist 0)
                 (* (distance strtpt nextpt) (/ (abs dist) 100.0))
                 dist
               )
             )
  )
  (setq strtpt (polar strtpt
                      (angle strtpt nextpt)
                      dist
               )
  )
  (setq temp nil)
  (command "_.UNDO" "_GROUP")
)
;;;
;;; Set snap options to ON, OFF or set the size of the area to be searched
;;; by (ssget point) via "pickbox".  This value is being limited for built-
;;; in display drivers at 10 pixels.  For ADI drivers it may be necessary
;;; to bump up this number by adjusting "MAXSNP" at the top of this file.
;;;
;;; dl_sso == DLine_Set_Snap_Options
;;;
(defun dl_sso ()
  (initget "ACT DES Intérvalo")
  (setq ans (getkword
    "\nDefinir Intérvalo de forzcoor o forzcoor ACT/DES.  Intérvalo/DES/<ACT>: "))
  (if (= ans "DES")
    (progn
      (setq dl:snp nil)
      (setvar "pickbox" 0)
    )
    (if (= ans "Intérvalo")
      (progn
        (setq dl:snp T ans 0)
        (while (or (< ans 1) (> ans MAXSNP))
          (setq ans (getint (strcat
            "\nNuevo intérvalo (1 - " (itoa MAXSNP) ") <" (itoa dl:opb) ">: ")))

          (if (or (= ans "") (null ans))
            (setq ans dl:opb)
          )
        )
        (setvar "pickbox" ans)
        (setq dl:opb ans)
      )
      (progn
        (setq dl:snp T)
        (setvar "pickbox" dl:opb)
      )
    )
  )
  (if dl:snp
    (if (= uctr 0)
      (dl_ved "brk_e1" strtpt)
    )
  )
  (if dl_arc
    (setq nextpt "Arc")
    (setq nextpt "Line")
  )

)
;;;
;;; Obtain and verify the extrusion direction of an entity at the
;;; start point or endpoint of the line or arc we are drawing.
;;;
;;; dl_ved == DLine_Verify_Extrusion_Direction
;;;
(defun dl_ved (vent pt)
  ;; Get entity to break if the user snapped to a DLINE.
  ;; Make sure that it is a line or arc and that its extrusion
  ;; direction is parallel to the current UCS.
  (if (set (read vent) (ssget pt))
    (progn
      (set (read vent) (ssname (eval (read vent)) 0))
      (if (and
            (or (= (dl_val 0 (eval (read vent))) "ARC")
                (= (dl_val 0 (eval (read vent))) "LINE")
            )
            (equal (caddr(dl_val 210 (eval (read vent))))
                   (caddr(trans '(0 0 1) 1 0)) 0.001)
          )
        (princ)
        (progn
          (princ (strcat
            "\nEntity found is not an arc or line, "
            "or is not parallel to the current UCS. "))
          (set (read vent) nil)
        )
      )
    )
  )
  (eval (read vent))
)
;;;
;;; Verify nextpt.
;;; Get the point on the arc at the opposite
;;; end from the start point (strtpt).
;;;
;;; dl_vnp == DLine_Verify_NextPt
;;;
(defun dl_vnp (/ temp cpt ang rad)

  (setq temp (entlast))
  (if (= (dl_val 0 temp) "LINE")
    (setq nextpt (if (equal strtpt (dl_val 10 temp) 0.001)
                   (dl_val 11 temp)
                   (dl_val 10 temp)
                 )
    )
    ;; Then it must be an arc...
    (progn
      ;; get its center point
      (setq cpt  (trans (dl_val 10 temp) (dl_val -1 temp) 1)
            ang  (dl_val 50 temp)     ; starting angle
            rad  (dl_val 40 temp)     ; radius
      )
      (setq ange (trans '(1 0 0) (dl_val -1 temp) 1)
            ange (angle '(0 0 0) ange)
            ang (+ ang ange)
      )
      (if (> ang (* 2 pi))
        (setq ang (- ang (* 2 pi)))
      )
      (setq nextpt (if (equal strtpt (polar cpt ang rad) 0.01)
                     (polar cpt (dl_val 51 temp) rad)
                     (polar cpt ang rad)
                   )
      )
    )
  )
)
;;; ----------------- Main Line Drawing Function -------------------
;;;
;;; Draw the lines.
;;;
;;; dl_mlf == DLine_Main_Line_Function
;;;
(defun dl_mlf (flg / temp1 temp2 newang ang1 ang2
                     ent cpt ang rad1 rad2 sent1 sent2
                     tmpt1 tmpt2 tmpt3 tmpt4)

  ;; Verify nextpt
  (if (null nextpt) (setq nextpt (dl_vnp)))

  (if (equal nextpt (nth 0 spts) 0.01)
    (if dl_arc
      (setq flg 4)
      (setq flg 3)
    )
  )

  (setq temp1  (+ (/ (getvar "tracewid") 2.0) dl:osd)
        temp2  (- (getvar "tracewid") temp1)
        newang (angle strtpt nextpt)
        ang1   (+ (angle strtpt nextpt) (/ pi 2))
        ang2   (- (angle strtpt nextpt) (/ pi 2))
  )
  (cond
    ((= flg 1)                        ; if drawing lines
      (dl_dls nil ang1 temp1)         ; Draw line segment 1
      (dl_dls nil ang2 temp2)         ; Draw line segment 2
    )
    ((or (= flg 2) (= flg 4))         ; else drawing arcs...
      (setq tmp (entlast)             ; get the last arc entity
            ent  (entget tmp)         ; (i.e., the guideline)
            ;; get its center point
            cpt  (trans (dl_val 10 tmp) (dl_val -1 tmp) 1)
            ang  (dl_val 50 tmp)      ; starting angle
      )
      (setq ange (trans '(1 0 0) (dl_val -1 tmp) 1)
            ange (angle '(0 0 0) ange)
            ang (+ ang ange)
      )
      (if (> ang (* 2 pi))
        (setq ang (- ang (* 2 pi)))
      )

      ;; if start angle needs revision
      (if (equal (angle cpt strtpt) ang 0.01)
        (progn
          ;; Start angle needs revision.
          (setq strt_a T
                rad1  (+ (dl_val 40 tmp) temp2) ; outer radius
                rad2  (- (dl_val 40 tmp) temp1) ; inner radius
          )
          (setq ent (subst (cons 40 rad2) ; modify its radius
                           (assoc 40 ent)
                           ent))
          (entmod ent)
          (dl_atl)                    ; Add ename to list
          (setq save_1 ent)
          (setq sent1 (dl_val -1 tmp))
          (if (= flg 4)
            (if (> uctr 2)
              (dl_das 0 rad2 50)      ; modify arc endpt and close
            )
            (dl_das nil rad2 50)      ; else modify arc endpt
          )
          ;; Create the "parallel" arc
          (command "_.OFFSET" (getvar "tracewid") ; offset the arc
                              (list tmp '(0 0 0))
                              (polar cpt ang (+ 1 rad1 rad2))
                              "")
          (setq tmp (entlast)         ; get the offset arc
                ent  (entget tmp))
          (dl_atl)                    ; Add ename to list
          (setq save_2 ent)
          (setq sent2 tmp)
          (if (= flg 4)
            (if (> uctr 3)
              (progn
                (dl_das 1 rad1 50)    ; modify arc endpt and close

                ;; set nextpt to "CLose" which will cause an exit.
                (setq nextpt "CIerra"
                      v:stpt nil
                      cont   nil
                )
              )
            )
            (dl_das nil rad1 50)      ; else modify arc endpt
          )

        )
        (progn                        ; if end angle needs revision
          ;; End angle needs revision.
          (setq strt_a nil
                rad1  (+ (dl_val 40 tmp) temp1) ; outer radius
                rad2  (- (dl_val 40 tmp) temp2) ; inner radius
          )
          (setq ent (subst (cons 40 rad1) ; modify its radius
                           (assoc 40 ent)
                           ent))
          (entmod ent)
          (dl_atl)                    ; Add ename to list
          (setq save_1 ent)
          (setq sent1 (dl_val -1 tmp))
          (if (= flg 4)
            (if (> uctr 2)
              (dl_das 0 rad1 51)      ; modify arc endpt and close
            )
            (dl_das nil rad1 51)      ; else modify arc endpt
          )
          ;; Create the "parallel" arc
          (command "_.OFFSET" (getvar "tracewid")
                            (list tmp '(0 0 0))
                            cpt
                            "")
          (setq tmp (entlast)         ; get the last arc entity
                ent  (entget tmp))
          (dl_atl)                    ; Add ename to list
          (setq save_2 ent)
          (setq sent2 tmp)
          (if (= flg 4)
            (if (> uctr 3)
              (progn
                (dl_das 1 rad2 51)    ; modify arc endpt and close

                ;; set nextpt to "CLose" which will cause an exit.
                (setq nextpt "CIerra"
                      v:stpt nil
                      cont   nil
                )
              )
            )
            (dl_das nil rad2 51)      ; else modify arc endpt
          )
        )
      )

    )
    ((= flg 3)                        ; if straight closing
      (setq nextpt (nth 0 spts)
            ang1   (+ (angle strtpt nextpt) (/ pi 2))
            ang2   (- (angle strtpt nextpt) (/ pi 2))
      )
      (dl_dls 0 ang1 temp1)
      (dl_dls 1 ang2 temp2)

      ;; set nextpt to "CLose" which will cause an exit.
      (setq nextpt "CIerra"
            v:stpt nil
            cont   nil
      )
    )
    (T
      (princ "\nERROR:  Valor fuera de rango. ")
      (exit)
    )
  )
  (setq strtpt nextpt
        spts   (append spts (list strtpt))
        savpts (append savpts (list savpt3))
        savpts (append savpts (list savpt4))
  )
  (command "_.UNDO" "_E")                ; only end when DLINE's have been drawn
)
;;; ------------------- End Support Functions -----------------------
;;; ---------------- Begin Line Drawing Functions -------------------
;;;
;;; Straight DLINE function
;;;
;;; dl_dls == DLine_Draw_Line_Segment
;;;
(defun dl_dls (flgn ang temp / j k pt1 pt2 tmp1 ent1 p1 p2)

  (mapcar                             ; get endpoints of the offset line
    '(lambda (j k)
       (set j (polar (eval k) ang temp))
     )
     '(pt1 pt2)
     '(strtpt nextpt)
  )
  (cond
    ((= uctr 0)
      ;; Set points 1 and 2 for segment 1.
      (setq p1 (if (dl_l01 brk_e1 "1" pt1 pt2 strtpt) ipt savpt1))
      (setq pt2 (if (dl_l01 brk_e2 "3" pt2 pt1 nextpt) ipt savpt3))
      (setq pt1 p1)
    )
    ((= uctr 1)
      ;; Set points 1 and 2 for segment 2.
      (setq p1 (if (dl_l01 brk_e1 "2" pt1 pt2 strtpt) ipt savpt2))
      (setq pt2 (if (dl_l01 brk_e2 "4" pt2 pt1 nextpt) ipt savpt4))
      (setq pt1 p1)

      ;; Now break the line or arc found at the start point
      ;; if there is one, and we are in a breaking mood.
      (if (and dl:brk brk_e1)
        (progn
          (command "_.BREAK" brk_e1 savpt1 savpt2)
        )
      )
      ;; Now break the line or arc found at the end point
      ;; if there is one, and we are in a breaking mood.
      (if (and dl:brk brk_e2)
        (progn
          (if (eq brk_e1 brk_e2)
            (progn
              ;; Delete first line so we can find the arc or line that
              ;; we found previously.
              (entdel (nth 0 wnames))
              (dl_ved "brk_e2" nextpt)
              ;; Restore first line
              (entdel (nth 0 wnames))
            )
          )
          (command "_.BREAK" brk_e2 savpt3 savpt4)
        )
      )
      ;; Do not set brk_e2 nil... it will be set later.
    )
    ((= (rem uctr 2.0) 0)
      (setq fang nil)
      (setq p1 (dl_dl2 pt1))          ; Draw line part 2
      (setq pt2 (if (dl_l01 brk_e2 "3" pt2 pt1 strtpt)
                  ipt
                  savpt3
                )
      )
      (setq pt1 p1)
      (if flgn                        ; if closing
        (progn
          (setq tmp1 (nth flgn wnames)
                ent1 (entget tmp1)    ; get the corresponding prev. entity
          )
          (if (= (dl_val 0 tmp1) "LINE")
            ;; if it's a line
            (setq pt2 (dl_mls nil 10))
            ;; if it's an arc
            (setq pt2 (dl_mas T nil pt2 pt1 nil))
          )
        )
      )
    )
    (T
      (setq p1 (dl_dl2 pt1))              ; Draw line part 2
      (setq pt2 (if (dl_l01 brk_e2 "4" pt2 pt1 nextpt)
                  ipt
                  savpt4
                )
      )
      (setq pt1 p1)
      (if flgn                        ; if closing
        (progn
          (setq tmp1 (nth flgn wnames)
                ent1 (entget tmp1)    ; get the corresponding prev. entity
                brk_e1 nil
                brk_e2 nil
          )
          (if (= (dl_val 0 tmp1) "LINE")
            ;; if it's a line
            (setq pt2 (dl_mls nil 10))
            ;; if it's an arc
            (setq pt2 (dl_mas T nil pt2 pt1 nil))
          )
        )
      )
      ;; Now break the line or arc found at the end point
      ;; if there is one, and we are in a breaking mood.
      (if (and dl:brk brk_e2)
        (progn
          (command "_.BREAK" brk_e2 savpt3 savpt4)
        )
      )
      ;; Do not set brk_e2 nil... it will be set later.
    )
  )
  (command "_.LINE" pt1 pt2 "")         ; draw the line
  (setq wnames (if (null wnames)
                 (list (setq elast (entlast)) )
                 (append wnames (list (setq elast (entlast)))))
        uctr   (1+ uctr)
  )
  wnames
)
;;;
;;; Set pt1 or pt2 based on whether there is an arc or line to be broken.
;;;
;;; dl_l01 == DLine_draw_Lines_0_and_1
;;;
(defun dl_l01 (bent1 n p1 p2 pt / temp)
  (setq n (strcat "savpt" n))
  (setq spt nil)
  (if bent1
    (if (= (dl_val 0 bent1) "LINE")
      (progn
        (setq temp (inters (trans (dl_val 10 bent1) 0 1)
                            (trans (dl_val 11 bent1) 0 1)
                            p1
                            p2
                            nil
                    )
        )
        (if temp
          (set (read n) temp)
          (progn
            (set (read n) p1)
            (setq brk_e1 nil)
          )
        )
      )
      (progn
        (set (read n) (dl_ial bent1 p1 p2 pt))
        ;; Spt is set only if there was no intersection point.
        (if spt
          (progn
            (setq ipt (eval (read n)))
            (set (read n) spt)
          )
        )
      )
    )
    (set (read n) p1)
  )
  (if spt
    T
    nil
  )
)
;;;
;;; Do more of the line drawing stuff.  This is where we call the modify
;;; functions for the previous arc or line segment.  The line end being
;;; modified is always the group 11 end, but we have to test the start
;;; and end angle of an arc to tell which end to modify.
;;;
;;; dl_dl2 == DLine_Draw_Line_segment_part_2
;;;
(defun dl_dl2 (npt)
  (setq tmp1 (nth (- uctr 2) wnames)
        ent1 (entget tmp1))           ; get the corresponding prev. entity

  (if (= (dl_val 0 tmp1) "LINE")
    ;; Check angles 0 180, -180  and 360...
    (if (or  (equal (angle strtpt nextpt)
                   (angle (trans (dl_val 10 tmp1) 0 1)
                          (trans (dl_val 11 tmp1) 0 1)) 0.001)
             (equal (angle strtpt nextpt)
                   (angle (trans (dl_val 11 tmp1) 0 1)
                          (trans (dl_val 10 tmp1) 0 1)) 0.001)
             (equal (+ (* 2 pi) (angle strtpt nextpt))
                   (angle (trans (dl_val 10 tmp1) 0 1)
                          (trans (dl_val 11 tmp1) 0 1)) 0.001)
        )
      ;; if it's a line
      (progn
        (setq brk_e2 nil)
        (command "_.LINE" (trans (dl_val 11 tmp1) 0 1) pt1 "")
        pt1
      )
      ;; else, if it's an arc
      (progn
        (dl_mls nil 11)
      )
    )
    ;; if it's an arc
    (dl_mas nil nil pt1 pt2 strtpt)
  )
)
;;;
;;; Modify line endpoint
;;;
;;; dl_mls == DLine_Modify_Line_Segment
;;;
(defun dl_mls (flg2 nn / spt ept pt)  ; flg2 = nil if line to line
                                      ;      = T   if line to arc

  ;; This is the previous entity; a line
  (setq spt (trans (dl_val 10 tmp1) 0 1)
        ept (trans (dl_val 11 tmp1) 0 1)
  )
  (if flg2
    ;; find intersection with arc; tmp == ename of arc
    (progn
      ;; Find arc intersection with line; tmp == ename of arc.
      (setq pt (dl_ial tmp spt ept (if flgn nextpt strtpt)))
    )

    ;; find intersection with line
    (setq pt (inters spt ept pt1 pt2 nil))
  )
  ;; modify the previous line
  (if pt
    (entmod (subst (cons nn (trans pt 1 0))
                   (assoc nn ent1)
                   ent1))
    (setq pt pt2)
  )
  pt
)
;;;
;;; This routine does a variety of tasks: it calculate the distance from
;;; the center of the arc (or congruent circle) to a line, then it
;;; calculates up to two intersection points of a line and the arc,
;;; then it attempts to determine which of the points serves as a
;;; best-fit to the following criteria:
;;;
;;;   1) One end of the arc must lie "on" the line, or
;;;      one end of the line must lie on the arc.
;;;   2) Given that the point given in 1 above is p1,
;;;      and that the other point is p2, then if the arc crosses over
;;;      the line then use p2, otherwise the arc does not cross over
;;;      the line so use p1.
;;;
;;; If the line and the arc do not intersect, then a line will be drawn
;;; from the point of intersection of the arc and the perpendicular from
;;; the line to the arc centerpoint, and the line;  The line and arc will be
;;; trimmed or extended as needed to meet these points.
;;;
;;; If the line and arc are tangent, then the arc and line are
;;; trimmed/extended to this point.
;;;
;;; p1 and p2 are two points on a line
;;; ename  == entity name of arc
;;; flg == T when the segment being drawn ends on an arc,
;;; flg == nil when the segment being drawn starts on an arc.
;;;
;;; dl_ial == DLine_Intersect_Arc_with_Line
;;;
(defun dl_ial (arc pt_1 pt_2 npt / d pi2 rad ang nang temp ipt)

  (setq cpt  (trans (dl_val 10 arc) (dl_val -1 arc) 1)
        pi2  (/ pi 2)                 ; 1/2 pi
        ang  (angle pt_1 pt_2)
        nang (+ ang pi2)              ; Normal to "ang"
        temp (inters pt_1 pt_2 cpt (polar cpt nang 1) nil)
        nang (angle cpt temp)
  )
  ;; Get the perpendicular distance from the center of the arc to the line.
  (setq d (distance cpt temp))

  (cond
    ((equal (setq rad (dl_val 40 arc)) d 0.01)
      ;; One intersection.
      (setq ipt temp)
    )
    ((< rad d)
      ;; No intersection.
      (setq spt (polar cpt nang rad)
            ipt temp
      )
      (command "_.LINE" spt ipt "")
      ipt
    )
    (T
      ;; Two intersections. Now...
      ;; If drawing arcs, fang is set, we're past the first segment...
      ;; Reset the `near' point based on the previous ipt.  This can be
      ;; quite different and necessary from the `npt' passed in.
      (if (and dl_arc fang (> uctr 1))
        (setq npt (polar cpt fang rad))
      )
      (dl_g2p npt)
      (setq ipt (dl_bp arc pt_1 pt_2 ipt1 ipt2))
      ;; If `fang' is not set, set it, otherwise set it to nil.
      (if fang
        (setq fang nil)
        (if dl_arc (setq fang (angle cpt ipt)))
      )
      ipt
    )
  )
)
;;;
;;; Get two intersection points, ordering them such that ipt1
;;; is the closer of the two points to the passed-in point "npt".
;;;
;;; dl_g2p == DLine_Get_2_Points
;;;
(defun dl_g2p (npt / temp l theta)
  (if (equal d 0.0 0.01)
    (setq theta pi2
          nang (+ ang pi2)            ; Normal to "ang"
    )
    (setq l     (sqrt (abs (- (expt rad 2) (expt d 2))))
          theta (abs (atan (/ l d)))
    )
  )
  ;; Get the two angles to the infinite intersection points of the
  ;; congruent circle to the arc, and the line, then get the two
  ;; intersection points.
  (setq ipt1 (polar cpt (- nang theta) rad))
  (setq ipt2 (polar cpt (+ nang theta) rad))
  ;; Set the closer of the two points to npt to be ipt1.
  (if (< (distance ipt2 npt) (distance ipt1 npt))
    ;; Swap points
    (setq temp ipt1
          ipt1 ipt2
          ipt2 temp
    )
    (if (equal (distance ipt2 npt) (distance ipt1 npt) 0.01)
      (exit)
    )
  )
  ipt1
)
;;;
;;; Test a point `pt' to see if it is on the line `sp--ep'.
;;;
;;; dl_onl == DLine_ON_Line_segment
;;;
(defun dl_onl (sp ep pt / cpt sa ea ang)
  (if (inters sp ep pt
              (polar pt (+ (angle sp ep) (/ pi 2))
                     (/ (getvar "tracewid") 10)
              )
              T)
    T
    nil
  )
)
;;;
;;; Test a point `pt' to see if it is on the arc `arc'.
;;;
;;; dl_ona == DLine_ON_Arc_segment
;;;
(defun dl_ona (arc pt / cpt sa ea ang)
  (setq cpt (trans (dl_val 10 arc) (dl_val -1 arc) 1)
        sa  (dl_val 50 arc)           ; angle of current ent start point
        ea  (dl_val 51 arc)           ; angle of current ent end point
        ang (angle cpt pt)            ; angle to pt.
  )
  (if (> sa ea)
    (if (or (and (> ang sa) (< ang (+ ea (* 2 pi))))
            (and (> ang (- ea (* 2 pi))) (< ang ea))
        )
      T
      nil
    )
    (if (and (> ang sa) (< ang ea)) T nil)
  )
)
;;;
;;; Get the best intersection point of an arc and a line.  The criteria
;;; are as follows:
;;;
;;;   1) The best point will lie on both the arc and the line.
;;;   2) It will be the point which causes the shortest arc to be created
;;;      such that (1) is satisfied.
;;;   3) If closing, then always use the point closest to nextpt.  Unless,
;;;      the points are equidistant, then use 1 and 2 above to tiebreak.
;;;   4) If breaking an arc with a line, always use the points nearest the
;;;      break point.
;;;
;;; dl_bp == DLine_Best_Point_of_arc_and_line
;;;
(defun dl_bp (en1 p1 p2 pp1 pp2 / temp temp1 temp2)
  (setq temp1 (dl_onl p1 p2 pp2)
        temp2 (dl_ona en1 pp2)
        temp  (if (or (= flg 1) (= flg 3)) T nil)
  )
  (if (and temp1 temp2)
    (if (and (< uctr 2)
             (and brk_e1 brk_e2))
      pp1
      (if (and temp (not fang)) pp1 pp2)
    )
    pp1
  )
)
;;; ----------------- End Line Drawing Functions --------------------
;;; ---------------- Begin Arc  Drawing Functions -------------------
;;;
;;; Draw curved DLINE
;;;
;;; dl_das == DLine_Draw_Arc_Segment
;;;
(defun dl_das (flgn orad nn / tmp1 ent1 pt ang )
  (cond
    ((= uctr 0)
      (setq sent1 tmp)
      (dl_a01 brk_e1 "1" strtpt nil)  ; DLine_draw_Arc_0_and_1
      (dl_a01 brk_e2 "3" nextpt T)    ; DLine_draw_Arc_0_and_1
    )
    ((= uctr 1)
      (setq sent1 tmp)
      (dl_a01 brk_e1 "2" strtpt nil)  ; DLine_draw_Arc_0_and_1
      (dl_a01 brk_e2 "4" nextpt T)    ; DLine_draw_Arc_0_and_1
      (dl_mae nil T)
      (dl_mae nil nil)
      ;; Now break the line or arc found at the start point
      ;; if there is one, and we are in a breaking mood.
      (if (and dl:brk brk_e1)
        (progn
          (dl_mae T T)
          (dl_mae T nil)
          (command "_.BREAK" brk_e1 savpt1 savpt2)
        )
      )
      ;; Do not set brk_e1 nil... it will be set later.
      ;; Now break the line or arc found at the end point
      ;; if there is one, and we are in a breaking mood.
      (if (and dl:brk brk_e2)
        (progn
          (if (eq brk_e1 brk_e2)
            (progn
              ;; Delete both arcs so we can find the arc or line that
              ;; we found previously.
              (entdel (nth 0 wnames))
              (entdel (nth 1 wnames))
              (dl_ved "brk_e2" nextpt)
              ;; Restore first line
              (entdel (nth 0 wnames))
              (entdel (nth 1 wnames))
            )
          )
          (if (null brk_e1)
            (progn
              (dl_mae T T)
              (dl_mae T nil)
            )
          )
          (command "_.BREAK" brk_e2 savpt3 savpt4)
        )
      )
      ;; Do not set brk_e2 nil... it will be set later.
    )
    ((= (rem uctr 2.0) 0)
      (setq fang nil)
      (dl_da2)                        ; Draw arc part 2
      (if fang
        (setq ftmp fang
              fang nil
        )
      )
      (setq save_1 ent)
      (setq sent1 (cdr(assoc -1 ent)))
      (setq pt2 (dl_a01 brk_e2 "3" nextpt T)) ; DLine_draw_Arc_0_and_1
      (if ftmp
        (setq fang ftmp
              ftmp nil
        )
      )
    )
    (T
      (dl_da2)                        ; Draw arc part 2
      (if fang
        (setq ftmp fang
              fang nil
        )
      )
      (setq save_2 ent)
      (setq sent1 (cdr(assoc -1 ent)))
      (setq pt2 (dl_a01 brk_e2 "4" nextpt T)) ; DLine_draw_Arc_0_and_1
      (if ftmp
        (setq fang fang
              ftmp nil
        )
      )

      ;; Now break the line or arc found at the end point
      ;; if there is one, and we are in a breaking mood.
      (if (and dl:brk brk_e2)
        (progn
          (dl_mae T T)
          (dl_mae T nil)
          (command "_.BREAK" brk_e2 savpt3 savpt4)
        )
      )
      ;; Do not set brk_e2 nil... it will be set later.
    )
  )
  (setq uctr   (1+ uctr))
)
;;;
;;; Set pt1 or pt2 based on whether there is an arc or line to be broken.
;;;
;;; dl_a01 == DLine_draw_Arcs_0_and_1
;;;
(defun dl_a01 (bent1 n pt flg / pt1 pt2 ang1 ang2 anga angb)
  ;; "n" is the point to save for end capping
  (setq n (strcat "savpt" n))
  ;; "tmp" is the arc just created.
  ;; "bent1" is the line or arc to be broken, if there is one...
  (if bent1
    (if (= (dl_val 0 bent1) "LINE")
      (progn
        (set (read n) (dl_ial tmp (trans (dl_val 10 bent1) 0 1)
                                  (trans (dl_val 11 bent1) 0 1) pt))
      )
      (progn
        (setq curcpt (trans (dl_val 10 sent1) (dl_val -1 sent1) 1)
              prvcpt (trans (dl_val 10 bent1) (dl_val -1 bent1) 1)
              pt1    (polar prvcpt (dl_val 50 bent1) (dl_val 40 bent1))
              pt2    (polar curcpt (dl_val nn sent1) (dl_val 40 sent1))
              ang1   (angle prvcpt pt1)
        )
        (if (not (equal ang1 (angle prvcpt strtpt) 0.01))
          (setq pt1  (polar prvcpt (dl_val 51 bent1) (dl_val 40 bent1))
                ang1 (angle prvcpt pt1)
                ang2 (angle curcpt pt2)
                anga (- ang1 ang2)
                angb (- ang2 ang1)
          )
        )
        (if (or (and (< anga 0.0872665)
                     (> anga -0.0872665))
                (and (< angb 0.0872665)
                     (> angb -0.0872665))
            )
          (progn
            (set (read n) pt)
            (if (= bent1 brk_e1)
              (setq brk_e1 nil)
              (setq brk_e2 nil)
            )
          )
          (set (read n) (dl_iaa sent1 bent1 pt flg))
        )
      )
    )
    (progn
      (setq cpt (trans (dl_val 10 tmp) (dl_val -1 tmp) 1))
      (set (read n) (polar cpt (angle cpt pt) orad))
    )
  )
  (eval (read n))
)
;;;
;;; Do more of the arc drawing stuff.  This is where we call the modify
;;; functions for the previous arc or line segment.  The line end being
;;; modified is always the group 11 end, but we have to test the start
;;; and end angle of an arc to tell which end to modify.
;;;
;;; dl_da2 == DLine_Draw_Arc_segment_part_2
;;;
(defun dl_da2 (/ pt)
  ;; get the corresponding previous entity
  (setq tmp1 (nth (- uctr 2) wnames)
        ent1 (entget tmp1))
  (if (= (dl_val 0 tmp1) "LINE")
    ;; if it's a line
    (setq pt (dl_mls T 11))
    ;; if it's an arc
    (setq pt (dl_mas nil T nil nil strtpt))
  )
  ;; pt is a point in the current UCS, not ECS
  (if pt
    (progn
      (setq ang (- (angle cpt pt) ange))
      (entmod (setq ent (subst (cons nn ang)
                       (assoc nn ent)
                       ent)))         ; modify arc endpt
    )
  )
  (if flgn                            ; if closing
    (progn
      (setq tmp1 (nth flgn wnames)
            ent1  (entget tmp1))  ; get the flagged entity
      (if (= (dl_val 0 tmp1) "LINE")
        ;; if it's a line
        (setq pt (dl_mls T 10))
        ;; if it's an arc
        (setq pt (dl_mas T T nil nil nextpt))
      )
      (if pt
        (progn
          (setq ang (- (angle cpt pt) ange))
          (setq nn (if (= nn 50) 51 50))
          (entmod (setq ent (subst (cons nn ang)
                         (assoc nn ent)
                         ent)))       ; modify arc endpt
        )
      )
    )
  )
)
;;;
;;; Modify the endpoints of an arc by changing the start and end angles.
;;;
;;; dl_mae == DLine_Modify_Arc_Endpoints
;;;
(defun dl_mae (eflg sflg / nn1 nn2)
  (if (= nn 50)
    (setq nn1 50 nn2 51)
    (setq nn1 51 nn2 50)
  )
  (if sflg
    (if eflg
      (setq save_1 (subst (cons nn2
                                (angle
                                  (trans cpt    1 (cdr(assoc -1 save_1)))
                                  (trans savpt3 1 (cdr(assoc -1 save_1)))
                                )
                          )
                          (assoc nn2 save_1) save_1)
      )
      (setq save_1 (subst (cons nn1
                                (angle
                                  (trans cpt    1 (cdr(assoc -1 save_1)))
                                  (trans savpt1 1 (cdr(assoc -1 save_1)))
                                )
                          )
                          (assoc nn1 save_1) save_1)
      )
    )
    (if eflg
      (setq save_2 (subst (cons nn2
                                (angle
                                  (trans cpt    1 (cdr(assoc -1 save_1)))
                                  (trans savpt4 1 (cdr(assoc -1 save_2)))
                                )
                          )
                          (assoc nn2 save_2) save_2)
      )
      (setq save_2 (subst (cons nn1
                                (angle
                                  (trans cpt    1 (cdr(assoc -1 save_1)))
                                  (trans savpt2 1 (cdr(assoc -1 save_2)))
                                )
                          )
                          (assoc nn1 save_2) save_2)
      )
    )
  )
  (if sflg
    (entmod save_1)
    (entmod save_2)
  )
)
;;;
;;; Modify arc                        ; flg2 = nil if arc to line
;;;                                   ;      = T   if arc to arc
;;;
;;; dl_mas == DLine_Modify_Arc_Segment
;;;
(defun dl_mas (flg3 flg2 spt ept pt / nnn pt1 pt2 rad1 ange)
  ;; get some stuff
  (setq cpt1   (trans (dl_val 10 tmp1) (dl_val -1 tmp1) 1)
        rad1   (dl_val 40 tmp1)
        ang1   (dl_val 50 tmp1)
  )
  (if (null pt)                       ; if a point is not passed in:
    (setq pt (nth 0 spts))            ; set to initial saved start point.
  )
  (setq ange (trans '(1 0 0) (dl_val -1 tmp1) 1)
        ange (angle '(0 0 0) ange)
        ang1 (+ ang1 ange)
  )
  (if (> ang1 (* 2 pi))
    (setq ang1 (- ang1 (* 2 pi)))
  )
  (if (equal (angle cpt1 pt) ang1 0.01) ; figure out if we're looking
    (setq nnn 50)                     ; for the start or end point of
    (setq nnn 51)                     ; the beginning arc, then
  )                                   ; get the intersection point
  ;; if arc to arc
  (if flg2
    ;; then
    (progn
      ;; find intersection with arc
      (setq pt1 (dl_iaa tmp tmp1 (if flg3 nextpt strtpt) flg2))
      (if pt1
        (progn
          (setq ang1 (- (angle cpt1 pt1) ange))
          (setq ent1 (subst (cons nnn ang1)
                            (assoc nnn ent1)
                            ent1))
          (entmod ent1)               ; modify arc endpt
        )
      )
    )
    ;; else
    (progn
      ;; find arc intersection with line from spt to ept
      (setq pt1 (dl_ial tmp1 spt ept pt))
      (setq ang1 (- (angle cpt1 pt1) ange))
      (setq ent1 (subst (cons nnn ang1)
                        (assoc nnn ent1)
                        ent1))
      (entmod ent1)                   ; modify arc endpt
    )
  )
  pt1
)
;;; ---------------- Begin Arc to Arc Functions ---------------------
;;;
;;; This routine does a variety of tasks: it calculate up to two
;;; intersection points of two arcs,
;;; then it attempts to determine which of the points serves as a
;;; best-fit to the following criteria:
;;;
;;;   1) One end of the arc must lie "on" the arc.
;;;   2) Given that the point given in 1 above is pt1,
;;;      and that the other point is pt2, then if the arc crosses over
;;;      the other arc then use pt2, otherwise the arc does not cross over
;;;      the other arc so use pt1.
;;;
;;; If the two arcs do not intersect, then a line will be drawn
;;; from the point of intersection of the arc and the perpendicular from
;;; the line of the two arc centerpoints;  The arcs will be
;;; trimmed or extended as needed to meet these points.
;;;
;;; If the two arcs are tangent, then they are
;;; trimmed/extended to this point.
;;;
;;; Intersection point of two arcs or circles
;;; a    = radius of ename 1
;;; b    = distance from curcpt to prvcpt
;;; c    = radius of ename 2
;;; curcpt = center point of first circle or arc  -- bent1, bent2, tmp
;;; prvcpt = center point of second circle or arc -- sent1, sent2, tmp1
;;; npt  = near point for nearest test
;;;
;;; dl_iaa == DLine_Intersect_Arc_and_Arc
;;;
(defun dl_iaa  (en1 en2 npt flga / a b c s ang alpha alph ipt
                                   curcpt prvcpt temp temp1 temp2)
  (setq curcpt  (trans (dl_val 10 en1) (dl_val -1 en1) 1) ; the "last" entity
        prvcpt  (trans (dl_val 10 en2) (dl_val -1 en2) 1) ; the previous entity
        a       (dl_val 40 en2)
        b       (distance curcpt prvcpt)
        c       (dl_val 40 en1)
        s       (/ (+ a b c) 2.0)
        ang     (angle curcpt prvcpt)
  )
  (cond
    ;; circles are tangent
    ;; If (- s a) == 0, this would cause a divide by zero below...
    ((or (= (- s a) 0) (equal b (+ a c) 0.001) (equal b (abs (- a c)) 0.001))
      ;; Circles are tangent.
      (setq ipt nil)
    )
    ;; circles do not intersect
    ((and (or (> b (+ a c)) (if (> c a) (< (+ a b) c) (< (+ c b) a)))
          (not (equal (+ a b ) c (/ (+ a b c) 1000000))))
      ;; No intersection.
      (if (= flg 4)
        (progn
          (setq ipt (polar curcpt (angle curcpt prvcpt) c))
          (command "_.LINE" (polar prvcpt (angle prvcpt ipt) a) ipt "")
        )
        (progn
          (setq ipt (polar curcpt (angle curcpt prvcpt) c))
          (command "_.LINE" (polar prvcpt (angle prvcpt ipt) a) ipt "")
        )
      )
    )
    (T
      ;; general law of cosines formula -- (- s a) != 0
      (setq alpha (* 2.0 (atan (sqrt (abs (/ (* (- s b) (- s c))
                                             (* s (- s a)))))))
      )

      (setq tpt1 (polar curcpt (+ ang alpha) c)
            tpt2 (polar curcpt (- ang alpha) c)
            anga  (angle curcpt npt)
            angb  (angle prvcpt npt)
      )
      ;; Two intersections. Now...
      ;; If drawing arcs, fang is set, we're past the first segment...
      ;; Reset the `near' point based on the previous ipt.  This can be
      ;; quite different and necessary from the `npt' passed in.
      (if (and dl_arc fang (> uctr 1))
        (setq npt (polar prvcpt fang c))
      )
      (if (< (distance tpt1 npt) (distance tpt2 npt))
        (setq temp tpt1
              tpt1 tpt2
              tpt2 temp
        )
      )
      (setq temp (angle prvcpt curcpt)) ; angle from prev ent to this ent
      (setq ipt (dl_bap en1 en2 tpt2 tpt1 nil))
      (if fang
        (setq fang nil)
        (if dl_arc (setq fang (angle cpt ipt)))
      )
    )
  )
  (setq cpt curcpt)
  (setq cpt1 prvcpt)
  ipt                                 ; return point
)
;;;
;;; Get the best point for the arc/arc intersection.
;;;
;;; dl_bap == DLine_Best_Point_to_Arc
;;;
(defun dl_bap (en1 en2 pp1 pp2 flg / temp1 temp2)
  (setq temp1 (dl_ona en1 pp2)
        temp2 (dl_ona en2 pp2)
  )
  (if temp2
    (if (and (< uctr 2)
             (and brk_e1 brk_e2))
      pp1
      (if temp1
        (if (< uctr 2)
          pp2
          (if (not fang) pp2 pp1)
        )
        pp1
      )
    )
    pp1
  )
)
;;; ----------------- End Arc  Drawing Functions --------------------
;;; -------------------- Begin Misc Functions -----------------------
;;;
;;; Add the entity name to the list in wnames.
;;;
;;; dl_atl == DLine_Add_To_List
;;;
(defun dl_atl ()
  (setq wnames (if (null wnames)
                 (list (entlast))
                 (append wnames (list tmp)))
  )
  wnames
)
;;;
;;; The value of the assoc number of <ename>
;;;
(defun dl_val (v temp)
  (cdr(assoc v (entget temp)))
)
;;;
;;; List stripper : strips the last "v" members from the list
;;;
(defun dl_lsu (lst v / m)
  (setq m 0 temp '())
  (repeat (- (length lst) v)
    (progn
      (setq temp (append temp (list (nth m lst))))
      (setq m (1+ m))
  ) )
  temp
)
;;;
;;; Bitwise DLINE endcap setting function.
;;;
(defun endcap ()
  (initget "Auto Ambos Final Ninguno Inicial")
  (setq dl:ecp (getkword
    "\n¿Que tipo de remates?  Ambos/Final/Ninguno/Inicial/<Auto>: "))
  (cond
    ((= dl:ecp "Ninguno")
      (setq dl:ecp 0)
    )
    ((= dl:ecp "Inicial")
      (setq dl:ecp 1)
    )
    ((= dl:ecp "Final")
      (setq dl:ecp 2)
    )
    ((= dl:ecp "Ambos")
      (setq dl:ecp 3)
    )
    (T  ; Auto
      (setq dl:ecp 4)
    )
  )
)
;;;
;;; Set these defaults when loading the routine.
;;;
(if (null dl:ecp) (setq dl:ecp 4))    ; default to auto endcaps
(if (null dl:snp) (setq dl:snp T))    ; default to snapping ON
(if (null dl:brk) (setq dl:brk T))    ; default to breaking ON
(if (null dl:osd) (setq dl:osd 0))    ; default to center alignment
;;;
;;; These are the c: functions.
;;;
(defun c:dl () (dline))
(defun c:dline () (dline))

(princ "  DLINE cargada. (Version corregida por J. Erce.) ")
(princ)