Lisp to create polyline with arrow in the ends, but not everytime!

[Anonymous]

Dear all,
Can someone help me?
I need to create A LOT of polylines in my projects and sometimes they need to have an arrow at the beginning, end, or both, and I think a lisp like this could be helpful, instead of create a polyline then copy an arrow to the end.
I'm new with lisp and don't know hot to do it but I imagine something that, after the command, when I click on the screen pops up a window with options "yes" and "no" so I can choose to put an arrow on the beginning, then I would click on everywhere I need to extend my polyline, and in the end, with ESC, it opens another window asking me again if I want to leave an arrow in the end or not. All this made with the current layer. I've tried to use "leader" but it's not what I need, although the style of the arrow was fine! With leader the arrow should be "Closed Filled" with size 2.5, if that can help with the style.

This is what I need:

 

I'm sorry if my english is not right, it's not used at all in my country
Since now, thank you for your attention!

 

[RobDraw]

Leaders should work fine. You can change the size in the style definition.

For LISP, I would suggest using the Customization and LISP forum.

[Kent1Cooper]

---

@RobDraw wrote:

Leaders should work fine. ....

For LISP, I would suggest using the Customization and LISP forum.

---

Leaders won't give you the both-ends option.  But I agree, the >Customization Forum< is the place to go.

[RobDraw]

Personally, I don't use polylines for this. I use a block for the arrowheads and draw lines.

[ВeekeeCZ]

This should do the work. You can pre-select the existing pline to add arrows to it.

(vl-load-com)
;; beekeecz 21-08-01

(defun c:PArrow ( / :PLAddVertex e len)

  ;; From Lee Mac's code
(defun :PLAddVertex (e p / tan LM:LWVertices a b e h l n r w x z)
  (defun tan ( x ) (if (not (equal 0.0 (cos x) 1e-10)) (/ (sin x) (cos x))))
  (defun LM:LWVertices ( e )
    (if (setq e (member (assoc 10 e) e))
      (cons (list (assoc 10 e) (assoc 40 e) (assoc 41 e) (assoc 42 e))
	    (LM:LWVertices (cdr e)))))
  
  (if (and p
	   e
	   (setq p (vlax-curve-getclosestpointto e (trans p 1 0))
		 n (vlax-curve-getparamatpoint e p)))
    (if (not (equal n (fix n) 1e-8))
      (progn
	(setq e (entget e)
	      h (reverse (member (assoc 39 e) (reverse e)))
	      l (LM:LWVertices e)
	      z (assoc 210 e))
	(repeat (fix n)
	  (setq a (cons (car l) a)
		l (cdr l)))
	(setq x (car l)
	      r (- n (fix n))
	      w (cdr (assoc 40 x))
	      w (+ w (* r (- (cdr (assoc 41 x)) w)))
	      b (atan (cdr (assoc 42 x))))
	(entmod (append h
			(apply 'append (reverse a))
			(list (assoc 10 x)
			      (assoc 40 x)
			      (cons  41 w)
			      (cons  42 (tan (* r b))))
			(list
			  (cons  10 (trans p 0 (cdr z)))
			  (cons  40 w)
			  (assoc 41 x)
			  (cons  42 (tan (* (- 1.0 r) b))))
			(apply 'append (cdr l))
			(list z)))))))

  ; -----------------------------------------------------------------------------------------------------

  (if (ssget "_I" '((0 . "LWPOLYLINE")))
    (setq e (ssname (ssget "_I") 0))
    (progn
      (command "_.pline") (while (> (getvar 'cmdactive) 0) (command pause))
      (setq e (entlast))))

  (setq o (vlax-ename->vla-object e))

  (or *pa-t*
      (setq *pa-t* "End"))
  (initget "Start Both End")
  (setq *pa-t* (cond ((getkword (strcat "\nAdd arrows to [Start/Both/End] <" *pa-t* ">: "))) (*pa-t*)))

  (and (vl-position *pa-t* '("Start" "Both"))
       (< (vlax-curve-getparamatdist e 2.5) 1.)
       (:PlAddVertex e (vlax-curve-getpointatdist e 2.5))
       ;(not (vla-SetBulge o 0 0))
       (vla-SetWidth o 0 0 0.833))
  
  (and (vl-position *pa-t* '("End" "Both"))
       (setq len (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
       (< (- (vlax-curve-getendparam e) (vlax-curve-getparamatdist e (- len 2.5))) 1)
       (:PlAddVertex e (vlax-curve-getpointatdist e (- len 2.5)))
       ;(not (vla-SetBulge o (1- (vlax-curve-getendparam o)) 0))
       (vla-SetWidth o (1- (vlax-curve-getendparam o)) 0.833 0))
  (princ)
  )

[Anonymous · Accepted solution]

Thank you very much for this LISP @ВeekeeCZ, it's just what I was in need! You're awesome!
When I use linetype "dashed" the arrow shows dashed too. Is it something that I need to correct on my AutoCAD?
If not, can you please fix this for me??

I'm sorry for using the wrong area, I'm new here. It won't happen again!