求一个删除指点字符把文字分成两段，文字的位子不变

wxa123wl · 发表于 2014-3-5 18:24:45

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

求一个框选，把文字分成两份，并且放在不同图层！例如

途中的4：:17 变成4：和1.7两段文字，并把他们放在不同的图层上！

st788796 · 发表于 2014-3-5 21:37:20

本帖最后由 st788796 于 2014-3-5 22:01 编辑

更新

(defun c:tt (/ ss )
(if (setq ss (ssget '((0 . "text"))))
(progn
(mapcar
'(lambda
(x / txt sty scl tl tll h ntxt inspt pos _x1 _x2 el nstr)
(if (and
(setq txt (xdrx_getpropertyvalue x "Textstring"))
(setq pos (vl-string-search " " txt))
)
(progn
(setq
sty (car (xdrx_getpropertyvalue x "TextStyle"))
scl (xdrx_getpropertyvalue x "WidthFactor")
h (xdrx_getpropertyvalue x "Height")
tl (XD::String:SingleChr txt)
inspt (xdrx_getpropertyvalue x "Position")
tll (mapcar '(lambda (a)
(XD::String:ActualWidth a sty h scl)
)
tl
)
ntxt (ssname (xdrx_entity_copy x) 0)
nstr (substr txt (+ 2 pos))
el (entget x)
_x1 (caar (textbox el))
_x2 (caar (textbox (list (cons 1 nstr)
(assoc 7 el)
(assoc 40 el)
(assoc 41 el)
)
)
)
)
(xdrx_setpropertyvalue x "Textstring" (substr txt 1 pos))
(xdrx_setpropertyvalue x "Layer" "111")
(xdrx_setpropertyvalue
ntxt
"Position"
(list (+ (- (car inspt) _x2 _x1)
(apply '+ (XD::List:N-M tll 1 (+ 2 pos)))
)
(cadr inspt)
0.
)
)
(xdrx_setpropertyvalue
ntxt
"Textstring"
nstr
)
(xdrx_setpropertyvalue ntxt "Layer" "222")
)
)
)
(xdrx_pickset->ents ss)
)
)
)
(princ)
)

(defun c:tt (/ ss  ) 
  (if (setq ss (ssget '((0 . "text")))) 
    (progn 
      (mapcar 
        '(lambda 
           (x / txt sty scl tl tll h ntxt inspt pos _x1 _x2 el nstr) 
            (if        (and 
                  (setq txt (xdrx_getpropertyvalue x "Textstring")) 
                  (setq pos (vl-string-search " " txt)) 
                ) 
              (progn 
                (setq 
                  sty        (car (xdrx_getpropertyvalue x "TextStyle")) 
                  scl        (xdrx_getpropertyvalue x "WidthFactor") 
                  h        (xdrx_getpropertyvalue x "Height") 
                  tl        (XD::String:SingleChr txt) 
                  inspt        (xdrx_getpropertyvalue x "Position") 
                  tll        (mapcar        '(lambda (a) 
                                   (XD::String:ActualWidth a sty h scl) 
                                 ) 
                                tl 
                        ) 
                  ntxt        (ssname (xdrx_entity_copy x) 0) 
                  nstr        (substr txt (+ 2 pos)) 
                  el        (entget x) 
                  _x1        (caar (textbox el)) 
                  _x2        (caar (textbox (list (cons 1 nstr) 
                                             (assoc 7 el) 
                                             (assoc 40 el) 
                                             (assoc 41 el) 
                                       ) 
                              ) 
                        ) 
                ) 
 
                (xdrx_setpropertyvalue x "Textstring" (substr txt 1 pos)) 
                (xdrx_setpropertyvalue x "Layer" "111") 
                (xdrx_setpropertyvalue 
                  ntxt 
                  "Position" 
                  (list        (+ (- (car inspt) _x2 _x1) 
                           (apply '+ (XD::List:N-M tll 1 (+ 2 pos))) 
                        ) 
                        (cadr inspt) 
                        0. 
                  ) 
                ) 
                (xdrx_setpropertyvalue 
                  ntxt 
                  "Textstring" 
                  nstr 
                ) 
                (xdrx_setpropertyvalue ntxt "Layer" "222") 
              ) 
            ) 
         ) 
        (xdrx_pickset->ents ss) 
      ) 
    ) 
  ) 
  (princ) 
)

wxa123wl · 发表于 2014-3-5 22:35:30

st788796 发表于 2014-3-5 21:37
更新

你这得用晓东的那个函数库呀，！我的装那个，老师有问题，，求普通的lisp可以吗？

wxa123wl · 发表于 2014-3-5 22:46:44

st788796 发表于 2014-3-5 21:37
更新

加载了晓东的那个arx，和vlx后我的打开保存关闭都用不了了，！所以我一直没有用！

wxa123wl · 发表于 2014-3-5 22:56:01

st788796 发表于 2014-3-5 21:37
更新

我测试了一下你的程序，，一不能框选文字，，批量分开，，二，，还有点选一个后两个文字间分的很开！

st788796 · 发表于 2014-3-6 08:08:35

本帖最后由 st788796 于 2014-3-6 08:14 编辑

一个思路，适用只有一个连续空格文字

(defun c:tt (/ ss )
(if (setq ss (ssget '((0 . "text"))))
(progn
(mapcar
'(lambda
(x / el an str strl oldbox newbox _x pos)
(setq el (entget x)
str (cdr (assoc 1 el))
)
(if (vl-string-search " " str)
(progn
(setq an (cdr (assoc 50 el))
strl (XD::String:RegExps "[^ ]+" str "")
oldbox (textbox
(setq nel (subst '(50 . 0) (assoc 50 el) el))
)
nel (subst (cons 1 (cadr strl)) (assoc 1 nel) nel)
newbox (textbox nel)
_x (- (caadr oldbox)
(caadr newbox)
)
el (subst (cons 1 (car strl)) (assoc 1 el) el)
el (subst '(8 . "111") (assoc 8 el) el)
pos (polar (cdr (assoc 10 el)) an _x)
nel (subst '(8 . "222") (assoc 8 nel) nel)
nel (subst (cons 10 pos) (assoc 10 nel) nel)
nel (subst (cons 50 an) (assoc 50 nel) nel)
)
(entmake nel)
(entmod el)
)
)
)
(xdrx_pickset->ents ss)
)
)
)
(princ)
)

(defun c:tt (/ ss ) 
  (if (setq ss (ssget '((0 . "text")))) 
    (progn 
      (mapcar 
        '(lambda 
           (x / el an str strl oldbox newbox _x pos) 
            (setq el  (entget x) 
                  str (cdr (assoc 1 el)) 
            ) 
            (if        (vl-string-search " " str) 
              (progn 
                (setq an     (cdr (assoc 50 el)) 
                      strl   (XD::String:RegExps "[^ ]+" str "") 
                      oldbox (textbox 
                               (setq nel (subst '(50 . 0) (assoc 50 el) el)) 
                             ) 
                      nel    (subst (cons 1 (cadr strl)) (assoc 1 nel) nel) 
                      newbox (textbox nel) 
                      _x     (-        (caadr oldbox) 
                                (caadr newbox) 
                             ) 
                      el     (subst (cons 1 (car strl)) (assoc 1 el) el) 
                      el     (subst '(8 . "111") (assoc 8 el) el) 
                      pos    (polar (cdr (assoc 10 el)) an _x) 
                      nel    (subst '(8 . "222") (assoc 8 nel) nel) 
                      nel    (subst (cons 10 pos) (assoc 10 nel) nel) 
                      nel    (subst (cons 50 an) (assoc 50 nel) nel) 
                ) 
                (entmake nel) 
                (entmod el) 
              ) 
            ) 
         ) 
        (xdrx_pickset->ents ss) 
      ) 
    ) 
  ) 
  (princ) 
)

wxa123wl · 发表于 2014-3-6 23:07:48

st788796 发表于 2014-3-6 08:08
一个思路，适用只有一个连续空格文字

恩，，谢谢，

账号		自动登录	找回密码
密码			立即注册

[求助] 求一个删除指点字符把文字分成两段，文字的位子不变

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评