Topic: Curved leader

[TJAM51]

Does anyone know where I can obtain a curved leader routine that follows the current dimstyle and dimscale.

Thanks

[CADaver]

Does anyone know where I can obtain a curved leader routine that follows the current dimstyle and dimscale.

Thanks

Use the splined option?

[TJAM51]

All I seek is a simple three point arc with an arrowhead attached. I have the following which was written by a membe of this forum but it is a lwpolyline and not an arrow head. I need an arc. The spline is a good idea but the shape is not consistant and I do not want to keep changing settings for my leader.

Thanks

[CADaver]

It's a very simple code for splined leaders;

Code: [Select]

(defun c:ls3 () (command ".leader" pause pause "f" "s" pause "" "" "n")) and it creats a grip-editable leader. Or buid a button macro that does the same.

[TJAM51]

Thanks for the responses but we are seeking a certain appearance and that can only be arrived at using a three point arc.....but the spline routine is interesting......


Thanks

[CAB]

Code: [Select]

;;;   By Charles Alan Butler  : Last Modified 01/08/04
;;;   ArcL.lsp    (Arc Leader)
;;;   Uses the current layer & MyArrow Arrow head

;;;======  Main Lisp Routine  =======
(defun c:ArcL (/  usercmd useros userAngDir loop ptpick Lastpt)

  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
(member
 msg
 '("console break" "Function cancelled" "quit / exit abort")
)
      )
       (princ (strcat "\nError: " msg))
    ) ; if
    (princ)
  ) ;
 ;end error function

