draw polyline as a series of arrows

[motee]

looking for a lisp that can draw a polyline as continuous arrow divided by zero width segment as in attached drawing
the idea is to pick start point then second point as a given space then change width to optional number then returned to zero width and so on till end
any help will be appreciated

[Tom Beauford]

Why not just use a linetype? I don't use metric, but it looks simple enough.

[motee]

if you export your drawing to another pc you have to attache linetype so it is better to draw this line with lisp

[Coloradomrg]

Linetypes stay with their drawings, and can be copied from one to another. You don't lose them when you open a file on a new or different pc. If you are wanting to share the definition, that's easily accomplished with a custom .lin file.

[greg.battin]

I simply commented out the breaking portion of the routine that is found here by Raymond Rizkallah: http://cadtips.cadalyst.com/2d-opera...ctional-arrows
This seems to work similar though...

;;====================================================================
;;                    ** ARROW-BREAK.LSP **                           
;;                                                                    
;; * Used to apply BREAKS and ARROWS to objects (as a flow direction).
;; * Valid objects are POLYLINES, LINES and ARCS.                     
;;                                                                    
;; * Arrow size is defined by user input                              
;; * Arrow direction is opposite to the point you use to select object
;;                                                                    
;; * Written By Raymond Rizkallah - December/1998 ; October/2008      
;;====================================================================


;;----------- valid object selection --------------------------------
(defun RT1 ()             ;; only LWPOLYLINE or NULL will be selected
    (setq ValidEntList '("LWPOLYLINE" "LINE" "ARC"))
    (setq ent1 (entsel "\nPick Lwpolyline/Line/Arc: "))
    (if (null ent1) (progn (setq txt1 nil) (prin1)) 
      (progn
      ;(while (/= (cdr (assoc 0 (entget (car ent1)))) "LWPOLYLINE") (RT1))
      (while (not (member (cdr (assoc 0 (entget (car ent1)))) ValidEntList)) (RT1))	
      ;(setq txt1 (cdr (assoc 1 (entget (car ent1)))))
      (PRINC)
    )) ;end if
 )

;;===================================================================
;;                PL-DIRECTION FUNCTION :                            
;;   * Give Polyline length through spcified point PT0.              
;;   * Specify its direction according to PT0.                       
;;===================================================================
  
(defun PL-DIRECTION ()
  (vl-load-com)
  (command "ucs" "w")

  (RT1) 

  (setq ename (car ent1) eget (entget ename))

  (setq pt0 (osnap (cadr ent1) "nea"))
  (setq pt-ur (polar pt0 (* pi 0.25) (* (getvar "viewsize") 0.01)))
  (setq pt-ul (polar pt0 (* pi 0.75) (* (getvar "viewsize") 0.01)))
  (setq pt-ll (polar pt0 (* pi 1.25) (* (getvar "viewsize") 0.01)))
  (setq pt-lr (polar pt0 (* pi 1.75) (* (getvar "viewsize") 0.01)))
  (grdraw pt-ll pt-ur 7)
  (grdraw pt-lr pt-ul 7)
  
  (setq d1 (vlax-curve-getDistAtPoint (car ent1) pt0))   ;;; the specified point
  (setq curarea (vlax-curve-getArea ename))
  (setq curperi (vlax-curve-getDistAtParam ename (vlax-curve-getEndParam ename)))
  (setq d3 curperi)                     ;;;TOTAL LENGTH
  (setq d2 (- curperi d1))
  
  ;(prompt (strcat "L=" (rtos d3 2 2) " : [" (rtos d1 2 2) " + " (rtos d2 2 2) "]. "))
  (prompt (strcat " [L= " (rtos d3 2 2) "]"))
  (if (< d1 d2) 
    (progn (setq ctrl1 1))  ;(princ " Same direction."))
    (progn (setq ctrl1 -1)) ;(princ " Opposite direction."))
  )
) ; end function 

;;===================================================================
;;            C:ARB :: ARROW-BREAK MAIN FUNCTION                     
;;                                                                   
;;===================================================================

