[求助]如何得到一个块的外轮廓

my_autocad

如何得到一个块的外轮廓？

在做有一些图时，有些块线条很多，只需要其外轮廓，通常有两种方法，一是用PL线描一次，二是用BO命令生成边界，如何快速得到块的外轮廓呢？

祥子

 

(defun get_blk_box(en)

(setq en (vlax-ename->vla-object en))
         (vla-getboundingbox en 'p1 'p2)
         (setq p1 (vlax-safearray->list p1)
      p2 (vlax-safearray->list p2)
     )

)
这个程式返回左下角点各右上角点

祥子

p1 与　p2　就是所要的坐标点

露水2

祥子，没有理解楼主的意思，你的是包裹盒，他要是的是轮廓

xyp1964

tangjunasd58

;;边界轮廓线
;;最后转成pline线
(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)

ZZXXQQ

发个短的

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

linjian257

太好了，真的需要学习下

野狼谷/〈M〉

如果图块轮廓不闭合，很难办吧

憨厚的木头

好好学习下