Add block at start and end of polyline

[adaptacad]

Hey guys !!
I searched a lot on google but I couldn't find it. My goal is to add a triangle block at the beginning and end of the polyline and rotate it at the angle of the polyline, to look like a starter. If anyone can help it will save me a lot of time.

[ВeekeeCZ]

You caneither pre-select existing polylines to add the arrows, or draw a pline right away.

[adaptacad]

@ВeekeeCZ  That doesn't work I have to insert the block at the beginning and end.

[ВeekeeCZ]

I see. It uses a plinewidth to create arrows. Just another method that some prefer.

[adaptacad]

I understand! This is for an energy company they require it to be their block.

[Kent1Cooper]

---

@adaptacad wrote:

.... they require it to be their block.

---

That's not so special a Block that it should matter much, but anyway....

Its orientation at zero rotation is like this:

That's badly defined, in my opinion.  It makes it more complicated to do what they want than it would be if the zero-rotation Block was like this:

so the routine can use a point along the Polyline segment for the rotation of the Block insertion.

Is it allowable to use their Block but redefined at a different native rotation?

[adaptacad]

Got it @Kent1Cooper  thanks so much for the reply. I believe that rotating would not be a problem.

[Kent1Cooper]

And:

Are you talking about already-drawn Polylines that you would select to have the Blocks added at the ends, or are you looking for a routine that would include the drawing of them before the adding of the Blocks at the ends?

Could they ever include arc end segments?  That would argue for using the direction of the Polyline at the end, whereas if always line segments, the rotation could be defined more simply, by either the midpoint of the end segment or the next vertex in.

[marko_ribar · Accepted solution]

If you are looking for a code, here you are :