(defun C:ARB ()
  (COMMAND "UNDO" "M" "UNDO" "G")
  (setvar "cmdecho" 0)
  (SETVAR "OSMODE" 0)
  (setvar "sortents" 117)
  (setvar "snapmode" 0)

  ;;----------- Crating Blocks arw_100 & arw_200 --------------------
  
  (setq as3 0.5)

  (if (null (tblsearch "block" "arw_100")) (progn (setvar "fillmode" 0)
    (setq p1 (getvar "viewctr") p2 (polar p1 0 (* as3 1)) p3 (polar p1 0 (* as3 2)))
    (command "pline" p1 "w" (* 2 (/ as3 3.0)) 0 p3 "" "chprop" (entlast) "" "la" 0 "")
    (command "block" "arw_100" p2 (entlast) "")
    (setvar "fillmode" 1)
  ))
  (if (null (tblsearch "block" "arw_200")) (progn (setvar "fillmode" 0)
    (setq p1 (getvar "viewctr") p2 (polar p1 0 (* as3 1)) p3 (polar p1 0 (* as3 2)))
    (command "pline" p1 "w" 0 (* 2 (/ as3 3.0)) p3 "w" 0 0 "" "chprop" (entlast) "" "la" 0 "")
    (command "block" "arw_200" p2 (entlast) "")
    (setvar "fillmode" 1)
  ))
  
  ;;----------- Specifying polyline direction & length --------------
                 
  (PL-DIRECTION)
  
  (if (null (numberp arwsz)) (setq arwsz 3.0))
  (setq n-arwsz (getdist (strcat "\nArrow size <" (rtos arwsz) ">: ")))
  (if n-arwsz (setq arwsz n-arwsz))

  ;;--------------- Dividing the arrows -----------------------------

  (setq len1 (fix (/ d3 (* arwsz 3.5))) len1x (* len1 7)) ; --> --> --> 2+1+0.5=3.5

  (if (= ctrl1 1)
    (command "divide" ename "b" "arw_100" "y" len1X)
    (command "divide" ename "b" "arw_200" "y" len1x)
  )
  
  ;;------------ DELETING EXTRA ARROWS ------------------------------

  (setq ss1 (ssget "p")) 
  (setq len1 (sslength ss1) n1 0 ss2 (ssadd))

  (if (= ctrl1 1) 
    (while (< n1 len1)
      (setq ename1 (ssname ss1 n1))
      (if (or (= n1 5) (= (rem n1 7) 5)) (ssadd ename1 ss2))
      (setq n1 (1+ n1))
    ) ;end while
    (while (< n1 len1)
      (setq ename1 (ssname ss1 n1))
      (if (or (= n1 0) (= (rem n1 7) 0)) (ssadd ename1 ss2))
      (setq n1 (1+ n1))
    ) ;end while
  ) ;end if

  (command "erase" ss1 "r" ss2 "")
  (setq ss1 ss2)

  ;;---------  Scaling arrows  --------------------------------------

  (setq len1 (sslength ss1) n1 0)

  (while (< n1 len1)
    (setq ename1 (ssname ss1 n1) eget1 (entget ename1))
    (setq p1 (cdr (assoc 10 eget1))) 
    (command "scale" ename1 "" p1 arwsz)
    (setq n1 (1+ n1))
  )  ;end while
  
  ;;---------  Make Polyline First Entity - ENAME  ------------------

  (command "copy" ename "" "0,0" "@" "erase" "p" "")
  (setq ename (entlast)) (redraw ename)
 
  ;;---------  Braking Polyline -------------------------------------
;|
  (setq len1 (sslength ss1))
  (if (= ctrl1 1) (setq n1 0) (setq n1 1))

  (if (= ctrl1 1)
    (while (< n1 (1- len1))
      (setq ename1 (ssname ss1 n1) eget1 (entget ename1))
      (setq p1 (cdr (assoc 10 eget1)))                               ;;; insertion point of arrow
      (setq dist@-X  (vlax-curve-getDistAtPoint ename p1))
      (setq PT1 (vlax-curve-getPointAtDist ENAME dist@-X))           ;;; POINT @ insertion point
      (setq PT2 (vlax-curve-getPointAtDist ENAME (+ dist@-X arwsz))) ;;; NEXT POINT
      (COMMAND "BREAK" ename PT1 PT2)
      (setq ename (entlast)) (redraw ename)
      (setq n1 (1+ n1))
    ) ; end while
    (while (< n1 len1)
      (setq ename1 (ssname ss1 n1) eget1 (entget ename1))
      (setq p1 (cdr (assoc 10 eget1)))                               ;;; insertion point of arrow
      (setq dist@-X  (vlax-curve-getDistAtPoint ename p1))
      (setq PT1 (vlax-curve-getPointAtDist ENAME dist@-X))           ;;; POINT @ insertion point
      (setq PT2 (vlax-curve-getPointAtDist ENAME (- dist@-X arwsz))) ;;; NEXT POINT
      (COMMAND "BREAK" ename PT1 PT2)
      (setq ename (entlast)) (redraw ename)
      (setq n1 (1+ n1))
    ) ; end while
  ) ;end if
|;  
  (setvar "cmdecho" 1)
  (COMMAND "UNDO" "E")  (princ)
) ; end main function

