[编程交流] 边界工具

;Dynamic swing
http://www.cadtutor.net/forum/showthread.php?87809-boundary-tool
;hanhphuc 30/07/14
(defun swingl (a b fuzz / ss c i p1 p l o catch oops ls)
 (if (and (= (vla-get-objectname b) "AcDbLine")
   (setq p1 (getpoint "\nStretch point..")
         i  5
         ) ;_ end of setq 
   ) ;_ end of and
   (progn (terpri)
   (while (and (setq l (grread nil 13 0)) (= (car l) 5))
     (setq i (car l)
           p (cadr l)
           ) ;_ end of setq
     (redraw (vlax-vla-object->ename a) 4)
     (if (and a b (listp p))
       (progn (vla-put-EndPoint b (vlax-3d-point (trans p 1 0)))
              (setq catch (vl-catch-all-apply
                            ''((a b)
                               (setq
                                l
                                (split (vlax-safearray->list (vlax-variant-value (vla-IntersectWith a b 0))) 3 nil)
                                )
                               ) ;_ end of lambda
                            (list a b)
                            ) ;_ end of vl-catch-all-apply
                    ) ;_ end of setq
              ) ;_ end of progn
       ) ;_ end of if
     (setq p1 p)
     (if (< (length l) o)
       (princ "\n")
       (princ "\r")
       ) ;_ end of if
     (if (vl-catch-all-error-p catch)
       (princ)
       (progn (setq oops (cons l oops))
(foreach p l
(markp (trans p 0 1))
)
         (redraw (vlax-vla-object->ename a) 3)
              ) ;_ end of progn
       ) ;_ end of if
     (setq o (length l))
     ) ;_ end of while
   (redraw (vlax-vla-object->ename a) 4)
     ) ;_ end of progn
   ) ;_ end of if
 ) ;_ end of defun
;sub function: split
;http://www.cadtutor.net/forum/showthread.php?87320-Break-a-list-in-two-sub-lists&highlight=Split+list
;hanhphuc 
(defun split (lst len opt / ls l i) ; opt, T= by division or nil=by length
(setq i 1 l '() len (if opt (/ (length lst) len) len))
 (while lst
   (setq l (append  l (list(car lst))))
   (if
   (zerop (rem i len))
(setq ls (cons l ls) l nil)
   ) 
   (setq i (1+ i) lst (cdr lst))
 ) ;_ end of foreach
 (if l
   (append (reverse ls) (list  l))
   (reverse ls)
 ) ;_ end of if
) ;_ end of defun

(defun c:test(/ a b fuzz ) 
(if
(and
(setq a (car(entsel "\nPick main entity (static).. ")))
(setq b (car(entsel "\nPick secondary entity (dynamic).. ")))
     )
(apply 'swingl (append (mapcar ''((e) (vlax-ename->vla-object e )) (list a b))'(0.5)))
) ;_ end of if
(princ)
) ;_ end of defun
(defun dtor(_theta)
 (* (/ _theta 180.0) pi)        ; _theta=degree, to radian
)
(defun markp (_pt / _sc); R1.4
(setq _sc (/ (getvar 'viewsize) (cadr (getvar 'screensize)))); dynamic
 (grvecs         (list         6 _pt (polar _pt (dtor 45) (* 5 _sc))        ;;1.4
                                6 _pt (polar _pt (dtor 135) (* 5 _sc))
                        6 _pt (polar _pt (dtor 225) (* 5 _sc))
                               6 _pt (polar _pt (dtor 315) (* 5 _sc))
)
 ); grvecs
); mark
;area still pending, by bpoly or other method
http://www.cadtutor.net/forum/showthread.php?87531-Lee-Mac-Geometry-function-explined&highlight=samifox
;hanhphuc 07/07/2014
(defun 2d-area (l)
 (abs
   (/ (apply '-
      (mapcar '(lambda (x y)
   (vxv  ; sub function by LEE MAC
     (mapcar '(eval x) l)
     (mapcar '(eval y)
      (append (cdr l) (list (car l)))
     )
   ) ;_ vxv
        ) ;_ end of lambda
       '(car cadr)
       '(cadr car)
      ) ;_ end of mapcar
      ) ;_ end of apply
      2.
   ) ;_ end of /
   
 );_ end of abs
 
) ;_ end of defun
;; Vector Dot Product  -  Lee Mac
;; Args: u,v - vectors in R^n
(defun vxv ( u v )
   (apply '+ (mapcar '* u v))
)