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

my_autocad 发表于 2007-10-4 09:48:00

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

祥子发表于 2007-10-30 17:21:00

<img alt="" src="http://www.mjtd.com/Bbs/Skins/default/topicface/face1.gif"/> (defun get_blk_box(en)(<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> en (<a href="http://www.mjtd.com/object/autolisp/vlax-ename-62vla-object.htm" target="_black">vlax-ename->vla-object</a> en))          (vla-getboundingbox en 'p1 'p2)          (<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> p1 (<a href="http://www.mjtd.com/object/autolisp/vlax-safearray-62list.htm" target="_black">vlax-safearray->list</a> p1)       p2 (<a href="http://www.mjtd.com/object/autolisp/vlax-safearray-62list.htm" target="_black">vlax-safearray->list</a> p2)      )) 这个程式返回左下角点各右上角点

祥子发表于 2007-10-30 17:23:00

p1 与　p2　就是所要的坐标点

露水2 发表于 2007-10-31 11:48:00

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

xyp1964 发表于 2007-11-1 12:44:00

tangjunasd58 发表于 2013-6-5 00:36:41

;;边界轮廓线
;;最后转成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 发表于 2013-6-5 08:34:42

发个短的
;边界轮廓线明经 ZZXXQQ 2013.6.5
(defun c:tt ()
(setvar "CMDECHO" 0)
(if (and (setq p1 (getpoint "\n第一角点: "))
(setq p2 (getcorner p1 "\n另一角点: "))) (progn
(setq s1 (entlast))
(command "_.RECTANG" p1 p2)
(setq p3 (polar p1 (angle p1 p2) 5))
(command "_.BOUNDARY" p3 "")
(command "_.ERASE" "C" p1 p1 "")
(setq ss (ssadd))
(while (setq s1 (entnext s1)) (ssadd s1 ss))
(if (> (sslength ss) 0)
(command "_.ERASE" "W" p1 p2 "R" ss "")
(princ "\n无法生成边界！")
)
))
(setvar "CMDECHO" 1)
(princ)
)

linjian257 发表于 2013-8-12 11:31:22

太好了，真的需要学习下

野狼谷/〈M〉 发表于 2013-12-21 16:34:42

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

憨厚的木头 发表于 2013-12-22 22:20:48

好好学习下

页: [1] 2 3

明经CAD社区's Archiver

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