Insert blocks at the vertices of the polyline and align to the segments

[Browning_Zed]

Hi,

I need a routine that inserts and rotates blocks relative to a polyline.

How it should be: one block is inserted into the end vertices of the polyline, two blocks are inserted into the intermediate vertices, the blocks unfold along the polyline segments and are directed in opposite directions.

To explain in more detail, I have attached an image and a dwg file, which uses the "Arrow" block as an example.

Any help is appreciated.

[JBerns]

@Browning_Zed,

Will you need to support both lightweight and standard polylines?

Will the polylines contain only straight segments?

If a polyline is detected containing arc segments, should the command exit?

How will the block insertion scale be determined?

How should a closed polyline be handled?

What is your programming experience? Is your goal to learn code development or are you looking for a finished solution?

Just some initial thoughts. I'm sure others will have more questions.

Regards,

Jerry

[Browning_Zed]

1. LWPolyline only.
2. Only straight segments.
3. If arc segments are detected, they may be skipped or the command may exit.
4. Before inserting, the block needs to set the scale and layer.
5. Closed polyline must be ignored.
6. I am just starting to learn LISP.

[marko_ribar · Accepted solution]

I didn't see your comments, but I did for both open or closed LWPOLYLINES and for both straight or arced segmented LWPOLYLINES...

I hope you don't mind, I think its better more then less...

(defun c:insarrowsalonglw ( / mid lw bln data dat k mp c )

  (defun mid ( p1 p2 )
    (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  )

  (vl-cmdf "_.UNDO" "_BE")
  (while
    (or
      (not (setq lw (car (entsel "\nPick LWPOLYLINE to place block \"Arrow\" on its vertices..."))))
      (if lw
        (/= (cdr (assoc 0 (entget lw))) "LWPOLYLINE")
      )
    )
    (prompt "\nMissed or picked wrong entity type...")
  )
  (setq bln "Arrow")
  (setq data (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 42))) (entget lw)))
  (if (= 1 (logand 1 (cdr (assoc 70 (entget lw)))))
    (setq data (append data (list (car data) (last data))))
  )
  (setq dat data data nil)
  (while dat
    (setq data (cons (list (car dat) (cadr dat)) data))
    (setq dat (cddr dat))
  )
  (setq data (reverse data) k -1)
  (foreach d data
    (setq k (1+ k))
    (if (< k (1- (length data)))
      (if (zerop (cdr (cadr d)))
        (progn
          (vl-cmdf "_.-INSERT" bln "_non" (cdr (car d)) 1.0 1.0 (cvunit (angle (cdr (car d)) (cdr (car (nth (1+ k) data)))) "radian" "degree"))
          (vl-cmdf "_.-INSERT" bln "_non" (cdr (car (nth (1+ k) data))) 1.0 1.0 (cvunit (angle (cdr (car (nth (1+ k) data))) (cdr (car d))) "radian" "degree"))
        )
        (progn
          (setq mp (inters (cdr (car d)) (polar (cdr (car d)) (- (angle (cdr (car d)) (cdr (car (nth (1+ k) data)))) (atan (cdr (cadr d)))) 1.0) (cdr (car (nth (1+ k) data))) (polar (cdr (car (nth (1+ k) data))) (+ (angle (cdr (car (nth (1+ k) data))) (cdr (car d))) pi (atan (cdr (cadr d)))) 1.0) nil))
          (setq c (inters (mid (cdr (car d)) mp) (polar (mid (cdr (car d)) mp) (+ (angle (cdr (car d)) mp) (* 0.5 pi)) 1.0) (mid mp (cdr (car (nth (1+ k) data)))) (polar (mid mp (cdr (car (nth (1+ k) data)))) (+ (angle mp (cdr (car (nth (1+ k) data)))) (* 0.5 pi)) 1.0) nil))
          (vl-cmdf "_.-INSERT" bln "_non" (cdr (car d)) 1.0 1.0 (cvunit ((if (minusp (cdr (cadr d))) - +) (angle c (cdr (car d))) (* 0.5 pi)) "radian" "degree"))
          (vl-cmdf "_.-INSERT" bln "_non" (cdr (car (nth (1+ k) data))) 1.0 1.0 (cvunit ((if (minusp (cdr (cadr d))) + -) (angle c (cdr (car (nth (1+ k) data)))) (* 0.5 pi)) "radian" "degree"))
        )
      )
    )
  )
  (vl-cmdf "_.UNDO" "_E")
  (princ)
)

