Topic: Polyline: List of vertex incl. middle of bulges?

[Peter2]

I know some lists for creating vertexlists and I know some "bulge-feature", but does someone know a routine which creates a list of vertex incl. the mids of bulges?

Thanks for hints!

[roy_043]

Simple solution that makes use of vlax-curve-getpointatparam. Points in WCS.

Code: [Select]

; (ListPolyPoints (vlax-ename->vla-object (car (entsel))))
(defun ListPolyPoints (obj / endParam param ret)
  (setq param 0)
  (setq endParam (vlax-curve-getendparam obj))
  (repeat (+ (fix endParam) (if (= :vlax-true (vla-get-closed obj)) 0 1))
    (setq ret (cons (vlax-curve-getpointatparam obj param) ret))
    (if (and (< param endParam) (/= 0 (vla-getbulge obj param)))
      (setq ret (cons (vlax-curve-getpointatparam obj (+ 0.5 param)) ret))
    )
    (setq param (1+ param))
  )
  (reverse ret)
)

[Peter2]

Great. Thanks!

[Lee Mac]

Here's another possible method using Vanilla AutoLISP:

Code - Auto/Visual Lisp: [Select]

1. (defun lwverticesmidpoints ( enx / vt1 vt2 )
2.     (if (setq vt1 (assoc 10 enx))
3.         (if (setq vt2 (assoc 10 (cdr (member vt1 enx))))
4.             (vl-list*
5.                 (cdr vt1)
6.                 (mapcar '+
7.                     (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (cdr vt1) (cdr vt2))
8.                     (   (lambda ( v ) (mapcar '(lambda ( x ) (* 0.5 (cdr (assoc 42 enx)) x)) (list (cadr v) (- (car v)))))
9.                         (mapcar '- (cdr vt2) (cdr vt1))
10.                     )
11.                 )
12.                 (lwverticesmidpoints (member vt2 enx))
13.             )
14.             (list (cdr vt1))
15.         )
16.     )
17. )

To test:

Code - Auto/Visual Lisp: [Select]

1. (defun c:test ( / e )
2.     (if (setq e (car (entsel)))
3.         (foreach x (lwverticesmidpoints (entget e))
4.             (entmake (list '(0 . "POINT") (cons 10 x)))
5.         )
6.     )
7.     (princ)
8. )

EDIT: To account for closed polylines:

Code - Auto/Visual Lisp: [Select]

1. (defun lwverticesmidpoints ( enx / vt1 vt2 )
2.     (if (and (assoc 70 enx) (= 1 (logand 1 (cdr (assoc 70 enx)))))
3.         (setq enx (append enx (list (assoc 10 enx))))
4.     )
5.     (if (setq vt1 (assoc 10 enx))
6.         (if (setq vt2 (assoc 10 (cdr (member vt1 enx))))
7.             (vl-list*
8.                 (cdr vt1)
9.                 (mapcar '+
10.                     (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (cdr vt1) (cdr vt2))
11.                     (   (lambda ( v ) (mapcar '(lambda ( x ) (* 0.5 (cdr (assoc 42 enx)) x)) (list (cadr v) (- (car v)))))
12.                         (mapcar '- (cdr vt2) (cdr vt1))
13.                     )
14.                 )
15.                 (lwverticesmidpoints (member vt2 enx))
16.             )
17.             (list (cdr vt1))
18.         )
19.     )
20. )