;;边界轮廓线yad_outline*** YAD建筑 作者:lyy
(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请输入样条曲线或椭圆的取样距离：<600>"
						 )
					  )
					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)
	    (prompt "\n没有边界轮廓线！")
	    (prompt (strcat "\n生成" (itoa m) "条边界轮廓线！"))
	  )
	)
      )
      (setvar "osmode" os)
      (setvar "cecolor" cor)
      (setvar "qaflags" qa)
      (command "_.undo" "_e")
    )
  )
  (princ)
)
(prompt "\n***边界轮廓线yad_outline*** YAD建筑")
(princ)