马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
 - ;|
- 函数名称: XD::Mtext:Explode
- 调用格式: (XD::Mtext:Explode ss)
- 参数说明: ss ---- 选择集 or Ename or vla-object
- 返回值: 表
- 函数简介: 炸开MTEXT,保持字体样式(样式随第一个自定义样式)
- 函数来源: 原创
- 函数作者: Lispboy
- 适用版本: XDRX API
- 最后更新时间: 2018-05-23
- |;
- (defun XD::Mtext:Explode (ss / x txt font face ss1 ss2 h prec y styl faces xdir)
- (cond ((= (type ss) 'PICKSET) (setq ss (xdrx_pickset->ents ss)))
- ((= (type ss) 'ENAME) (setq ss (list ss)))
- ((= (type ss) 'VLA-OBJECT)
- (setq ss (list (vlax-vla-object->ename ss)))
- )
- )
- (setq prec (xdrx_document_getprec))
- (mapcar
- '(lambda (x / )
- (if (xdrx_object_isa x "AcDbMtext")
- (progn (setq txt (xdrx_getpropertyvalue x "contents")
- xdir (xdrx_entity_getecs x)
- xdir (cadr xdir)
- row (xdrx_string_split txt "\\P")
- styl (xdrx_getpropertyvalue x "textstyle" nil)
- )
- (setq
- faces (mapcar '(lambda (y)
- (cond ((setq font (xdrx_string_regexps "(?<=\\\\f).*(?=\\|)" y 6 t))
- (setq face (car (xdrx_string_regexps "[^|]+" font)))
- (if (not (xdrx_object_get "style" face))
- (progn (setq txt (xdrx_textstyle_make face "" "" 0.0 1.0))
- (xdrx_setpropertyvalue txt "font" face)
- )
- )
- )
- ((setq font (xdrx_string_regexps "(?<=\\\\F).*(?=\\|)" txt 6 t))
- (setq face (car (xdrx_string_regexps "[^|]+" font)))
- (if (not (xdrx_object_get "style" face))
- (progn (setq txt (xdrx_textstyle_make face "" "" 0.0 1.0))
- (xdrx_setpropertyvalue txt "filename" face)
- )
- )
- )
- (t
- (setq face styl))
- )
- face
- )
- row
- )
- )
- (setq ss1 (xdrx_entity_explode x))
- (xdrx_entity_setproperty ss1 "textstyle" face)
- (setq h (xdrx_getpropertyvalue (ssname ss1 0) "textheight")
- h (* 2 (/ h 3.0))
- )
- (xdrx_document_setprec h 0.01)
- (setq ss2 (xd::pickset:tablesortatecs ss1 xdir 0 3 '> '<))
- (setq faces (XD::List:FillGap faces styl (length ss2)))
- (apply 'xdrx_document_setprec prec)
- (mapcar '(lambda (m n)
- (setq str (xdrx_entity_getproperty m "textstring")
- str (apply 'strcat str)
- )
- (xdrx_setpropertyvalue (car m) "textstring" str)
- (xdrx_entity_delete (cdr m))
- (xdrx_setpropertyvalue (car m) "textstyle" n)
- (car m)
- )
- ss2
- faces
- )
- )
- )
- )
- ss
- )
- )
测试命令
 - (defun c:tt()
- (if (setq ss (ssget '((0 . "MTEXT"))))
- (xd::mtext:explode ss)
- )
- (princ)
- )
|