;;;==================================================================

(prompt "\n Start command with [ARB]. ") (princ)

[motee]

thank you greg.battin and for author raymond very nice lisp

[motee]

one more thing linetype with arrow will show wrong direction if we have polyline containing arcs you will see if you test, that arrows on arcs of poly ignore direction of pline and cosider the start and end of arc only

[Tharwat]

Simply you can make an arrow with the shape you want and use the measure command after all

[peter]

Here is my solution to the original question that was asked...

Polylines are strange entities.

This will work on straight line lwpolylines (plinetype system variable set to 1)

Arcs and bulges do not seem to work with this.

Also Arrowheads that straddle intersections are problematic.

Peter

; Function to add verticies to a polyline and make some segments arrows.
 
(defun C:ARWPL (/ objPolyline sngArrowSize sngArrowWidth sngSegment)
 (vl-load-com)
 (and 
  (setq sngSegment       24.0)  ;(getdist "\nEnter Segment Length: "))
  (setq sngArrowSize     5.0)   ;(getdist "\nEnter Arrow Size: "))
  (setq sngArrowWidth    (* 0.4 sngArrowSize))
  (setq objPolyline (polylineselect))
  (polylinemeasure objPolyline sngSegment)
 )
)

; Function to iterate through length of polyline

(defun PolylineMeasure (objPolyline sngSegment / lstofSublists sngDistance)
 (setq sngDistance sngSegment)
 (while (< sngDistance (vlax-curve-getdistatparam objPolyline 
                         (vlax-curve-getendparam objPolyline)))
  (PolylineVertexAdd objPolyline sngDistance)
  (PolylineVertexAdd objPolyline (- sngDistance sngArrowSize))
  (PolylineSetWidth  objPolyline sngDistance sngArrowWidth 0.0)
  (setq sngDistance    (+ sngDistance sngSegment))
 )
 T
)

; Function to set polyline width of a segment at a specified distance, specified widths

(defun PolylineSetWidth (objPolyline sngDistance sngStartWidth sngEndWidth)
 (vlax-invoke objPolyline 
              'SetWidth
              (1- (float (fix (+ 0.01 (vlax-curve-getparamatdist objPolyline sngDistance)))))
              sngStartWidth 
              sngEndWidth
 )
 T
)

; Function to add a vertex to a polyline at a specified distance

(defun PolylineVertexAdd (objPolyline sngDistance)
 (if (< sngDistance (vlax-curve-getdistatparam objPolyline 
                     (vlax-curve-getendparam objPolyline)))
  (vlax-invoke objPolyline 
               'AddVertex
              (1+ (float (fix (vlax-curve-getparamatdist objPolyline sngDistance))))
               (reverse (cdr (reverse (vlax-curve-getpointatdist objPolyline sngDistance))))
  )
 )
 T
)

; Function to select a single lightweight polyline.

(defun PolylineSelect (/ ssSelections entSelection objSelection)
 (princ "\nSelect Polyliine: \n")
 (if (and 
      (setq ssSelections (ssget ":E:S" (list (cons 0 "LWPOLYLINE"))))
      (setq entSelection (ssname ssSelections 0))
     )
  (vlax-ename->vla-object entSelection)
 )
)
(prin1)