(defun c:endpolyarrows ( / *error* tttt wcs initvalueslst ucsf ti bln ss i poly sp spp ep epp a1 a2 )

  (defun *error* ( m )
    (if wcs
      (if ucsf
        (while
          (not
            (and
              (equal (getvar (quote ucsxdir)) (car ucsf) 1e-6)
              (equal (getvar (quote ucsydir)) (cadr ucsf) 1e-6)
              (equal (trans (list 0.0 0.0 1.0) 1 0 t) (caddr ucsf) 1e-6)
            )
          )
          (exe (list "_.UCS" "_P"))
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if initvalueslst
      (mapcar (function apply_cadr->car) initvalueslst)
    )
    (foreach fun (list (quote tttt) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa))
      (setq fun nil)
    )
    (if doc
      (vla-regen doc acactiveviewport)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun tttt ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;;

    (defun vl-load nil
      (or cad
        (if vlax-get-acad-object
          (setq cad (vlax-get-acad-object))
          (progn
            (vl-load-com)
            (setq cad (vlax-get-acad-object))
          )
        )
      )
      (or doc (setq doc (vla-get-activedocument cad)))
      (or alo (setq alo (vla-get-activelayout doc)))
      (or spc (setq spc (vla-get-block alo)))
    )

    ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;;
    (or (and cad doc alo spc) (vl-load))

    (defun exe ( tokenslist )
      ( (lambda ( tokenslist / ctch )
          (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t)))
            (progn
              (cmderr tokenslist)
              (catch_cont ctch)
            )
            (progn
              (while (< 0 (getvar (quote cmdactive)))
                (vl-cmdf "")
              )
              t
            )
          )
        )
        tokenslist
      )
    )

    (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;;
      (if command-s
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))
            ctch
          )
        )
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist)))
            ctch
          )
        )
      )
    )

    (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;;
      (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist)))
    )

    (defun catch_cont ( ctch / gr )
      (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
      (while
        (and
          (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0)))))
          (setq gr (grread))
          (/= (car gr) 3)
          (not (equal gr (list 2 13)))
        )
      )
      (if (vl-catch-all-error-p ctch)
        ctch
      )
    )

    (defun apply_cadr->car ( sysvarvaluepair / ctch )
      (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair))
      (if (vl-catch-all-error-p ctch)
        (progn
          (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair))))
          (catch_cont ctch)
        )
      )
    )

    (defun ftoa ( n / m a s b )
      (if (numberp n)
        (progn
          (setq m (fix ((if (< n 0) - +) n 1e-8)))
          (setq a (abs (- n m)))
          (setq m (itoa m))
          (setq s "")
          (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
            (setq s (strcat s (itoa b)))
            (setq a (- (* a 10.0) b))
          )
          (if (= (type n) (quote int))
            m
            (if (= s "")
              m
              (if (and (= m "0") (< n 0))
                (strcat "-" m "." s)
                (strcat m "." s)
              )
            )
          )
        )
      )
    )

    (setq sysvarpreset
      (list
        (list (quote cmdecho) 0)
        (list (quote 3dosmode) 0)
        (list (quote osmode) 0)
        (list (quote unitmode) 0)
        (list (quote cmddia) 0)
        (list (quote ucsvp) 0)
        (list (quote ucsortho) 0)
        (list (quote projmode) 0)
        (list (quote orbitautotarget) 0)
        (list (quote insunits) 0)
        (list (quote hpseparate) 0)
        (list (quote hpgaptol) 0)
        (list (quote halogap) 0)
        (list (quote edgemode) 0)
        (list (quote pickdrag) 0)
        (list (quote qtextmode) 0)
        (list (quote dragsnap) 0)
        (list (quote angdir) 0)
        (list (quote aunits) 0)
        (list (quote limcheck) 0)
        (list (quote gridmode) 0)
        (list (quote nomutt) 0)
        (list (quote apbox) 0)
        (list (quote attdia) 0)
        (list (quote blipmode) 0)
        (list (quote copymode) 0)
        (list (quote circlerad) 0.0)
        (list (quote filletrad) 0.0)
        (list (quote filedia) 1)
        (list (quote autosnap) 1)
        (list (quote objectisolationmode) 1)
        (list (quote highlight) 1)
        (list (quote lispinit) 1)
        (list (quote layerpmode) 1)
        (list (quote fillmode) 1)
        (list (quote dragmodeinterrupt) 1)
        (list (quote dispsilh) 1)
        (list (quote fielddisplay) 1)
        (list (quote deletetool) 1)
        (list (quote delobj) 1)
        (list (quote dblclkedit) 1)
        (list (quote attreq) 1)
        (list (quote explmode) 1)
        (list (quote frameselection) 1)
        (list (quote ltgapselection) 1)
        (list (quote pickfirst) 1)
        (list (quote plinegen) 1)
        (list (quote plinetype) 1)
        (list (quote peditaccept) 1)
        (list (quote solidcheck) 1)
        (list (quote visretain) 1)
        (list (quote regenmode) 1)
        (list (quote celtscale) 1.0)
        (list (quote ltscale) 1.0)
        (list (quote osnapcoord) 2)
        (list (quote grips) 2)
        (list (quote dragmode) 2)
        (list (quote lunits) 2)
        (list (quote pickstyle) 3)
        (list (quote navvcubedisplay) 3)
        (list (quote pickauto) 3)
        (list (quote draworderctl) 3)
        (list (quote expert) 5)
        (list (quote auprec) 6)
        (list (quote luprec) 6)
        (list (quote pickbox) 6)
        (list (quote aperture) 6)
        (list (quote osoptions) 7)
        (list (quote dimzin) 8)
        (list (quote pdmode) 35)
        (list (quote pdsize) -1.5)
        (list (quote celweight) -1)
        (list (quote cecolor) "BYLAYER")
        (list (quote celtype) "ByLayer")
        (list (quote clayer) "0")
      )
    )
    (setq sysvarlst (mapcar (function car) sysvarpreset))
    (setq sysvarvals (mapcar (function cadr) sysvarpreset))
    (setq sysvarvals
      (vl-remove nil
        (mapcar
          (function (lambda ( x )
            (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals))
          ))
          sysvarlst
        )
      )
    )
    (setq sysvarlst
      (vl-remove-if-not
        (function (lambda ( x )
          (getvar x)
        ))
        sysvarlst
      )
    )
    (setq initvalueslst
      (apply (function mapcar)
        (cons (function list)
          (list
            sysvarlst
            (mapcar (function getvar) sysvarlst)
          )
        )
      )
    )
    (apply (function mapcar)
      (cons (function setvar)
        (list
          sysvarlst
          sysvarvals
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if (not (exe (list "_.UNDO" "_M")))
      (if doc
        (vla-startundomark doc)
      )
    )
    (if wcs
      (if (= 0 (getvar (quote worlducs)))
        (progn
          (setq ucsf
            (list
              (getvar (quote ucsxdir))
              (getvar (quote ucsydir))
              (trans (list 0.0 0.0 1.0) 1 0 t)
            )
          )
          (exe (list "_.UCS" "_W"))
        )
      )
    )
    wcs
  )

  (setq wcs (tttt t)) ;;; starting "library" template sub function - initialization ;;;
  (setq bln "indicator")
  (if (setq ss (ssget (list (cons 0 "*POLYLINE") (cons -4 "<not") (cons -4 "&=") (cons 70 1) (cons -4 "not>"))))
    (progn
      (setq ti (car (_vl-times)))
      (repeat (setq i (sslength ss))
        (setq poly (ssname ss (setq i (1- i))))
        (setq sp (vlax-curve-getstartpoint poly))
        (setq spp (vlax-curve-getpointatparam poly 1.0))
        (setq ep (vlax-curve-getendpoint poly))
        (setq epp (vlax-curve-getpointatparam poly (float (1- (vlax-curve-getendparam poly)))))
        (setq a1 (cvunit (angle spp sp) "radian" "degree"))
        (setq a2 (cvunit (angle epp ep) "radian" "degree"))
        (setq a1 (+ a1 90.0) a2 (+ a2 90.0))
        (exe (list "_.INSERT" bln "_non" sp "" "" a1))
        (exe (list "_.INSERT" bln "_non" ep "" "" a2))
      )
      (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
      (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
    )
  )
  (*error* nil)
)

HTH.

M.R.

[adaptacad]

This will help me a lot!! Thanks @marko_ribar 

[Kent1Cooper]

Assuming selection of pre-drawn open-ended Polylines of only line-variety end segments, and with the "indicator" Block redefined as suggested in my earlier Reply, is this not enough?  [It works for me in your sample drawing.]

(defun C:APBE (/ ss n pl); = Arrows on Polylines, Both Ends
  (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 1) (-4 . "NOT>"))))
    (repeat (setq n (sslength ss)); then
      (setq pl (ssname ss (setq n (1- n))))
      (command
        "_.insert" "indicator" "_non" (vlax-curve-getStartPoint pl)
          1 1 "_non" (vlax-curve-getPointAtParam pl 1)
        "_.insert" "indicator" "_non" (vlax-curve-getEndPoint pl)
          1 1 "_non" (vlax-curve-getPointAtParam pl (1- (vlax-curve-getEndParam pl)))
      ); command
    ); repeat
  ); if
  (prin1)
)

