边界轮廓线lsp程序.docVIP

边界轮廓线Isp程序 ;;边界轮廓线 (vl-load-com) (defun c:yad_outline(/ viewpt maxmin spl2arc ss_add os cor qa ss n ptl 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 (/cd)) x (setq x (getvar viewctr)) x (transx 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 1st) a (car x) b (cadr x) c (car x) d (cadr x) n 1) (repeat (max (- (length 1st) 1) 0) (setq x (nth n 1st) 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 ptl pt2 pt3 s) (setq obj (vlax-ename-gt;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 _.dividen ent (* 2 num)) (setvar cecolor Hl) (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 (/ (+i2)2)) (setq ptl (cdr (assoc 10 (entget (ssname ss (1+ i)))))) (command _.arc pt3 pt2 ptl) (ssadd (entlast) s) (setq pt3 ptl) (setq i (+ 2 i)) ) (command _.erase ss ent) (setvar cecolor 188) s ) (defun ss_add(sl s2 / n) (setq n -1) (repeat (sslength si) (ssadd (ssname si (setq n (1+ n))) s2) ) s2 ) (prompt -\n请选择要生成边界轮廓线的所有对象(图块轮廓要闭合): )(if (setq ss (ssget #39;((0 . nline,arc,circle, polyline,spline,ellipse,insert1’)))) (progn cor (getvar cecolor) qa (getvar qaflags) ) (setvar osmode 0) (setvar cmdecho* 0) (setq n -1) (repeat (sslength ss) (vla-getboundingbox (vlax-ename-gt;vla-object (ssname ss (setq n (1+ n)))) #39;ptl #39;pt2) (setq l_pt (append l_pt (list (vlax-safearray-gt;list ptl) (vlax-safearray-gt;list pt2)))) ) (setq l_pt (maxmin l