文字加下划线(同时转换成属性块)和 下划线更新 插件
**** Hidden Message *****下划线更新:
(defun c:xdtb_textulineupd (/ atts insert box mat xdir ydir p1 p2 p3 p4 p5 p6 dist h el blks)
(defun _update (blk)
(setq insert (ssname (ssget "x" (list (cons 2 blk))) 0)
atts (xdrx_getpropertyvalue insert "attributeentities")
box (xdrx_entity_box atts (cadr (xdrx_entity_getecs insert)))
mat (xdrx_matrix_block2wcs insert)
mat (xdrx_matrix_inverse mat)
box (xdrx_points_transform box mat)
xdir '(1 0 0)
ydir '(0 1 0)
p1 (car box)
p2 (cadr box)
dist (distance p1 p2)
p1 (mapcar '+ p1 (xdrx_vector_product xdir (- (* #ext dist))))
p2 (mapcar '+ p2 (xdrx_vector_product xdir (* #ext dist)))
h (distance (car box) (last box))
p3 (mapcar '+ p1 (xdrx_vector_product ydir (- (* 0.3333 h))))
p4 (mapcar '+ p2 (xdrx_vector_product ydir (- (* 0.3333 h))))
p5 (mapcar '+
p3
(xdrx_vector_product
ydir
(- (setq wid (xd::var:getdrawratio)))
)
)
p6 (mapcar '+ p4 (xdrx_vector_product ydir (- wid)))
)
(xdrx_entity_delete ents)
(setq el (xdrx_block_getentities blk '((0 . "*polyline"))))
(xdrx_setpropertyvalue
(car el)
"setpointat"
(list 0 p3)
"setpointat"
(list 1 p4)
)
(xdrx_setpropertyvalue
(cadr el)
"setpointat"
(list 0 p5)
"setpointat"
(list 1 p6)
)
)
(if (setq ss (ssget "x"
(list '(0 . "INSERT") (cons 2 "xd_text_xiahua_*"))
)
)
(progn (setq blks (xdrx_entity_getproperty ss "blocktablerecord")
blks (xd::list:groupbyindex (mapcar 'car blks) 0)
)
(mapcar '(lambda (x) (_update (car x))) blks)
)
)
(princ)
)
更新这个功能不错 看看楼主的程序,谢谢提供。 不错,很有用处 每日插件 每日新鲜!!!!!!! 每日新鲜,每天更新! 这个很强大~ 可以,相当完美。 看看楼主的程序,谢谢提供。 看看楼主的程序,谢谢提供。 非常实用的功能,谢谢 谢谢分享。 一直在找下划线的插件,谢谢了 非常实用的功能,谢谢 用了反应器吧?