;;;=============================================================
;;;              Local Functions
;;;=============================================================
  (defun makeMyblk (/ ss)
    (command "-color" "Red")
    (command "line" "0,0" "0,6" "")
    (setq ss (ssadd))
    (ssadd (entlast) ss)
    (command "line" "0,0" "6,0" "")
    (ssadd (entlast) ss)
    (command "line" "0,0" (polar '(0 0) 0.2618 6) "")
    (ssadd (entlast) ss)
    (command "line" "0,0" (polar '(0 0) 1.309 6) "")
    (ssadd (entlast) ss)
    (command "-block" "MyArrow" '(0 0) ss "")
    (command "-color" "ByLayer")
  ) ;defun
 
;;;=============================================
;;;   ArcC    Arc Leader with Circle Arrow Head
;;;   Uses the current layer & Circle Arrow head
;;;=============================================

(defun ArcC (/ ArcEnt)
  (setq ArcEnt (list (entlast) ptpick))
  (Command "_.Circle" ptpick 2) ; circle arrow head 2" radius
  (command "_trim" (entlast) "" ArcEnt "")
) ;  end defun

;;;=============================================
;;;   ArcArw    Arc Leader with Arrow Type Head
;;;   Uses the current layer & Block Arrow head
;;;=============================================

(defun arcArw (/ L_Angle cenpt   rad     StartAng  arcdata
      EndAng ArwOffset
     )
  (setq arcdata (entget (entlast))
cenpt (cdr (assoc 10 arcdata))
rad (cdr (assoc 40 arcdata))
StartAng (cdr (assoc 50 arcdata))
EndAng (cdr (assoc 51 arcdata))
  )
  ;;-------check for cw drawn arc----------
  (if (equal (polar cenpt EndAng rad) ptpick 0.1)
    (progn
      (setq L_Angle (+ EndAng (* pi 1.25)) ;start ang for cw
      )
    ) ;progn
    (setq L_Angle (- StartAng (* pi 1.75))) ;start ang for ccw
  ) ;if
  ;; ----------   Arrow Head    ---------------
  (if (not (tblsearch "block" "MyArrow"))
    (MakeMyBlk)
  )
  (setq ang (* 180.0 (/ L_Angle pi)))
  (Command "_.insert" "MyArrow" "S" 1 ptpick ang) ; arrow head
); end defun

;;;=============================================================
;;;=============================================================
;;;          Routine Starts Here
;;;=============================================================
;;;=============================================================
  (princ "\n")
  (princ "\n            Arc Leader - Version 1.2")
  (princ "\n")

;;; -------  Some Housekeeping   ------------------
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq useros (getvar "osmode"))
  (setvar "osmode" 0)
  (setq userANGDIR (getvar "angdir"))
  (setvar "angdir" 0)
  (if (not ArType) ; GET Arrow Type FOR THE FIRST TIME IN THE ROUTINE
    (progn
      (setq ArType "")
      (while (not (member ArType (list "Circle" "Arrow")))
      (INITGET 1 "Circle Arrow")
      (setq ArType (getkword "\nArrow head to use, [A]rrow or [C]ircle: "))
)
    )
  ) ; endif


  ;;  loop until user enters point or "C" or "A"
  (setq loop T)
  (while loop
    (initget 1 "Circle Arrow")
    (setq
      ptpick (getpoint
      (strcat "\nPick leader start point or [Circle / Arrow]:<"
      ArType
      ">"
      )
    )
    )
    (cond
      ((= (type ptpick) 'LIST) ; point picked
       (setq loop nil) ; exit loop
      )
      ((or (= ptpick "Circle") (= ptpick "Arrow"))
       (setq ArType ptpick)
      )
      (T (alert "Pick point or enter C or A"))
    )
  ) ; end while

  (command "arc" ptpick pause pause)
  (if (= "ARC" (cdr (assoc 0 (entget (entlast)))))
    (progn ; arc created
      (setq Lastpt (getvar "lastpoint"))
      (cond
((= ArType "Arrow")
(ArcArw)
)
((= ArType "Circle")
(ArcC)
)
      )
    )
  ) ; endif

;;;==========  Exit Sequence  ============
  (setvar "osmode" useros)
  (setvar "CMDECHO" usercmd)
  (setvar "angdir" userangdir)
  (princ)
  (list ptpick Lastpt) ; return the start & end point of the arc
) ;  end defun
(prompt "\nArc Leader Loaded, Type  ArcL  to run")
(princ)

;;;==========  End of Routine  ============

;;;/////////////
;;;    EOF
;;;\\\\\\\\\\\\\

[CAB]

Code: [Select]

;;;   By Charles Alan Butler  : Last Modified 11/19/03
;;;   ArcC.lsp    (Arc Leader with Circle Arrow Head)
;;;   Uses the current layer & Circle Arrow head

;; error function & Routine Exit
(defun *error* (msg)
  (if
    (not
      (member
msg
'("console break" "Function cancelled" "quit / exit abort")
      )
    )
     (princ (strcat "\nError: " msg))
  ) ; if
  (princ)
) ;
;end error function

;;;======  Main Lisp Routine  =======
(defun c:ArcC (/ usercmd   useros    pt1       pt2
      pttemp ptpick   L_Angle   cenpt     rad
      StartAng arcdata   EndAng    
     )
  (princ "\n")
  (princ "\n       Arc Leader w/ Circle Arrow - Version 1.0")
  (princ "\n")

;;; -------  Some Housekeeping   ------------------
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq useros (getvar "osmode"))
  (setvar "osmode" 0)
  (setq userANGDIR (getvar "angdir"))
  (setvar "angdir" 0)

  (setq ptpick (getpoint "\nPick leader start point: "))
  (command "arc" ptpick pause pause)
  (if (= "ARC" (cdr (assoc 0 (entget (entlast)))))
    (progn
      (setq ArcEnt (list (entlast) ptpick))
      (Command "_.Circle" ptpick 2) ; circle arrow head 2" radius
      (command "_trim" (entlast) "" ArcEnt "")
       ;;;==========  Exit Sequence  ============
      (setvar "osmode" useros)
      (setvar "CMDECHO" usercmd)
      (setvar "angdir" userangdir)
      (princ)
    ) ; end progn
  ) ; endif ARC
) ;  end defun
(prompt "\nType  ArcC  to run")
(princ)

;;;==========  End of Routine  ============ [/code]

[CAB]

Code: [Select]

;;;   By Charles Alan Butler  : Last Modified 05/20/04
;;;   FatL.lsp    (Fat Leader)
;;;  This routine will create a tapered three point poly arc leader with arrow head
;;;  The arrow head length & width may be changed within the code
;;;   Uses the current layer

;;;======  Main Lisp Routine  =======
(defun c:FatL (/)
              ;|usercmd  useros   arpt     pt1      pt2
               pttemp   ptpick   L_Angle  cenpt    MidPt    rad
               StartAng arcdata  EndAng   DelAng   midang   ArLen
               Width
              )|;
  (princ "\n")
  (princ "\n            Fat Leader - Version 1.0")
  (princ "\n")
  ;; -------  Some Housekeeping   ------------------
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq useros (getvar "osmode"))
  (setvar "osmode" 0)

 ;-------------------------------------
 ;-----   Set Arrow Head Size   ------
 ;-------------------------------------
 ; Length = 6"  @ DimScale 48
 ; Width = 1.5" @ DimScale 48
  (setq ArLen (* 0.125 (getvar "DIMSCALE")) ; Head length
        Width (* 0.03125 (getvar "DIMSCALE")) ; Head Width
  )

 ;-------------------------------------
 ;-----   Get Leader Location   ------
 ;-------------------------------------
  (setq ptpick (getpoint "\nPick from leader start point: "))
  (command "arc" ptpick pause pause)
  (if (and (setq arcdata (entget (entlast)))
           (= (cdr (assoc 0 arcdata)) "ARC")
      )
    (progn


      (setq cenpt    (cdr (assoc 10 arcdata))
            rad      (cdr (assoc 40 arcdata))
            StartAng (cdr (assoc 50 arcdata))
            EndAng   (cdr (assoc 51 arcdata))
      )

      (entdel (entlast))
      (prompt "\n")
      (setq midpt (polar cenpt
                         (+ StartAng (/ (@delta startang endang) 2))
                         rad
                  )

            pt1   (polar cenpt StartAng rad)
            pt2   (polar cenpt EndAng rad)
      )

      (setq ang (get-delta ArLen rad))

      ;;-------check for cw drawn arc----------
      (if (equal pt2 ptpick 0.1)
        (progn
          (princ "**CLOCK**")
          (setq pttemp pt2
                pt2    pt1
                pt1    pttemp ;reverse pts if cw
                ang    (- EndAng ang)
          )
          (setq arpt (polar cenpt ang rad)) ;end point of head
        ) ;progn
        (setq ang  (+ StartAng ang)
              arpt (polar cenpt ang rad)
        ) ;end point of head
      ) ;if

      ;; ----------   Draw the pline    ---------------
      (command "_pline" pt1 "w" "0" Width ; arrow head
               arpt "w" "0" Width "A" "S" midpt pt2 "")
    )
  )
  ;;==========  Exit Sequence  ============
  (setvar "osmode" useros)
  (setvar "CMDECHO" usercmd)
  (princ)
) ;  end defun
(prompt "\nType  FatL  to run")
(princ)
;;;==========  End of Routine  ============

; Inverse sine
(defun isine (x)
  (atan (/ x (sqrt (- 1.0 (* x x)))))
  )

;; delta angle (radians) given the chord and radius (real)
(defun get-delta (chord radius / DeltaAng)
  (setq
    DeltaAng
     (* 2 (isine (/ chord (* 2 radius))))
  )
) ; defun

;; compute the delta angle between 2 absolute angles a1 & a2
(defun @delta (a1 a2)
  (abs
  (cond
    ((> a1 (+ a2 pi)) (- (+ a2 pi pi) a1))
    ((> a2 (+ a1 pi)) (- a2 a1 pi pi))
    ((- a2 a1))
  )
  )
)

[hyposmurf]

CAB you seem to have lisps like a chemist has pills for a plethora of problems.

[CADaver]

Thanks for the responses but we are seeking a certain appearance and that can only be arrived at using a three point arc.....but the spline routine is interesting......


Thanks

Sounds like expensive gingerbread to me, but whatever floats yer boat, I guess.

[CAB]

CAB you seem to have lisps like a chemist has pills for a plethora of problems.

I am a Lisp Collector, Over 1500 so far after almost two years.
We all do some common task and there are a lot of lisp solutions out there on the net.
When I started lisping I mostly collected, cut and paste parts of one lisp into another
making then do things I wanted them to. When I figured out how to lisp I revised the routines
to do it my way. It's a great hobby.

[CAB]

Here is another I just revised.

Code: [Select]

;; TIP493B.LSP   improvement based on TIP493   (c)1990, CADalyst
;;
;; CAB revised 01/04/05
;;  added block check code
;;  added text height error check

(defun c:cl (/ usercmd vars pt2 pt1 asize ang tsize x1 y1 pt4)
  (graphscr)
  (defun dxf (a b) (cdr (assoc a b)))
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "UNDO" "Begin")

 
  (setq pt1 (getpoint "\nStart point:"))
  (prompt "\nPoint on arc segment: ")
  (command "ARC" pt1 pause)
  (prompt "\nNext point: ")
  (command pause)
  (setq
    pt3    (getvar "LastPoint")
    dscale (getvar "DimScale")
    asize  (* (getvar "DimAsz") dscale)
    tsize  (* (getvar "DimTxt") dscale)
    block  (getvar "DimLdrBlk") ; CAB
    90deg  (/ pi 2)
    ent1   (entlast)
    edata  (entget ent1)
    center (dxf 10 edata)
    radius (dxf 40 edata)
    start  (polar center (dxf 50 edata) radius)
    ang    (/ asize radius)
    ang    ((if (< (distance pt1 start) 1.0e-6) + -)
             (angle center pt1)
             ang
           )
    pt2    (polar center ang radius)
    ang    (angle pt1 pt2)
  )
  ;;  CAB added block name error check
  (if (not (tblsearch "BLOCK" block))
    (progn
      (setq block (strcat "_" block))
      (if (not (tblsearch "BLOCK" block))
        (setq block "")
      )
    )
  )
 
  (cond
    ((eq block "")
     (setq asize (* asize 0.1667))
     (command "SOLID" pt1
       (polar pt2 (+ ang 90deg) asize)
       (polar pt2 (- ang 90deg) asize)
       "" ""
     )
    )
    (t
     (command "INSERT" block pt1 asize "" (angtos (- ang pi)))
    )
  )

  ;;  Text Entry, revised by CAB
  (prompt "\nText: ")
  (setq y (- (nth 1 pt3) (* tsize 0.5)))
  (if (<= (nth 0 pt3) (nth 0 pt1))
    (setq x (- (nth 0 pt3) tsize))
    (setq x (+ (nth 0 pt3) tsize))
  )
  (initget 1)
  (setq txt (getstring t "\n Enter Text: "))
  ;; If text height is undefined (signified by 0 in the table)
  (if (= (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))) 0)
    ;; Draw the text using the current text height (textsize)
    (command "text" (list x y) "" 0 txt)
    ;; Otherwise use the defined text height
    (command "text" (list x y) 0 txt)
  ) ; endif
  (if (<= (nth 0 pt3) (nth 0 pt1)) ; Right Justify text
    (progn
      (setq elst (entget(entlast))
            elst (subst '(72 . 2) '(72 . 0) elst); right justify
            )
      (if (null (assoc 11 elst)) ; correct alignment point
        (setq elst (append elst (list (cons 11 (list x y)))))
        (setq elst (subst (cons 11  (list x y)) (assoc 11 elst) elst))
      )
      (entmod elst)
    )
  )

  (command "UNDO" "End")
  (setvar "CMDECHO" usercmd)
  (princ)
)
(prompt "\n**  Curved Leader Loaded. Enter CL to run.  **")
(princ)

