
- ;;-----------------------------------------------
- ;; CDNC5-02.LSP
- ;; Bill Kramer
- ;; Find all intersections between objects in
- ;; the selection set SS.
- ;; Process - Create drawing with intersecting lines and lwpolylines.
- ;; Load function set
- ;; Run command function INTLINES
- ;; Intersections are marked with POINT objects on current layer
- (defun C:INTLINES (/ SSL ;length of SS
- PTS ;returning list
- AOBJ1 ;Object 1
- AOBJ2 ;Object 2
- N1 ;Loop counter
- N2 ;Loop counter
- IPTS ;intersects
- A N NN HOLDOSMODE)
- (vl-load-com)
- (COMMAND "_.UNDO" "_GROUP")
- (SETQ HOLDOSMODE (GETVAR "OSMODE"))
- (SETVAR "OSMODE" 0)
- (setq SS (ssget '((0 . "*LINE,ARC"))))
- (setq N1 0 ;index for outer loop
- SSL (sslength SS)
- ) ; Outer loop, first through second to last
- (while (< N1 (1- SSL)) ; Get object 1, convert to VLA object type
- (setq AOBJ1 (ssname SS N1)
- AOBJ1 (vlax-ename->vla-object AOBJ1)
- N2 (1+ N1)
- ) ;index for inner loop
- ;;; Inner loop, go through remaining objects
- (while (< N2 SSL) ; Get object 2, convert to VLA object
- (setq AOBJ2 (ssname SS N2)
- AOBJ2 (vlax-ename->vla-object AOBJ2)
- ;;;Find intersections of Objects
- IPTS (vla-intersectwith
- AOBJ1
- AOBJ2
- 0
- ) ; variant result
- IPTS (vlax-variant-value IPTS)
- )
- ;;;Variant array has values?
- (if (> (vlax-safearray-get-u-bound IPTS 1) 0)
- (progn ;array holds values, convert it
- (setq IPTS ;to a list.
- (vlax-safearray->list IPTS)
- )
- ;;;Loop through list constructing points
- (while (> (length IPTS) 0)
- (setq PTS (cons (list (car IPTS)
- (cadr IPTS)
- (caddr IPTS)
- )
- PTS
- )
- IPTS (cdddr IPTS)
- )
- )
- )
- )
- (setq N2 (1+ N2))
- ) ;inner loop end
- (setq N1 (1+ N1))
- ) ;outer loop end
- (setq N 0)
- (repeat (length PTS)
- (setq A (ssget "C" (nth N PTS) (nth N PTS)))
- (setq NN 0)
- (repeat (sslength A)
- (command "_.BREAK" (ssname A NN) (nth N PTS) (nth N PTS))
- (setq NN (1+ NN))
- )
- (setq N (1+ N))
- )
- (SETVAR "OSMODE" HOLDOSMODE)
- (COMMAND "_.UNDO" "_END")
- (PRINC)
- )
|