边界轮廓线lsp程序

;边界轮廓线(vl-load-com)(defun c:yad_outline(/ viewpt maxmin spl2arc ss_add os cor qa ss n pt1 pt2 l_pt dis ent m)(defun viewpt(/ a b c d x) (setq b (getvar viewsize) c (car (getvar screensize) d (cadr (getvar screensize) a (* b (/ c d) x (setq x (getvar viewctr) x (trans x 1 2) c (list (- (car x)(/ a 2.0) (- (cadr x) (/ b 2.0) 0.0) d (list (+ (car x) (/ a 2.0) (+ (cadr x) (/ b 2.0) 0.0) c (trans c 2 1) d (trans d 2 1) ) (list c d)(defun maxmin(lst / x n a b c d) (setq x (car lst) a (car x) b (cadr x) c (car x) d (cadr x) n 1) (repeat (max (- (length lst) 1) 0) (setq x (nth n lst) a (min a (car x) b (min b (cadr x) c (max c (car x) d (max d (cadr x) (setq n (1+ n) ) (list (list a b) (list c d)(defun spl2arc(ent / obj len num spt ept ss i pt1 pt2 pt3 s) (setq obj (vlax-ename-vla-object ent) len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) num (1+ (fix (/ len dis) num (if (= num 1) 2 num) spt (vlax-curve-getStartPoint obj) ept (vlax-curve-getEndPoint obj) ) (command _.divide ent (* 2 num) (setvar cecolor 1) (setq ss (ssget _p) (if (equal spt ept) (setq i 1) (setq i 0) ) (setq pt3 spt) (setq s (ssadd) (repeat num (setq pt2 (cdr (assoc 10 (entget (ssname ss i) (if (/= num (/ (+ i 2) 2) (setq pt1 (cdr (assoc 10 (entget (ssname ss (1+ i) (setq pt1 ept) ) (command _.arc pt3 pt2 pt1) (ssadd (entlast) s) (setq pt3 pt1) (setq i (+ 2 i) ) (command _.erase ss ent ) (setvar cecolor 188) s)(defun ss_add(s1 s2 / n) (setq n -1) (repeat (sslength s1) (ssadd (ssname s1 (setq n (1+ n) s2) ) s2)(prompt n请选择要生成边界轮廓线的所有对象（图块轮廓要闭合）：)(if (setq ss (ssget (0 . line,arc,circle,*polyline,spline,ellipse,insert) (progn (command _.undo _be) (setq os (getvar osmode) cor (getvar cecolor) qa (getvar qaflags) ) (setvar osmode 0) (setvar cmdecho 0) (setq n -1) (repeat (sslength ss) (vla-getboundingbox (vlax-ename-vla-object (ssname ss (setq n (1+ n) pt1 pt2) (setq l_pt (append l_pt (list (vlax-safearray-list pt1) (vlax-safearray-list pt2) ) (setq l_pt (maxmin l_pt) pt1 (car l_pt) pt2 (cadr l_pt) dis (/ (distance pt1 pt2) 20) pt1 (polar pt1 (angle pt2 pt1) dis) pt2 (polar pt2 (angle pt1 pt2) dis) ) (setq l_pt (maxmin (append (viewpt) (list pt1 pt2) (command _.zoom _w (car l_pt) (cadr l_pt) (setvar cecolor 188) (command _.rectang pt1 pt2) (setq ent (entlast) (command _.boundary _a _o _r _i _y _b _n ent ss (polar pt1 (angle pt1 pt2) (/ dis 2) ) (if (equal (entlast) ent) (progn (entdel ent) (prompt n没有边界轮廓线！) ) (progn (entdel ent) (command _.erase (ssget c pt1 pt1 (0 . region) (62 . 188) ) (setq m 0) (if (setq ss (ssget x (0 . region) (62 . 188) (progn (command _.union ss ) (entmod (subst (cons 62 1) (cons 62 188) (entget (setq ent (entlast) (command _.explode ent) (setq ss (ssget _p) (if (= (cdr (assoc 0 (entget (ssname ss 0) REGION) (progn (setvar qaflags 1) (command _.explode ss ) (setq ss (ssget _p) ) ) (if (ssget p (0 . spline,ellipse) (progn (setq dis (abs (if (setq dis (getreal n请输入样条曲线或椭圆的取样距离：) dis 600.0) (if (= dis 0.0) (setq dis 600.0) ) ) (setq n -1) (repeat (sslength ss) (setq ent (ssname ss (setq n (1+ n) name (cdr (assoc 0 (entget ent) ) (if (or (= name SPLINE) (= name ELLIPSE) (progn (ssdel ent ss) (setq ss (ss_add (spl2arc ent) ss) (setq n (1- n) ) ) ) (setq n -1) (while (setq ent (ssname ss (setq n (1+ n) (if (entget ent) (progn (command _.pedit ent _y _j ss ) (setq m (1+ m) ) ) ) ) ) (if (setq ss (ssget x (0 . *polyline) (62 . 188) (progn (setq n -1) (repeat (sslength ss) (entmod (subst (cons 62 1) (cons 62 188) (entget (ssname ss (setq n (1+ n) ) (setq m (+ m (sslength ss) ) ) (if (= m 0) (prom