self intersection

Jaco

Usenet Archive
Joined
Aug 22, 2003
Messages
2
Reaction score
0
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 . "<NOT") (0 . "REGION") (-4 . "NOT>")))   )   ;; 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)
)
 
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.
 

Latest threads

Back
Top