[hyposmurf]

I am a Lisp Collector, Over 1500 so far after almost two years.

How do you collate all your lisps?Ive collected quite a few but find it dam hardto find some lisps when i want them.You got a database or something?

[CAB]

I need a better system.
There is a lisp organizer lisp that reads the first line or two in each lisp to  collect
comments & descriptions. But I'm too lazy to comment all the lisp files.
So I add a prefix to the file name like all my leader routines start with "Leader"
That way they are at least grouped together. I use the Explorer Search for key words
when I am looking for a special feature. Problem comes when I'm looking for a technique
used by someone. If it's worth going back for I save that code in it's own file.

[Anonymous]

Here is a program to organize lisp programs

http://www.jefferypsanders.com/autolisp_LOADLSP.html

[VENUS]

CAB,  
I recently found this forum in my search for a curved leader routine so thanks for sharing the lisp routines.  I'm having trouble getting the routine to use a different arrow head type.  How would I go about doing this?  Also, how could I format the arrow and add text to the leader  and have both be a specific size as a standard AutoCAD leader would?  Maybe you have a routine that fullfills my greedy needs. . .??!
Thanks again for the help
PS I'm a lisp newbee

[CAB]

Welcome aboard.
Which routine are you trying to use?

[VENUS]

it's the first lisp routine you posted here (post dated Jan 04, 05) for the arcl command.  I saw the post posts of related lisp routines, but being new to the whole lisp thing, didn't know where to begin. . .

