 - ;实体包围盒
- (defun Getbox (obj / bp up)
- (vla-getboundingbox obj 'bp 'up)
- (setq bp (safearray-value bp)
- up (safearray-value up)
- )
- (list bp
- (list (car up) (cadr bp) 0.)
- up
- (list (car bp) (cadr up) 0.)
- )
- )
- ;;通过直线的平面
- (defun GetPlan (p1 p2 / an)
- (setq an (angle p1 p2))
- (cond
- ((equal an 0. 1e-8)
- (list p1 '(0. 1. 0.))
- )
- ((equal an (/ pi 2) 1e-8)
- (list p1 '(-1. 0. 0.))
- )
- ((equal an pi 1e-8)
- (list p1 '(0. -1. 0.))
- )
- (t (list p1 '(1. 0. 0.)))
- )
- )
- ;;
- (defun getclosestpt (curve lst)
- (vlax-curve-getclosestpointtoprojection
- curve
- (car lst)
- (cadr lst)
- t
- )
- )
- ;;点集包围盒
- (defun pnts:box (pts / xpt ypt xmin xmax ymin ymax)
- (setq xpt (mapcar 'car pts)
- ypt (mapcar 'cadr pts)
- xmin (apply 'min xpt)
- xmax (apply 'max xpt)
- ymin (apply 'min ypt)
- ymax (apply 'max ypt)
- )
- (list (list xmin ymin 0.)
- (list xmax ymin 0.)
- (list xmax ymax 0.)
- (list xmin ymax 0.)
- )
- )
- (defun c:tt (/ e obj box pts)
- (setq e (car (entsel "\nPick Spline: ")))
- (setq obj (vlax-ename->vla-object e))
- (setq box (Getbox obj))
- (setq pts (mapcar '(lambda (p1 p2)
- (getclosestpt obj (getplan p1 p2))
- )
- box
- (cdr (reverse (cons (car box) (reverse box))))
- )
- )
- (entmakex
- (append '((0 . "LWPOLYLINE")
- (100 . "AcDbEntity")
- (100 . "AcDbPolyline")
- (90 . 4)
- (70 . 1)
- )
- (mapcar
- '(lambda (x) (cons 10 (list (car x) (cadr x))))
- (pnts:box pts)
- )
- )
- )
- )
转发自晓东论坛 |