;;;###################### TKTN_LDR.LSP #####################
;;;
;;;       Created:        June 1998
;;;       Current file:   7 Nov. 1999
;;;       Version:        1.2
;;;       Author:         Herman Mayfarth
;;;       Purpose:        Entmakes Leaders, Forward & Reverse
;;;----------------------------------------------------------
;;;       Modification History
;;;       11 July 99  Added SLDR command July 99  Added SLDR command
;;;       21 Aug 99  changed tktn_ldr to return last 2 pts selected
;;;       06 Nov. 99 cleaned up superfluous function calls
;;;       07 Nov. 99 added arrow autoscaling to tktn_ldr
;;;       Copyright(c) 1998, 1999 by Herman Mayfarth                
;;;       Provided "as is" and without warranty, express or implied.
;;;       Permission granted to freely use and redistribute without fee
;;;       provided this copyright notice remains in all redistributed 
;;;       copies.
;;;
;;;       Acknowledgement: To John F. "Quick Draw" Uhden, for showing
;;;                         the way.
;;;
;;;#######################################################
;;Global Variables
; If you want leaders to be drawn on a specific layer, simply set
; the value of arwlayer to a layer name of your choosing, either here or
; somewhere else in your session startup code. 
;
;;(setq arwlayer "your_layer");replace your_layer with your layer name
;;and remove the semicolons @ beginning of preceding line to enable
;;drawing leaders on a predetermined layer (other than current layer)
;;
;;if you wish leaders on current layer, do nothing
;
(if (not ai_undo_push)
    (load "ai_utils")
)
;;;---------------------tktn_ldr-------------------------------
;;; function to entmake leaders, forward or backward
;;; Uses: pthtyp:   0 = straight, 1 = splined
;;;      arwlayer: string specifies layer 
;;;      ldrtyp:   nil = forward, non-nil = backward
;;; Returns: rtlist: list containing last 2 points selected
;;;-------------------------------------------------------------
(defun tktn_ldr (pthtyp arwlayer ldrtyp / p1 p2 |p1 |p2 dimsty nvert
                                          ptlist rtlist elist)
  (setq dimsty (getvar "DIMSTYLE"))
     (if (tblsearch "DIMSTYLE" (strcat (getvar "DIMSTYLE") "$7"))
     (setq dimsty (strcat dimsty "$7"));defaults to parent style
     );                                ;if no leader child exists
      (setq elist (list'(0 . "LEADER")
                       '(100 . "AcDbEntity")  ;required!
                       '(100 . "AcDbLeader")  ;what it is
                       (cons 3 dimsty)        ;dimension style
                       (cons 8 arwlayer)      ;layer
                       (cons 71  1)           ;arrow flag
                       (cons 72 pthtyp)       ;path type
                  )
      );setq
    (setq |p1 (getpoint "\nEnd of Leader:")
          p1 (trans |p1 1 0)
          ptlist (list (cons 10 p1))
    )
    (while (setq |p2 (getpoint |p1 "\n Next Point:"))
      (progn
        (setq  p2 (trans |p2 1 0))
        (grdraw |p1 |p2 -1)
        (setq ptlist (cons (cons 10 p2) ptlist)
              |p1 |p2)
      );progn 
    );while
    (if (< 1 (length ptlist))
        (progn
          (setq nvert (length ptlist)
                rtlist (list (cdadr ptlist)
                             (cdar ptlist))
          )
          (if (null ldrtyp) (setq ptlist (reverse ptlist)));T draws ldr backward
          (setq elist (append elist (list(cons 76 nvert))  ptlist 
(list(cons 77 256))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; *unconditionally* adds xdata to scale the leader arrow size,
;; based on the value returned by tktn_setscl,
;; based on a suggestion by Peter Farrell 11/7/99
(setq elist (append elist (list (list 
  '-3
  (list 
  "ACAD" 
  '(1000 . "DSTYLE") 
  '(1002 . "{") 
  '(1070 . 40)
  (cons 1040 (tktn_setscl))
  '(1002 . "}")
  )))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      (entmake elist)
          (redraw)
        );progn
      (princ "\nNot enough points!\n")
    );if
  rtlist;last two points selected
);end tktn_ldr
;;;
;;--------------------- tktn_setscl--------------------------------------
;;      Purpose: calculate scale factor
;;      Uses:    nothing
;;      Returns: sf
;;      which is equal to:
;;      dimscale        <-TILEMODE=1
;;      1               <-in paper space
;;      viewport scale  <-in a viewport
;;  local symbols
;;      curvpt: current viewport (integer - not saved by drawing)
;;-----------------------------------------------------------------
(defun tktn_setscl( / curvpt )
  (setq curvpt (getvar "CVPORT"))
  (cond ((= 1 (getvar "TILEMODE")) (setq sf (getvar "DIMSCALE")));tiled space
        ((= 1 curvpt) (setq sf 1.0));in paper space
     ;; in a viewport
        (T
          (setq sf (last (trans '(0 0 1.0) 3 2)));calc scale factor
        )  
  );cond
);end tktn_setscl
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  function    C:LDR
;   Purpose:    draws leader forward
;   Needs:      user input of points
;   Returns:    last point selected
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (defun C:LDR ( / ldrerr extldr olderr pathtype larwlayer ldrtyp)
;;local error handler
   (defun ldrerr(msg)
   (command "_.UNDO" "GROUP")
   (command "_.REDRAW")
   (extldr)
   (if
      (or
         (= msg "Function cancelled")
         (= msg "quit / exit abort")
      )
      (princ)
      (princ (strcat "\nError: " msg))
   );end if
   (princ)
 );end ldrerr
;; exit function
(defun extldr ()
   (ai_undo_pop)
   (setq *error* olderr)
   (setvar "CMDECHO" 1)
   (princ)
); end extldr
    (setvar "CMDECHO" 0)
    (setq olderr *error*
         *error* ldrerr)
    (ai_undo_push)
(if (null arwlayer)
    (setq larwlayer (getvar "CLAYER"))
    (setq larwlayer arwlayer)
)
(princ "\nDraw Leader Forward.\n")
(initget "Spline STraight")
(setq pathtype (getkword "\nPathtype:Spline <STraight>"))
;(if (null pathtype) (setq pathtype "Straight")
(cond ((equal pathtype "Spline" )(setq pathtype 1))
      ((equal pathtype "Straight")(setq pathtype 0))
      (T (setq pathtype 0))
);cond
(setq ldrtyp nil)
(tktn_ldr pathtype larwlayer ldrtyp)
(princ)
);end LDR
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  function    C:SLDR
;   Purpose:    draws splined leader forward
;   Needs:      user input of points
;   Returns:    last point selected
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (defun C:SLDR ( / ldrerr extldr olderr oldort p2 larwlayer)
;;local error handler
   (defun ldrerr(msg)
   (command "_.UNDO" "GROUP")
   (command "_.REDRAW")
   (extldr)
   (if
      (or
         (= msg "Function cancelled")
         (= msg "quit / exit abort")
      )
      (princ)
      (princ (strcat "\nError: " msg))
   );end if
   (princ)
 );end ldrerr
;; exit function
(defun extldr ()
   (ai_undo_pop)
   (setq *error* olderr)
   (setvar "ORTHOMODE" oldort)
   (setvar "CMDECHO" 1)
   (princ)
); end extldr
    (setvar "CMDECHO" 0)
    (setq olderr *error*
         *error* ldrerr)
    (ai_undo_push)
(if (null arwlayer)
    (setq larwlayer (getvar "CLAYER"))
    (setq larwlayer arwlayer)
)
(princ "\nDraw Leader Forward.\n")
(setq oldort (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 0)
(setq p2(tktn_ldr 1 larwlayer nil))
(setvar "ORTHOMODE" oldort)
(princ)
);end SLDR
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;   function    C:LR
;   Purpose:    draws leader in reverse
;   Needs:      user input of points
;   Returns:    last point selected
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     (defun C:LR ( / ldrerr extldr olderr pathtype larwlayer)
;;local error handler
   (defun ldrerr(msg)
   (command "_.UNDO" "GROUP")
   (command "_.REDRAW")
   (extldr)
   (if
      (or
         (= msg "Function cancelled")
         (= msg "quit / exit abort")
      )
      (princ)
      (princ (strcat "\nError: " msg))
   );end if
   (princ)
 );end ldrerr
;; exit function
(defun extldr ()
   (ai_undo_pop)
   (setq *error* olderr)
   (setvar "CMDECHO" 1)
   (princ)
); end extldr
    (setvar "CMDECHO" 0)
    (setq olderr *error*
         *error* ldrerr)
    (ai_undo_push)
(if (null arwlayer)
    (setq larwlayer (getvar "CLAYER"))
    (setq larwlayer arwlayer)
)
(princ "\nDraw Leader in Reverse.\n")
(initget "Spline STraight")
(setq pathtype (getkword "\nPathtype:Spline <STraight>"))
;(if (null pathtype) (setq pathtype "Straight")
(cond ((equal pathtype "Spline" )(setq pathtype 1))
      ((equal pathtype "Straight")(setq pathtype 0))
      (T (setq pathtype 0))
);cond
(tktn_ldr pathtype larwlayer t)
(princ)
);end LR

;; Prompt at load time
    (prompt " \nTKTN_LDR Copyright(c) 1998 by Herman Mayfarth.")
    (prompt " \nLDR forward leader, LR draw in reverse. SLDR for automatic spline.")
    (princ)