Polyline intersect itself

Is it there anyway (other than testing each segment with the others) to know
if a polyline have a segment that intersect another of the same PLINE, in
order to be able to extrude it, (or any way to know if it is able to be
extruded or not)

Thanks

 

You can use the IntersectWith method, and if there is more points in the variant returned then vertices of the polyline, then it intersects itself.

Tim

 

Hi,

If you have map, the drawing cleanup tools will fix these problems. I cheat
and do this one with a "Sendcommand" from VBA, but you could do the same
with lisp.

--

Regards,


Laurie Comerford
www.cadapps.com.au

 

;; Try this: ;;

;; Intersection 3dpoly itself ;;

(defun inactx ()
(vl-load-com)
(setq adoc
(vla-get-activedocument
(vlax-get-acad-object))
mdsp (vla-get-modelspace adoc)))

(defun conapp (lst / rlst)
(cond
((null lst) nil)
(T (append rlst (list (list (car lst)(cadr lst)(caddr lst)))
(conapp (cdddr lst))))))

(defun catchlist (pnt)
(vl-load-com)
(if pnt (vl-catch-all-apply
'vlax-safearray->list
(list (vlax-variant-value pnt)))))

;______end of 'hlps_____;

(defun C:ters (/ ob1 ob2 pts rlst
adoc cir en int_lst
mdsp vlst x)
(inactx)
(setq en (car (entsel "\nSelect polyline : >>> \n"))
ob1 (vlax-ename->vla-object en)
ob2 (vla-copy ob1)
pts (vl-catch-all-apply 'vla-IntersectWith (list ob1 ob2
acExtendNone))
)
(cond
((vl-catch-all-error-p pts) nil)
((vl-catch-all-error-p
(setq pts (catchlist pts))) nil)
(t pts (while pts
(setq rlst (cons (list (car pts)(cadr pts)(caddr pts))rlst)
pts (cdddr pts))) rlst))
(print rlst)
(setq vlst (conapp (catchlist (vla-get-coordinates ob1))))
(print vlst);catch it
(setq int_lst (vl-remove-if
(function (lambda (x)
(member x vlst))) rlst))

;; Test :
(mapcar '(lambda (x)
(setq cir (vla-addsphere mdsp x 3.))
(vla-put-color cir acred))
(mapcar 'vlax-3d-point int_lst));test
(vla-delete ob2)
(vlax-release-object ob1)
(vla-zoomextents (vla-get-application adoc))
(vla-regen adoc acActiveViewport)
(princ)
)

 

;;ob2(no need)!
(defun C:TERS (/ OB1 ;|OB2|; PTS RLST ADOC CIR EN INT_LST MDSP VLST X)
(INACTX)
(setq EN (car (entsel "\nSelect polyline : >>> \n"))
OB1 (vlax-ename->vla-object EN)
;OB2 (vla-copy OB1)
PTS (vl-catch-all-apply
'vla-intersectwith
(list OB1
OB1
acextendnone
)
)
)
(cond
((vl-catch-all-error-p PTS) NIL)
((vl-catch-all-error-p (setq PTS (CATCHLIST PTS)))
NIL
)
(t
PTS
(while PTS
(setq RLST (cons (list (car PTS) (cadr PTS) (caddr PTS)) RLST)
PTS (cdddr PTS)
)
)
RLST
)
)
(print RLST)
(setq VLST (CONAPP (CATCHLIST (vla-get-coordinates OB1))))
(print VLST) ;catch it
(setq INT_LST (vl-remove-if
(function (lambda (X)
(member X VLST)
)
)
RLST
)
)

;; Test :
(mapcar '(lambda (X)
(setq CIR (vla-addsphere MDSP X 3.))
(vla-put-color CIR acred)
)
(mapcar 'vlax-3d-point INT_LST)
) ;test
;(vla-delete OB2)
(vlax-release-object OB1)
(vla-zoomextents (vla-get-application ADOC))
(vla-regen ADOC acactiveviewport)
(princ)
)

 

thanx, LUCAS
You absolutely right