[CAB]

Well all you want to do is add a TEXT command to the routine.
Does it need to be on a particular layer or current, if not current define the layer.
Do you want a particular text style or current? If not current define the text style.
Do you use a text style with zero height, If so what height do you want the text?
Do you want to place the leader first? if so what text justification do you want?
[ top, middle, or bottom ] Left, Right will be determined by the leader direction.

You see there are a lot of options when you add text.

You do realize that the curved leader is not linked to the text like an ACAD leader is?

[VENUS]

AHHH!
ok forget the text I can do without it; but the arrow is a must (ya gotta have standards ya know).  back to my initial question (before I got greedy):
how can I get my arrow onto the curved leader and specify what the scale of the arrow is?

[CAB]

Ok, are you using your block?
Does it need to be scaled?
Is the point on the left & it points left?
Will it exist in the drawing? Or is it a DWG in the ACAD path?

[VENUS]

yes, I have the routine loaded and it works great
right now it is just part of the dwg but I would like AutoCAD to automaticallly load it at startup.
for the drawing I'm doing right now, it doesn't need to be scaled
I really appreciate the help

[CAB]

To have the routine load into every drawing enter appload at the command line.
Click on 'Contents' under the "Startup Suite"
Then click add, find the lisp & click add.
Now in any drawing you may enter arcl at the command line & it will run.

