Polyline 2 Countour lines

[aclima01]

Hello
It would be very useful to have a command that creates outline lines from a group of polylines, including their thickness, as shown in the figure. I did not find anything similar on the internet and I do not even know if it would be possible. Any suggestion / help?

[hmsilva]

Try Lee Mac's Polyline Outline

Hope this helps,
Henrique

[aclima01]

Nice!

Its not perfect, but it is a good help

Obrigado

[marko_ribar]

@aclima01 

Maybe something like this :

(Sometimes it may be buggy, but generally it's working fine...)

(defun c:globalwidthlws2outlines ( / *error* adoc ch sss el ss i lw gw lw1 lw2 li1 li2 regs )

  (vl-load-com)

  (defun *error* ( m )
    (if adoc
      (vla-endundomark adoc)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (initget "Convtosurface Offset")
  (setq ch (getkword "\nChoose option - convtosurface method (more reliable); offset method (less reliable) [Convtosurface/Offset] <Convtosurface> : "))
  (if (null ch)
    (setq ch "Convtosurface")
  )
  (if (= ch "Offset")
    (progn
      (setq sss (ssadd) el (entlast))
      (prompt "\nSelect open or closed LWPOLYLINES with global widths...")
      (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . ">") (43 . 0.0))))
        (progn
          (repeat (setq i (sslength ss))
            (setq lw (ssname ss (setq i (1- i))))
            (setq gw (cdr (assoc 43 (entget lw))))
            (if (= 1 (logand 1 (cdr (assoc 70 (entget lw)))))
              (progn
                (setq lw1 (vlax-vla-object->ename (car (safearray-value (variant-value (vla-offset (vlax-ename->vla-object lw) (/ gw 2.0)))))))
                (setq lw2 (vlax-vla-object->ename (car (safearray-value (variant-value (vla-offset (vlax-ename->vla-object lw) (/ gw -2.0)))))))
                (if (> (vlax-curve-getarea lw1) (vlax-curve-getarea lw2))
                  (progn
                    (vla-boolean (car (vlax-invoke (vla-get-block (vla-get-activelayout adoc)) 'addregion (list (vlax-ename->vla-object lw1)))) acsubtraction (car (vlax-invoke (vla-get-block (vla-get-activelayout adoc)) 'addregion (list (vlax-ename->vla-object lw2)))))
                    (ssadd (entlast) sss)
                  )
                  (progn
                    (vla-boolean (car (vlax-invoke (vla-get-block (vla-get-activelayout adoc)) 'addregion (list (vlax-ename->vla-object lw2)))) acsubtraction (car (vlax-invoke (vla-get-block (vla-get-activelayout adoc)) 'addregion (list (vlax-ename->vla-object lw1)))))
                    (ssadd (entlast) sss)
                  )
                )
                (entdel lw1)
                (entdel lw2)
              )
              (progn
                (setq lw1 (vlax-vla-object->ename (car (safearray-value (variant-value (vla-offset (vlax-ename->vla-object lw) (- (/ gw 2.0) 1e-11)))))))
                (setq lw2 (vlax-vla-object->ename (car (safearray-value (variant-value (vla-offset (vlax-ename->vla-object lw) (+ (/ gw -2.0) 1e-11)))))))
                (setq li1 (entmakex (list '(0 . "LINE") (cons 10 (vlax-curve-getstartpoint lw1)) (cons 11 (vlax-curve-getstartpoint lw2)))))
                (setq li2 (entmakex (list '(0 . "LINE") (cons 10 (vlax-curve-getendpoint lw1)) (cons 11 (vlax-curve-getendpoint lw2)))))
                (ssadd (vlax-vla-object->ename (car (vlax-invoke (vla-get-block (vla-get-activelayout adoc)) 'addregion (list (vlax-ename->vla-object lw1) (vlax-ename->vla-object lw2) (vlax-ename->vla-object li1) (vlax-ename->vla-object li2))))) sss)
                (entdel lw1)
                (entdel lw2)
                (entdel li1)
                (entdel li2)
              )
            )
          )
          (setq regs (vl-remove-if 'listp (mapcar 'cadr (ssnamex sss))))
          (while (and (cadr regs) (not (vlax-erased-p (cadr regs))))
            (vla-boolean (vlax-ename->vla-object (car regs)) acunion (vlax-ename->vla-object (cadr regs)))
            (setq regs (cons (car regs) (cddr regs)))
          )
        )
      )
    )
    (progn
      (alert "Set UCS to be planar with reference LWPOLYLINEs and restart routine again if not set...")
      (setq sss (ssadd) el (entlast))
      (prompt "\nSelect open or closed LWPOLYLINES with global widths on unlocked layer(s)...")
      (if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . ">") (43 . 0.0))))
        (progn
          (repeat (setq i (sslength ss))
            (setq lw (ssname ss (setq i (1- i))))
            (vl-cmdf "_.CONVTOSURFACE" (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object lw))))
            (while (< 0 (getvar 'cmdactive))
              (vl-cmdf "")
            )
            (if (not (eq el (entlast)))
              (progn
                (ssadd (entlast) sss)
                (setq el (entlast))
              )
            )
          )
          (vl-cmdf "_.EXTRUDE" sss "" 0.1)
          (while (< 0 (getvar 'cmdactive))
            (vl-cmdf "")
          )
          (setq sss (ssadd))
          (while (setq el (entnext el))
            (ssadd el sss)
          )
          (setq el (entlast))
          (vl-cmdf "_.UNION" sss)
          (while (< 0 (getvar 'cmdactive))
            (vl-cmdf "")
          )
          (if (not (eq el (entlast)))
            (progn
              (setq el (entlast))
              (vl-cmdf "_.EXPLODE" el)
              (while (< 0 (getvar 'cmdactive))
                (vl-cmdf "")
              )
            )
            (if sss
              (progn
                (vl-cmdf "_.EXPLODE" (vl-some '(lambda ( x ) (if (not (vlax-erased-p x)) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sss)))))
                (while (< 0 (getvar 'cmdactive))
                  (vl-cmdf "")
                )
              )
            )
          )
          (setq sss (ssadd))
          (foreach reg (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_P"))))
            (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-centroid (list (vlax-ename->vla-object reg))))
              (entdel reg)
              (ssadd reg sss)
            )
          )
          (vl-cmdf "_.UNION" sss)
          (while (< 0 (getvar 'cmdactive))
            (vl-cmdf "")
          )
        )
      )
    )
  )
  (if (not (eq el (entlast)))
    (sssetfirst nil (ssadd (entlast)))
  )
  (vl-cmdf "_.REGEN")
  (*error* nil)
)

Regards, M.R.

[aclima01]

Cool!

Making regions, not polylines, right? Still a big help.

Its working with curved segments and 2 intersected polylines, wich is great, but apparently not with a self intersected polyline. Could this feature be added?

[marko_ribar]

---

@aclima01 wrote:

Cool!

Making regions, not polylines, right? Still a big help.

Its working with curved segments and 2 intersected polylines, wich is great, but apparently not with a self intersected polyline. Could this feature be added?

---

Not directly with this routine... But I have routine which splits self-intersecting LWPOLYLINE(s) and that's another story... And BTW. I am not willing to share it... But for your info - it is possible, but with extra steps and beside this you would have to assign to split LWPOLYLINE(s) WIDTH property again and apply previously posted code...

[john.uhden]

BTW,

If you use the format...

(VLAX-INVOKE OBJECT 'OFFSET distance)

it returns a list of the VLA-OBJECTs created, avoiding all that safearray crap.