The following is lazy & terrible coding, but should produce the desired result:
(defun c:test ( / sel )
(if (setq sel (ssget "_+.:E:S:L" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
(splitpoly (ssname sel 0))
)
(princ)
)
(defun splitpoly ( ent / *error* are col enx lin lst mxa mxp new nwp ply pnt reg tmp val var vec vtx )
(defun *error* ( msg )
(mapcar 'setvar var val)
(LM:endundo (LM:acdoc))
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(princ)
)
(LM:startundo (LM:acdoc))
(setq col 0
var '(cmdecho peditaccept)
val (mapcar 'getvar var)
enx (entget ent)
vtx (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx))
)
(mapcar 'setvar var '(0 1))
(if (= 1 (logand 1 (cdr (assoc 70 enx))))
(setq vtx (cons (last vtx) vtx))
)
(while (cadr vtx)
(setq tmp (list (car vtx) (cadr vtx)))
(foreach x (setq vtx (cdr vtx))
(if (LM:collinear-p x (car tmp) (cadr tmp))
(setq tmp (cons x tmp))
)
)
(setq lst (cons tmp lst) tmp nil)
)
(foreach x lst
(setq vec (mapcar '- (car x) (cadr x))
lin
(append lin
(mapcar
'(lambda ( a b )
(vlax-ename->vla-object
(entmakex (list '(0 . "LINE") (cons 10 a) (cons 11 b)))
)
)
(setq x
(vl-sort x
'(lambda ( a b )
(< (caddr (trans a ent vec))
(caddr (trans b ent vec))
)
)
)
)
(cdr x)
)
)
)
)
(foreach obj
(setq reg
(vlax-invoke
(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
'addregion lin
)
)
(command "_.pedit" "_m")
(apply 'command (mapcar 'vlax-vla-object->ename (vlax-invoke obj 'explode)))
(command "" "_j" "" "")
(vla-delete obj)
(setq ply (entlast)
vtx (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget ply)))
new (list (cadr vtx) (car vtx))
vtx (cddr vtx)
)
(while (setq pnt (car vtx))
(setq vtx (cdr vtx))
(if (LM:collinear-p pnt (car new) (cadr new))
(setq new (cons pnt (cdr new)))
(setq new (cons pnt new))
)
)
(setq new (reverse new))
(while (LM:collinear-p (car new) (cadr new) (last new))
(setq new (cdr new))
)
(setq nwp
(entmakex
(append
(list
'(000 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length new))
'(070 . 1)
(cons 62 (setq col (1+ col)))
)
(mapcar '(lambda ( p ) (cons 10 p)) new)
)
)
)
(if (< mxa (setq are (vla-get-area (vlax-ename->vla-object ply))))
(setq mxa are
mxp nwp
)
)
(entdel ply)
)
(foreach l lin (vla-delete l))
(entdel ent)
(entdel mxp)
(*error* nil)
(princ)
)
;; Collinear-p - Lee Mac
;; Returns T if p1,p2,p3 are collinear
(defun LM:Collinear-p ( p1 p2 p3 )
( (lambda ( a b c )
(or
(equal (+ a b) c 1e-3)
(equal (+ b c) a 1e-3)
(equal (+ c a) b 1e-3)
)
)
(distance p1 p2) (distance p2 p3) (distance p1 p3)
)
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)