[LISP函数]：轉貼:選擇集交點

taner

[PHP]
;;; -----------------------------------------------
;;; 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 ssinterlines (/ 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)
)
[/PHP]

eachy

可以改一改

2. 
   
3. (defun ssinters        (/ ss el aobj1 el1 aobj2 ipts pts)
   
4.   (vl-load-com)
   
5.   (if (ssget '((0 . "*line,arc,circle,ellipse")))
   
6.     (vlax-for obj (vla-get-activeselectionset
   
7.                     (vla-get-activedocument (vlax-get-acad-object))
   
8.                   )
   
9.       (setq el (cons obj el))
   
10.     )
    
11.   )
    
12.   (while el
    
13.     (setq aobj1 (car el))
    
14.     (if        (setq el1 (cdr el))
    
15.       (foreach aobj2 el1
    
16.         (if (and (setq ipts (vla-intersectwith aobj1 aobj2 0))
    
17.                  (setq ipts (vlax-variant-value ipts))
    
18.                  (> (vlax-safearray-get-u-bound ipts 1) 0)
    
19.             )
    
20.           (progn
    
21.             (setq ipts (vlax-safearray->list ipts))
    
22.             (while (> (length ipts) 0)
    
23.               (setq pts         (cons (list (car ipts)
    
24.                                      (cadr ipts)
    
25.                                      (caddr ipts)
    
26.                                )
    
27.                                pts
    
28.                          )
    
29.                     ipts (cdddr ipts)
    
30.               )
    
31.             )
    
32.           )
    
33.         )
    
34.       )
    
35.     )
    
36.     (setq el (cdr el))
    
37.   )
    
38.   pts
    
39. )

<br /> (defun ssinters        (/ ss el aobj1 el1 aobj2 ipts pts)<br />   (vl-load-com)<br />   (if (ssget '((0 . "*line,arc,circle,ellipse")))<br />     (vlax-for obj (vla-get-activeselectionset<br />                     (vla-get-activedocument (vlax-get-acad-object))<br />                   )<br />       (setq el (cons obj el))<br />     )<br />   )<br />   (while el<br />     (setq aobj1 (car el))<br />     (if        (setq el1 (cdr el))<br />       (foreach aobj2 el1<br />         (if (and (setq ipts (vla-intersectwith aobj1 aobj2 0))<br />                  (setq ipts (vlax-variant-value ipts))<br />                  (> (vlax-safearray-get-u-bound ipts 1) 0)<br />             )<br />           (progn<br />             (setq ipts (vlax-safearray->list ipts))<br />             (while (> (length ipts) 0)<br />               (setq pts         (cons (list (car ipts)<br />                                      (cadr ipts)<br />                                      (caddr ipts)<br />                                )<br />                                pts<br />                          )<br />                     ipts (cdddr ipts)<br />               )<br />             )<br />           )<br />         )<br />       )<br />     )<br />     (setq el (cdr el))<br />   )<br />   pts<br /> )