self intersection

self intersection

Anonymous
Not applicable
340 Views
1 Reply
Message 1 of 2

self intersection

Anonymous
Not applicable
Hy,
Does anybody know if is there a property or method, or any other way, to check if it is possible to extrude one polyline or not? My intention was to write a routine wich could filter 2d polyline with a "self-intersection" ..
Tanks, Jacopo Russo.

The following code is the only way I have found, but it is not very smart..

;;; this function checks if any selected object has self-intersections
;;; trying to extract regions from the entities *JAC 2002*
(defun C:SELFCHK ()
(prompt "AutoInt Fuction Running *JAC 2002*")
(command "_LAYER" "_NEW" "_autoint_chk_temp"
"_MAKE" "_autoint_chk_temp"
""
)
(command "_REGION" (setq selection (ssget)) "")

(setq selection
(ssget "p" '((-4 . "")))
)
;; select any object in previous selection sect, wich is not a region

(command "_UNDO" "2")
;; undo creating new layer and extracting regions

(if (not (= selection nil))
;; if any self intersection exists ...
(progn ;; execute the following instructions:

;; loops trough the self-intersecting objects found and paint them with cyan "ink"
(setq N1 0

SSL (sslength selection)
)
(while (< N1 SSL)
(setq object (entget (ssname selection N1)))
(paintobj object)
(setq N1 (1+ N1))
)
;; while
(prompt "\ntest copmplete")
(prompt "\n")
(prompt (itoa SSL))
(prompt " Auto intersections found in selected objects.")
)
;; progn
)
;; if
(if (= selection nil)
;; if no self intersection exists ...
(progn ;; execute the following instructions:
(prompt "\ntest copmplete")
(prompt
"\nNo Auto Intersection was found in selected objects."
)
)
)
(princ)
)

(defun paintobj (object / ink)
;; cambia colore a un oggetto
(setq ink 4)

(setq b3 (append object (list (cons 62 ink))))
(entmod b3)
)
0 Likes
341 Views
1 Reply
Reply (1)
Message 2 of 2

Anonymous
Not applicable
Jaco,

This does the same thing but with vlisp - from a suggestion in this newsgroup:

;;f:pline_intersects returns T if given a self-intersecting lwpolyline
;;

(defun f:pline_intersects (en / sa rg)
(setq sa (vlax-make-safearray vlax-vbObject '(0 . 0))
sa (vlax-make-variant (vlax-safearray-fill sa (list (f:enx en))))
);setq
(if (vl-catch-all-error-p (setq rg (vl-catch-all-apply 'vla-addregion (list (fx:active_space) sa))))
(if (wcmatch (strcase (vl-catch-all-error-message rg)) "*UNGÜLTIGE*") T)
(vla-Delete (car (vlax-safearray->list (vlax-variant-value rg))))
)
)

(defun fx:active_space ()
(if (zerop (getvar "TILEMODE"))
(vla-get-PaperSpace (fx:doc))
(vla-get-ModelSpace (fx:doc))
)
)

(defun f:enx (en)
(if (= (type en) 'ENAME)
(vlax-ename->vla-object en)
en
)
)


You will need to modify "*UNGÜLTIGE*" to match the vl-catch-all-error-message of the language that you are working in.
0 Likes