马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
本帖最后由 Lispboy 于 2016-11-22 21:01 编辑
[sell](defun c:XDTB_BlockSingleBound (/ blk bound bound1 e el el1 ents mat mat-b2w
mat-w2b pts1 pts2 scr ss1 tf wid x yon
)
(defun _getent (e / bound x)
(mapcar
'(lambda (x)
(if (xdrx_entity_boundingboxintersectwith x e)
(progn
(xdrx_curve_union x e t)
(xdrx_setpropertyvalue (entlast) "constantwidth" wid)
(xdrx_object_swapid (entlast) e)
(xdrx_entity_delete (list x (entlast)))
)
)
)
ents
)
)
(xdrx_begin)
(if (not #block_wid)
(setq #block_wid 0.0)
)
(if (not #block_color)
(setq #block_color 7)
)
(if (not #block_gen)
(setq #block_gen "是")
)
(setq scr (xdrx_system_screenMetrics)
scr (cadr scr)
scr (/ scr 100)
)
(setq tf t)
(xdrx_setmark)
(setq ents nil)
(while tf
(xdrx_initget "C W G")
(xdrx_prompt "\n当前设置:颜色(" #block_color ") / 宽度(" #block_wid
") / 所有块生成(" #block_gen ")"
)
(if (setq e (nentsel "\n拾取块中要提取轮廓的多段线[颜色(C)宽度(W)/生成(G)]<退出>:"))
(cond
((= e "W")
(if (setq wid (getreal (xdrx_prompt "\n输入轮廓线宽度<" #block_wid
">:" t
)
)
)
(setq #block_wid wid)
)
)
((= e "G")
(setq yon (xdrx_yesorno "\n是否所有块生成轮廓线" 1))
(if (= yon 1)
(setq #block_gen "是")
(setq #block_gen "否")
)
)
((= e "C")
(setq #block_color (xdrx_color_select #block_color))
)
((= (type e) 'LIST)
(setq blk (car (last e))
e (car e)
mat-b2w (xdrx_matrix_block2wcs blk)
pts1 (xdrx_getpropertyvalue e "vertices")
pts2 (xdrx_points_transform pts1 mat-b2w)
)
(if (setq bound1 (xdrx_geom_searchoutline e wid))
(progn
(xdrx_entity_transform bound1 mat-b2w)
(_getent bound1)
(setq ents (cons bound1 ents))
(xdrx_entity_setproperty ents "color" 1 "constantwidth" scr)
)
(xdrx_prompt "\n选择的实体不能生成轮廓,重选.")
)
)
)
(setq tf nil)
)
)
(setq ss1 (xdrx_getss 9)
el1 (xdrx_pickset->ents ss1)
)
(xdrx_entity_setproperty ss1 "color" #block_color "constantwidth" wid)
(if (and
ss1
(= #block_gen "是")
)
(progn
(setq el (xdrx_getpropertyvalue blk "BlockReferenceEntities"))
(setq mat-w2b (xdrx_matrix_inverse mat-b2w))
(mapcar
'(lambda (x)
(setq mat (xdrx_matrix_block2wcs x)
mat (xdrx_matrix_product mat mat-w2b)
)
(xdrx_entity_transformedcopy ss1 mat)
)
el
)
)
)
(xdrx_end)
(if (setq ss1 (xdrx_getss))
(sssetfirst nil ss1)
)
(princ)
)
[/sell] |