If you want them, it could use Undo begin/end wrapping, Layer control, *error* handling, perhaps Block scaling dependent on the drawing's intended scale.

Open-endedness is required by the selection filter, but having line segments at the ends is up to you [though it could be enhanced to check for that, or in a different way to just use the direction rather than the next vertex in].

[Sea-Haven]

Maybe version 2 detects lines also.

(defun C:APBE (/ ss n pl plent); = Arrows on Polylines, Both Ends
  (if (setq ss (ssget '((0 . "LWPOLYLINE,LINE") )))
    (repeat (setq n (sslength ss)); then
      (setq pl (ssname ss (setq n (1- n))))
	  (setq plent (entget pl))
	  (if (or (and (= (cdr (assoc 0 plent)) "LWPOLYLINE")(/= (cdr (assoc 70 plent)) 1))(= (cdr (assoc 0 plent)) "LINE"))
      (command
        "_.insert" "indicator" "_non" (vlax-curve-getStartPoint pl)
          1 1 "_non" (vlax-curve-getPointAtParam pl 1)
        "_.insert" "indicator" "_non" (vlax-curve-getEndPoint pl)
          1 1 "_non" (vlax-curve-getPointAtParam pl (1- (vlax-curve-getEndParam pl)))
      ); command
	  ) ; if
    ); repeat
  ); if
  (prin1)
)

[Kent1Cooper]

---

@Sea-Haven wrote:

Maybe version 2 detects lines also. ....

---

[That, with the simple modification of adding LINE to the selectable entity types, will fail if a Line is less than 1 drawing unit long.  A parameter value on a Line is not the same as on a Polyline, but is just the length at that point.  Calling for a parameter greater than the Line's length for the rotation on the start Block will try to find a place beyond the end, and give a nil return.  I haven't tried, but for the end Block, it will call for a negative parameter value, which may be rejected.]