[LISP函数]：轉貼:兩實體交點集

taner

Copyright   :   MENZI ENGINEERING GmbH, Switzerland
[PHP]; -- Function MeGetInters
; Returns all intersection points between two objects.
; Arguments [Typ]:
;   Fst = First object [VLA-OBJECT]
;   Nxt = Second object [VLA-OBJECT]
;   Mde = Intersection mode [INT]
;         Constants:
;         - acExtendNone           Does not extend either object.
;         - acExtendThisEntity     Extends the Fst object.
;         - acExtendOtherEntity    Extends the Nxt object.
;         - acExtendBoth           Extends both objects.
; Return [Typ]:
;   > List of points '((1.0 1.0 0.0)... [LIST]
;   > False if no intersection found
; Notes:
;   - None
;
  
(defun MeGetInters (Fst Nxt Mde / IntLst PntLst)

(setq IntLst (vlax-invoke Fst 'IntersectWith Nxt Mde))
(if IntLst
  (progn
   (repeat (/ (length IntLst) 3)
    (setq PntLst (cons
                  (list (car IntLst) (cadr IntLst) (caddr IntLst))
                  PntLst
                 )
          IntLst (cdddr IntLst)
    )
   )
   (reverse PntLst)
  )
)
)[/PHP]
調用格式:
(MeGetInters (vlax-ename->vla-object (car (entsel)))(vlax-ename->vla-object (car (entsel))) acExtendBoth)
修改一下,使調用更簡單.
[PHP](defun th-get2entinters (fst nxt k / intlst pntlst)
(if (= k 0)
    (setq k acextendnone)
  )
  (if (= k 1)
    (setq k acextendthisentity)
  )
  (if (= k 2)
    (setq k acextendotherentity)
  )
  (if (= k 3)
    (setq k acextendboth)
  )
  (setq intlst (vlax-invoke (vlax-ename->vla-object fst)  'intersectwith  (vlax-ename->vla-object  nxt) k))  
  (if intlst
    (progn
      (repeat (/ (length intlst) 3)
        (setq pntlst (cons (list (car intlst) (cadr intlst) (caddr intlst))
                           pntlst
                     )
              intlst (cdddr intlst)
        )
      )
      (reverse pntlst)
    )
  )
)[/PHP]

yunlong3000

好贴

firstintimate

intlst返回的应该是安全数组吧，(length intlst)好像有问题
稍微改了一下

2. (defun get2entinters (fst nxt k / mode intlst pntlst)
   
3.   (setq  mode '(acextendnone acextendthisentity acextendotherentity acextendboth))
   
4.   (setq k (eval(nth k mode)))
   
5.   (setq intlst (vla-intersectwith (vlax-ename->vla-object fst) (vlax-ename->vla-object  nxt) k))
   
6.    (if intlst     
   
7.     (progn
   
8.       (setq intlst(vlax-safearray->list(vlax-variant-value intlst)))
   
9.       (repeat (/ (length intlst) 3)
   
10.       (setq pntlst (cons (list (car intlst) (cadr intlst) (caddr intlst))
    
11.                pntlst
    
12.              )
    
13.           intlst (cdddr intlst)
    
14.     )
    
15.       )
    
16.       (reverse pntlst)
    
17.     )
    
18.   )
    
19. )

(defun get2entinters (fst nxt k / mode intlst pntlst)<br />   (setq  mode '(acextendnone acextendthisentity acextendotherentity acextendboth))<br />   (setq k (eval(nth k mode)))<br />   (setq intlst (vla-intersectwith (vlax-ename->vla-object fst) (vlax-ename->vla-object  nxt) k))<br />    (if intlst     <br />     (progn<br />       (setq intlst(vlax-safearray->list(vlax-variant-value intlst)))<br />       (repeat (/ (length intlst) 3) <br />       (setq pntlst (cons (list (car intlst) (cadr intlst) (caddr intlst)) <br />                pntlst <br />              ) <br />           intlst (cdddr intlst) <br />     ) <br />       ) <br />       (reverse pntlst) <br />     ) <br />   )<br /> )

如果对相交模式熟悉的话，程序前两行也可以省略

2.   (defun get2entinters (fst nxt k / mode intlst pntlst);;;k=0,1,2,3
   
3.   (setq intlst (vla-intersectwith (vlax-ename->vla-object fst) (vlax-ename->vla-object  nxt) (eval k)))
   
4.    (if intlst     
   
5.     (progn
   
6.       (setq intlst(vlax-safearray->list(vlax-variant-value intlst)))
   
7.       (repeat (/ (length intlst) 3)
   
8.       (setq pntlst (cons (list (car intlst) (cadr intlst) (caddr intlst))
   
9.                pntlst
   
10.              )
    
11.           intlst (cdddr intlst)
    
12.     )
    
13.       )
    
14.       (reverse pntlst)
    
15.     )
    
16.   )
    
17. )

  (defun get2entinters (fst nxt k / mode intlst pntlst);;;k=0,1,2,3<br />   (setq intlst (vla-intersectwith (vlax-ename->vla-object fst) (vlax-ename->vla-object  nxt) (eval k)))<br />    (if intlst     <br />     (progn<br />       (setq intlst(vlax-safearray->list(vlax-variant-value intlst)))<br />       (repeat (/ (length intlst) 3) <br />       (setq pntlst (cons (list (car intlst) (cadr intlst) (caddr intlst)) <br />                pntlst <br />              ) <br />           intlst (cdddr intlst) <br />     ) <br />       ) <br />       (reverse pntlst) <br />     ) <br />   )<br /> )

yjch

好贴收藏了，tanger