Lisp to draw an arrow

December 6, 2011

Hi everyone.I'm new to AutoCAD and Autolisp.And now,I want to make a lisp routine to draw an arrow like the one show below

A and B are two specific points,m = 1/3 the distance between A and B.Does anyone know how to make this lisp routine?

Thanks in advance

sorry for my English

December 6, 2011

You can make a separate dimension style with these properties to draw it instead of a routine .

December 6, 2011

I'm am amatuer, and should probably just stay out of it. But I wanted to reply to 1 request just for the experience of it.

 
(defun c:test ( / a b c wid)
 (setq a (getpoint "Pick head of arrow...\n")
b (getpoint a "Pick tail of arrow...\n")
c (polar a (angle a b) (/ (distance a b) 3.0))
wid (/ (distance a b) 6.0)
)
 (entmake
   (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(8 . "0")'(62 . 0)'(6 . "ByBlock")'(100 . "AcDbPolyline")'(90 . 2)'(70 . 0)'(38 . 0.0)'(39 . 0.0)(cons 10 a)
  '(40 . 0.0)(cons 41 wid)'(42 . 0.0)(cons 10 c)'(40 . 0.0)'(41 . 0.0)'(42 . 0.0)'(210 0.0 0.0 1.0)))
 (entmake
   (list '(0 . "LINE")'(100 . "AcDbEntity")'(8 . "0")'(62 . 0)'(6 . "ByBlock")'(100 . "AcDbLine")(cons 10 c)(cons 11 b)'(210 0.0 0.0 1.0)))
(princ)
 )

I keep myself amused by creating the oddest solutions. In fact, just ignore me. Sorry.

December 6, 2011

@Quest for Peace: this is a nice solution; only one suggestion - may make the arrow as one entity, I mean add the tail as second segment of the polyline instead of a separate entity.

Regards,

Mircea

December 6, 2011

@Quest for Peace: this is a nice solution; only one suggestion - may make the arrow as one entity, I mean add the tail as second segment of the polyline instead of a separate entity.

Regards,

Mircea

 
(defun  c:test (/ a b c wid)
[color=blue](vl-load-com)[/color]
 (setq
   a   (getpoint "Pick head of arrow...\n")
   b   (getpoint a "Pick tail of arrow...\n")
   c   (polar a (angle a b) (/ (distance a b) 3.0))
   wid (/ (distance a b) 6.0)
   )
 [color=blue](vla-setWidth[/color]
[color=blue]    (vlax-ename->vla-object[/color]
[color=blue]      (entmakex[/color]
[color=blue]        (append[/color]
[color=blue]          (list[/color]
[color=blue]            (cons 0 "LWPOLYLINE")[/color]
[color=blue]            (cons 100 "AcDbEntity")[/color]
[color=blue]            (cons 100 "AcDbPolyline")[/color]
[color=blue]            (cons 90 3)[/color]
[color=blue]            )[/color]
[color=blue]          (mapcar[/color]
[color=blue]            (function (lambda (p) (cons 10 (trans p 1 0))))[/color]
[color=blue]            (list a c b)[/color]
[color=blue]            )[/color]
[color=blue]          )[/color]
[color=blue]        )[/color]
[color=blue]      )[/color]
[color=blue]    0[/color]
[color=blue]    0.0[/color]
[color=blue]    wid[/color]
[color=blue]    )[/color]
 (princ)
 )

December 6, 2011

Thank you all

December 6, 2011

Another:

(defun c:arrow ( / di nm p1 p2 )
   (if
       (and
           (setq p1 (getpoint "\nArrow Head: "))
           (setq p2 (getpoint "\nTail Point: " p1))
           (setq di (/ (distance p1 p2) 3.0)
                 nm (trans '(0. 0. 1.) 1 0 t)
           )
       )
       (entmake
           (list
              '(0 . "LWPOLYLINE")
              '(100 . "AcDbEntity")
              '(100 . "AcDbPolyline")
              '(90 . 3)
              '(70 . 0)
               (cons 10 (trans p1 1 nm))
              '(40 . 0.0)
               (cons 41 (/ di 2.0))
               (cons 10 (trans (polar p1 (angle p1 p2) di) 1 nm))
               (cons 10 (trans p2 1 nm))
               (cons 210 nm)
           )
       )
   )
   (princ)
)

@pBe: Why convert to a VLA-Object?

Edited December 6, 2011 by Lee Mac
Accounted for all UCS/Views

December 6, 2011

Was the arrow head to be a solid? In this case I would think two different entities need to be drawn. Oh wait, I think LeeMac just did that with a two segment polyline. Is the code 41 a polyline end width?

December 6, 2011

I was thinking that he could take what I did and block or group it. I'd forgotten you could do what Lee did because I use a dimension style for simple arrows as suggested at the top. A question about this, a complicated arrow that I do use (Lisp for) is a head on the tip of a spline. I have a routine that asks for 4 points, creates the spline, inserts the head as a block, and then groups it. I wrote that years ago. Is there a way that I could have done that with just a simple entity, without the block insertion and group?

December 6, 2011

I was thinking that he could take what I did and block or group it. I'd forgotten you could do what Lee did because I use a dimension style for simple arrows as suggested at the top. A question about this, a complicated arrow that I do use (Lisp for) is a head on the tip of a spline. I have a routine that asks for 4 points, creates the spline, inserts the head as a block, and then groups it. I wrote that years ago. Is there a way that I could have done that with just a simple entity, without the block insertion and group?

You can use the leader settings to adjust the settings as needed .

December 6, 2011

Here's two I did a while back (playing around more than anything) that just use the current Dimension style and just creates a regular LEADER for the arrow:

(defun c:Arrow (/ _group _dist lastentity p1 p2 ent obj gr coords pt)
 ;; Draw quick arrow
 ;; Alan J. Thompson, 03.13.11
 (defun _group (l)
   (if (caddr l)
     (cons (list (car l) (cadr l) (caddr l)) (_group (cdddr l)))
   )
 )

 (defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

 (setq lastentity (entlast))
 (if (and (setq p1 (getpoint "\nSpecify first point: "))
          (setq p2 (getpoint p1 "\nSpecity next point: "))
          (vl-cmdf "_.leader" "_non" p2 "_non" p1 "" "" "_N")
          (not (equal lastentity (setq ent (entlast))))
          (setq obj (vlax-ename->vla-object ent))
     )
   (while (eq 5 (car (setq gr (grread T 15 0))))
     (redraw)
     (grdraw (cadr gr)
             (trans (vlax-curve-getClosestPointTo ent (setq pt (trans (cadr gr) 1 0))) 0 1)
             3
             -1
     )
     (if
       (equal
         (last (setq coords (_group (vlax-get obj 'Coordinates))))
         (car (vl-sort coords (function (lambda (a b) (< (_dist a pt) (_dist b pt))))))
       )
        (vlax-put obj 'Coordinates (apply (function append) (reverse coords)))
     )
     (grdraw (cadr gr) (trans (car coords) 0 1) 1 -1)
   )
 )
 (redraw)
 (princ)
)






(defun c:ArrowM
      (/ _group _getPoints _arrow _closestpt AT:Arrow lastentity AT:Midpoint lst ent obj gr coords)
 ;; Draw Arrow
 ;; Alan J. Thompson, 03.13.11

 (defun _group (l)
   (if (caddr l)
     (cons (list (car l) (cadr l) (caddr l)) (_group (cdddr l)))
   )
 )

 (defun _getPoints (/ lst pt)
   (if (car (setq lst (list (getpoint "\nSpecify first point: "))))
     ((lambda (color)
        (while (setq pt (getpoint (car lst) "\nSpecify next point: "))
          (redraw)
          (mapcar (function (lambda (a b) (and a b (grdraw a b color -1))))
                  (setq lst (cons pt lst))
                  (cdr lst)
          )
          (AT:Arrow (car lst) (angle (cadr lst) (car lst)))
        )
        (redraw)
        lst
      )
       (cdr (assoc 62 (tblsearch "LAYER" (getvar 'CLAYER))))
     )
   )
 )

 (defun _arrow (lst)
   (mapcar
     (function
       (lambda (a b)
         (and a b (AT:Arrow (trans (AT:MidPoint a b) 0 1) (angle (trans b 0 1) (trans a 0 1))))
       )
     )
     lst
     (cdr lst)
   )
 )

 (defun _closestpt (lst p)
   (car (vl-sort lst (function (lambda (a b) (< (distance a p) (distance b p))))))
 )

 (defun AT:Arrow (#Location #Angle / #Size #Point1 #Point2 #Point3)
   ;; Display directional arrow
   ;; #Location - arrow placement point
   ;; #Angle - arrow directional angle
   ;; Alan J. Thompson, 04.28.09
   (setq #Size   (* (getvar "viewsize") 0.02)
         #Point1 (polar #Location #Angle #Size)
         #Point2 (polar #Location (+ #Angle (* pi 0.85)) #Size)
         #Point3 (polar #Location (+ #Angle (* pi 1.15)) #Size)
   )
   (grvecs (list 4 #Point1 #Point2 #Point2 #Point3 #Point3 #Point1))
   #Location
 )


 (defun AT:Midpoint (p1 p2)
   ;; Midpoint between two points
   ;; Alan J. Thompson, 04.23.09
   (mapcar (function (lambda (a b) (/ (+ a b) 2.))) p1 p2)
 )

 (setq lastentity (entlast))
 (if (and (setq lst (_getPoints))
          (progn (vl-cmdf "_.leader") (foreach p lst (vl-cmdf "_non" p)) (vl-cmdf "" "" "_N"))
          (not (equal lastentity (setq ent (entlast))))
          (setq obj (vlax-ename->vla-object ent))
     )
   (while (eq 5 (car (setq gr (grread T 15 0))))
     (redraw)
     (grdraw (cadr gr) (trans (vlax-curve-getClosestPointTo ent (trans (cadr gr) 1 0)) 0 1) 3 -1)
     (grdraw (cadr gr) (trans (car (setq coords (_group (vlax-get obj 'Coordinates)))) 0 1) 1 -1)
     (_arrow coords)
     (if (equal (last coords) (_closestpt coords (trans (cadr gr) 1 0)))
       (vlax-put obj 'Coordinates (apply (function append) (reverse coords)))
     )
   )
 )
 (redraw)
 (princ)
)

Arrow

ArrowM

December 6, 2011

A modification of my original code to match the arrow end selection Alan has demonstrated:

(defun c:arrow ( / di en gr l1 l2 nm p1 p2 )
   (if
       (and
           (setq p1 (getpoint "\n1st Point: "))
           (setq p2 (getpoint "\n2nd Point: " p1))
       )
       (progn
           (setq di (/ (distance p1 p2) 3.0)
                 nm (trans '(0. 0. 1.) 1 0 t)
           )
           (setq en
               (entget
                   (entmakex
                       (append
                           (list
                              '(0 . "LWPOLYLINE")
                              '(100 . "AcDbEntity")
                              '(100 . "AcDbPolyline")
                              '(90 . 3)
                              '(70 . 0)
                           )
                           (setq l1
                               (list
                                   (cons 10 (trans p1 1 nm))
                                   (cons 10 (trans (polar p2 (angle p2 p1) di) 1 nm))
                                   (cons 40 (/ di 2.0))
                                  '(41 . 0.0)
                                   (cons 10 (trans p2 1 nm))
                                   (cons 210 nm)
                               )
                           )
                       )
                   )
               )
           )
           (setq l2
               (list
                   (cons 10 (trans p1 1 nm))
                  '(40 . 0.0)
                   (cons 41 (/ di 2.0))
                   (cons 10 (trans (polar p1 (angle p1 p2) di) 1 nm))
                   (cons 10 (trans p2 1 nm))
                   (cons 210 nm)
               )
           )
           (setq en (reverse (member (assoc 39 en) (reverse en))))
           (princ "\nChoose Arrow End...")
           (while (= 5 (car (setq gr (grread t 13 0))))
               (entmod
                   (append en
                       (if (< (distance (cadr gr) p2) (distance (cadr gr) p1)) l1 l2)
                   )
               )
           )
       )                    
   )
   (princ)
)

December 6, 2011

A modification of my original code to match the arrow end selection Alan has demonstrated:

Nice. I must add that I never use the dynamic option on the arrow code and have never used the arrowm code. Arrow was a rewrite of my very simple arrow routine and arrowm was to mimic one written when we were regularly posting to the grread examples thread @ theswamp - hence all the silly grdraw fluff.

December 7, 2011

Ah, I couldn't get to a computer all day to clarify something! Darn paying customers always make everything so difficult.

Our drafting standards have us drawing most things w/ (LW)PLines and giving them a 2" width. Therefore, I don't think the deminsion solution works for this complex arrow. I'm all set in this regard, but Lee's clarification of what I did reminded me that years ago my first attempt was to make the arrow as a single entity PLine with head and tail exactly as he did, but then SPline it. But everytime I SPline it, it messes up the variation in thicknesses. (Starting at 0, going to width of arrow head, then down to tail width and so on...) I just tried it again, I took Lee's arrow, attached 2 additional segments (at zero width), then Splined it. It turned into a SPline of zero width the whole way, with no head.

So my solution back then was to make the SPline, add an arrow block, then group them together. So Lee's solution reminded, and now I ask, could I have done it with a single entity? Just for the sake of learning.

I feel good today, like I contributed to the conversation. I think I'll try it again. (Posing a solution to someone's question.)

December 7, 2011

)
@pBe: Why convert to a VLA-Object?

Yea, what was i thinking. i should've incorporated the width directly on entmakex

Thanks Lee.

December 7, 2011

Nice. I must add that I never use the dynamic option on the arrow code and have never used the arrowm code. Arrow was a rewrite of my very simple arrow routine and arrowm was to mimic one written when we were regularly posting to the grread examples thread @ theswamp - hence all the silly grdraw fluff.

Cheers dude lol I don't use any of my programs - the fun is in the writing of them.

December 7, 2011

the fun is in the writing of them.

It always is.

December 9, 2011

Alan

I often use your single arrow routine.

(defun c:sar (/ _group _dist lastentity p1 p2 ent obj gr coords pt)
 ;; Draw quick arrow
 ;; Alan J. Thompson, 03.13.11
 (defun _group (l)
   (if (caddr l)
     (cons (list (car l) (cadr l) (caddr l)) (_group (cdddr l)))
   )
 )

 (defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

 (setq lastentity (entlast))
 (if (and (setq p1 (getpoint "\nSpecify first point: "))
          (setq p2 (getpoint p1 "\nSpecity next point: "))
          (vl-cmdf "_.leader" "_non" p2 "_non" p1 "" "" "_N")
          (not (equal lastentity (setq ent (entlast))))
          (setq obj (vlax-ename->vla-object ent))
     )
   (while (eq 5 (car (setq gr (grread T 15 0))))
     (redraw)
     (grdraw (cadr gr)
             (trans (vlax-curve-getClosestPointTo ent (setq pt (trans (cadr gr) 1 0))) 0 1)
             3
             -1
     )
     (if
       (equal
         (last (setq coords (_group (vlax-get obj 'Coordinates))))
         (car (vl-sort coords (function (lambda (a b) (< (_dist a pt) (_dist b pt))))))
       )
        (vlax-put obj 'Coordinates (apply (function append) (reverse coords)))
     )
     (grdraw (cadr gr) (trans (car coords) 0 1) 1 -1)
   )
 )
 (redraw)
 (princ)
)

Was wondering though, I want to have two different leader styles in a drawing, both the same size but one closed filled and the other blank filled. What would be the best way of achieving this?

Thanks

P

December 9, 2011

You could change that one property, but since you have different styles, I figure you'd rather have them as the appropriate style. I decided to just make it a subroutine where you can specify the style (or just leave it nil for current style)...

(defun c:SAR1 (/) (_ArrowWithStyle "Standard") (princ))
(defun c:SAR2 (/) (_ArrowWithStyle "SomethingElse") (princ))
(defun c:SAR3 (/) (_ArrowWithStyle nil) (princ))

(defun _ArrowWithStyle (dimstyle / _group _dist ent p1 p2 ent obj gr coords pt)
 ;; Draw quick arrow with specified dimension style
 ;; Alan J. Thompson, 03.13.11

 (defun _group (l)
   (if (caddr l)
     (cons (list (car l) (cadr l) (caddr l)) (_group (cdddr l)))
   )
 )

 (defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

 (setq ent (entlast))
 (if (and (setq p1 (getpoint "\nSpecify first point: "))
          (setq p2 (getpoint p1 "\nSpecity next point: "))
          (vl-cmdf "_.leader" "_non" p2 "_non" p1 "" "" "_N")
          (not (equal ent (setq ent (entlast))))
     )
   (progn (setq obj (vlax-ename->vla-object ent))
          (if (and (eq (type dimstyle) 'STR)
                   (tblsearch "DIMSTYLE" dimstyle)
                   (/= (strcase (getvar 'DIMSTYLE)) (strcase dimstyle))
              )
            (entmod (subst (cons 3 dimstyle) (assoc 3 (entget ent)) (entget ent)))
          )

          (while (eq 5 (car (setq gr (grread T 15 0))))
            (redraw)
            (grdraw (cadr gr)
                    (trans (vlax-curve-getClosestPointTo ent (setq pt (trans (cadr gr) 1 0))) 0 1)
                    3
                    -1
            )
            (if
              (equal
                (last (setq coords (_group (vlax-get obj 'Coordinates))))
                (car (vl-sort coords (function (lambda (a b) (< (_dist a pt) (_dist b pt))))))
              )
               (vlax-put obj 'Coordinates (apply (function append) (reverse coords)))
            )
            (grdraw (cadr gr) (trans (car coords) 0 1) 1 -1)
          )
   )
 )
 (redraw)
 (princ)
)

December 9, 2011

Cheers Alan

I will give it a go once I get this damn boat house survey finished..

Sign In

Lisp to draw an arrow

Recommended Posts

Minh Heaven

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Lee Mac

Posted Images

Tharwat

Quest for Peace

MSasu

pBe

Minh Heaven

Lee Mac

LibertyOne

Quest for Peace

Tharwat

alanjt

Lee Mac

alanjt

Quest for Peace

pBe

Lee Mac

alanjt

Least

alanjt

Least

Join the conversation

Lee Mac

Tutorials

Forums

Activity