[Browning_Zed]

Thanks a lot for the code! Is it possible to add a condition so that the command is also executed if the polyline is selected before starting the command?

[JBerns]

Nicely done, @marko_ribar. 

In reply to @Browning_Zed  question about pre-select, the code could certainly be modified.

If you need to insert arrows on several polylines, the code could be modified to process a selection set.

Great thing about code - you can keep enhancing.

Regards,

Jerry

[Browning_Zed]

I tried:

(setq lw (ssget ": L" '((0. "LWPOLYLINE"))))

but it doesn't work.

[Kent1Cooper]

---

@Browning_Zed wrote:

I tried:

(setq lw (ssget ": L" '((0. "LWPOLYLINE"))))

but it doesn't work.

---

No space between the colon and the L, but you need one between the 0 and the period/decimal.  But I don't see any reason to restrict the selection to Polylines that are not on locked Layers -- is there any reason the Blocks shouldn't be added to those?

[Browning_Zed]

The locked layer is not important, but ssget doesn't work anyway.
(setq lw (ssget '((0 . "LWPOLYLINE"))))
return "lentityp <Selection set: 120c>"

[marko_ribar]

You haven't studied well selection set handling... Here it is, just a small mod...

(defun c:insarrowsalonglw ( / mid bln ss i lw data dat k mp c )

  (defun mid ( p1 p2 )
    (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  )

  (vl-cmdf "_.UNDO" "_BE")
  (setq bln "Arrow")
  (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (repeat (setq i (sslength ss))
      (setq lw (ssname ss (setq i (1- i))))
      (setq data (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 42))) (entget lw)))
      (if (= 1 (logand 1 (cdr (assoc 70 (entget lw)))))
        (setq data (append data (list (car data) (last data))))
      )
      (setq dat data data nil)
      (while dat
        (setq data (cons (list (car dat) (cadr dat)) data))
        (setq dat (cddr dat))
      )
      (setq data (reverse data) k -1)
      (foreach d data
        (setq k (1+ k))
        (if (< k (1- (length data)))
          (if (zerop (cdr (cadr d)))
            (progn
              (vl-cmdf "_.-INSERT" bln "_non" (cdr (car d)) 1.0 1.0 (cvunit (angle (cdr (car d)) (cdr (car (nth (1+ k) data)))) "radian" "degree"))
              (vl-cmdf "_.-INSERT" bln "_non" (cdr (car (nth (1+ k) data))) 1.0 1.0 (cvunit (angle (cdr (car (nth (1+ k) data))) (cdr (car d))) "radian" "degree"))
            )
            (progn
              (setq mp (inters (cdr (car d)) (polar (cdr (car d)) (- (angle (cdr (car d)) (cdr (car (nth (1+ k) data)))) (atan (cdr (cadr d)))) 1.0) (cdr (car (nth (1+ k) data))) (polar (cdr (car (nth (1+ k) data))) (+ (angle (cdr (car (nth (1+ k) data))) (cdr (car d))) pi (atan (cdr (cadr d)))) 1.0) nil))
              (setq c (inters (mid (cdr (car d)) mp) (polar (mid (cdr (car d)) mp) (+ (angle (cdr (car d)) mp) (* 0.5 pi)) 1.0) (mid mp (cdr (car (nth (1+ k) data)))) (polar (mid mp (cdr (car (nth (1+ k) data)))) (+ (angle mp (cdr (car (nth (1+ k) data)))) (* 0.5 pi)) 1.0) nil))
              (vl-cmdf "_.-INSERT" bln "_non" (cdr (car d)) 1.0 1.0 (cvunit ((if (minusp (cdr (cadr d))) - +) (angle c (cdr (car d))) (* 0.5 pi)) "radian" "degree"))
              (vl-cmdf "_.-INSERT" bln "_non" (cdr (car (nth (1+ k) data))) 1.0 1.0 (cvunit ((if (minusp (cdr (cadr d))) + -) (angle c (cdr (car (nth (1+ k) data)))) (* 0.5 pi)) "radian" "degree"))
            )
          )
        )
      )
    )
  )
  (vl-cmdf "_.UNDO" "_E")
  (princ)
)

[Browning_Zed]

Thank you so much! You helped me a lot.