Tell me about the block you are trying to use with the routine.

[VENUS]

It is a simple dwg file.  I'm able to use it successfully when doing a spline leader or other type of leader.

[CAB]

Try this routine
http://theswamp.org/phpBB2/viewtopic.php?t=3753
Is your arrow head solid like that?

[t-bear]

Welcome to the Swamp, Venus!  You've discovered the finest Gurus of CAD in the industry today.  While you're here, take a few seconds to join the gang....(there's *SECRET* forums that only members can see...tempt, tempt....).  It won't hurt hardly at all....LOL
In the mean time, you're in good hands!  Enjoy the ride.

[venus]

Thanks, Bear.  I'm official now - you're right about the *secret* stuff!
CAB:
I tried out the routine linked previously but it is not the correct arrowhead - I've uploaded the arrowhead I use into lilypond.  It's a dwg file called Arrow90.  Is this something that has to be programmed into the routine?  I take it I can't just go into some kind of options menu and select the arrowhead I want. . .
btw:  I found the link (here in the swamp none the less!) to http://www.smadsen.com/
It has been most helpful in my understanding of LISP
THE SWAMP ROCKS!

[SMadsen]

btw:  I found the link (here in the swamp none the less!) to http://www.smadsen.com/

Hmmm .. that url seems familiar somehow  
(glad if you could use some of that old stuff)

Welcome aboard, Venus.

[CAB]

venus,
I took the liberty of creating a folder in your name and moved your drawing there.
Here is the link
Arrow90
I will take a look at your dwg and get back to you.

[CAB]

OK try this one out.
But you must first download the Arrow90 file from here because your file
had a Arrow90 block alread in it. Your file will cause an error. Replace it.

Code: [Select]

;;;   ArcLv.lsp    (Arc Leader)
;;;   Created for venus @ the Swamp
;;;   Uses the current layer & Arrow90 Arrow head
;;;   Creates an arc leader, Arrow90.DWG must be in the ACAD path
;;;
;;; ARGUMENTS
;;; none
;;;
;;; USAGE
;;; arclv
;;;
;;; PLATFORMS
;;; 2000+
;;;
;;; AUTHOR
;;; Copyright© 2005 Charles Alan Butler
;;; ab2draft@TampaBay.rr.com
;;;
;;; VERSION
;;; 1.0 Jan 21, 2005
;;
;; YOU MAY USE THIS CODE ONLY FOR *NON-COMMERCIAL*
;; PURPOSES AND ONLY IF YOU RETAIN
;; THIS HEADER COMPLETE AND UNALTERED
;; you must contact me if you want to use it commercially
;;
;;;======  Main Lisp Routine  =======
(defun c:arclv (/ usercmd useros userangdir loop ptpick lastpt arwsize
                ang dist enpt len p1 stpt vobj)
  (vl-load-com)
  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    ) ; if
    (setvar "osmode" useros)
    (setvar "CMDECHO" usercmd)
    (setvar "angdir" userangdir)
    (princ)
  ) ;end error function


