- 积分
- 11502
- 明经币
- 个
- 注册时间
- 2002-10-2
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2003-1-20 10:52:00
|
显示全部楼层
I remember Long Long Zai pasted this routine months ago, probably it might he
I remember Long Long Zai pasted this routine months ago, probably it might help you.[br];;-----------------------------------------------
;; 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,CIRCLE,ELLIPSE"))))
(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
(print PTS)
(setvar "OSMODE" HOLDOSMODE)
(command "_.UNDO" "_END")
(princ)
) |
|