;;;=============================================================
;;;=============================================================
;;;                  Routine Starts Here                        
;;;=============================================================
;;;=============================================================
  (princ "\n")
  (princ "\n            Arc Leader 2 Heads - Version 1.2")
  (princ "\n")
  (if (and (not (tblsearch "block" "Arrow90"))
           (not (findfile "Arrow90.dwg")))
    (progn
      (alert "Arrow90 DWG not found.")
      (exit)
    )
  )


;;; -------  Some Housekeeping   ------------------
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq useros (getvar "osmode"))
  (setvar "osmode" 0)
  (setq userangdir (getvar "angdir"))
  (setvar "angdir" 0)

  ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
  (setq arwsize (* (getvar "dimasz") (getvar "dimscale")))
  ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

  (setq ptpick (getpoint "\nDraw Arc, Arrow location first."))
  (if (= (type ptpick) 'list)
    (progn
      (command "._arc" ptpick pause pause)
      (if (= "ARC" (cdr (assoc 0 (entget (entlast)))))
        (progn ; arc created
          ;;-------------------------------------------------------
          (setq vobj (vlax-ename->vla-object (entlast)))
          (setq stpt (vlax-curve-getstartpoint vobj))
          (setq enpt (vlax-curve-getendpoint vobj))
          (setq len (vlax-curve-getdistatparam
                      vobj
                      (vlax-curve-getendparam vobj)
                    )
          )
          (if (< (distance stpt ptpick) (distance enpt ptpick))
            (setq dist arwsize)
            (setq dist    (- len arwsize)
                  arwsize (- arwsize)
            )
          )

          (setq p1 (vlax-curve-getpointatdist vobj dist))
          (setq ang (* 180.0 (/ (angle p1 ptpick) pi)))
          (command "_.insert" "Arrow90" "S" (abs arwsize) ptpick ang) ; arrow head
          ;;--------------------------------------------------------------
        ); progn
      ) ; endif
    ) ; progn
  ) ; endif

  (*error* "")
  (princ)
) ;  end defun
(prompt "\nArc Leader Loaded, Type  ArcLv  to run")
(princ)

;;;==========  End of Routine  ============


[venus]

   
It works great!!!!
Thanks so much for all the help.  I hope one day to be able to contribute some of my own routines.  Until then. . .
I'll see how I can customize/alter the ones I've got
So now I guess I need permission to use this commercially?

[CAB]

So now I guess I need permission to use this commercially?

If you want to include that code in a software package you sell, YES.
If you want to use it at work, feel free & enjoy.

CAB