(XD::Text:StringBetween)获取Text一点或两点间String

eachy · 发表于 2013-12-8 08:34:43

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

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

×

;;功能: 获取一点或两点间String
;;参数: e --- Text Entity
;; p1 -- Point
;; p2 -- Point or nil
;;返回值: String
(defun XD::Text:StringBetween (e p1 p2 / gettl el str
nstr nnstr ll l zl ecs inspt
l1 l2 l3 l4
)
(if (= (xdrx_getpropertyvalue e "IsA") "AcDbText")
(progn
(defun gettl (l / box)
(setq box (textbox l))
(car (mapcar '- (cadr box) (car box)))
)
(setq el (entget e)
str (cdr (assoc 1 el))
nstr (xd::string:singlechr str)
l (vl-remove-if-not
'(lambda (x) (vl-position (car x) '(1 40 41 7)))
el
)
zl (gettl l)
ecs (xdrx_entity_getecs e)
inspt (car ecs)
l1 (last (trans (mapcar '- (trans p1 1 0) inspt) 0 (cadr ecs)))
nnstr nstr
)
(while nnstr
(setq ll (cons
(gettl
(subst (cons 1 (apply 'strcat nnstr))
(assoc 1 l)
l
)
)
ll
)
nnstr (cdr nnstr)
)
)
(if p2
(progn
(setq l2
(last
(trans (mapcar '- (trans p2 1 0) inspt) 0 (cadr ecs))
)
)
(mapcar 'set '(l3 l4) (vl-sort (list l1 l2) '<))
(if (or (<= l4 0.) (>= l3 zl))
str
(apply 'strcat
(vl-remove nil
(mapcar '(lambda (a b)
(if a
b
nil
)
)
(mapcar '(lambda (x)
(if (<= l3 x l4)
x
nil
)
)
ll
)
nstr
)
)
)
)
)
(if (or (<= l1 0.) (>= l1 zl))
str
(nth (1+ (vl-position
(last (vl-remove-if '(lambda (x) (> x l1)) ll))
ll
)
)
nstr
)
)
)
)
)
)

;;功  能: 获取一点或两点间String 
;;参  数: e --- Text Entity 
;;        p1 -- Point 
;;        p2 -- Point or nil 
;;返回值: String 
(defun XD::Text:StringBetween (e    p1         p2   /           gettl     el          str 
                               nstr nnstr     ll   l        zl   ecs  inspt 
                               l1   l2         l3   l4 
                              ) 
  (if (= (xdrx_getpropertyvalue e "IsA") "AcDbText") 
    (progn 
      (defun gettl (l / box) 
        (setq box (textbox l)) 
        (car (mapcar '- (cadr box) (car box))) 
      ) 
      (setq el          (entget e) 
            str          (cdr (assoc 1 el)) 
            nstr  (xd::string:singlechr str) 
            l          (vl-remove-if-not 
                    '(lambda (x) (vl-position (car x) '(1 40 41 7))) 
                    el 
                  ) 
            zl          (gettl l) 
            ecs          (xdrx_entity_getecs e) 
            inspt (car ecs) 
            l1          (last (trans (mapcar '- (trans p1 1 0) inspt) 0 (cadr ecs))) 
            nnstr nstr 
      ) 
      (while nnstr 
        (setq ll    (cons 
                      (gettl 
                        (subst (cons 1 (apply 'strcat nnstr)) 
                               (assoc 1 l) 
                               l 
                        ) 
                      ) 
                      ll 
                    ) 
              nnstr (cdr nnstr) 
        ) 
      ) 
      (if p2 
        (progn 
          (setq        l2 
                 (last 
                   (trans (mapcar '- (trans p2 1 0) inspt) 0 (cadr ecs)) 
                 ) 
          ) 
          (mapcar 'set '(l3 l4) (vl-sort (list l1 l2) '<)) 
          (if (or (<= l4 0.) (>= l3 zl)) 
            str 
            (apply 'strcat 
                   (vl-remove nil 
                              (mapcar '(lambda (a b) 
                                         (if a 
                                           b 
                                           nil 
                                         ) 
                                       ) 
                                      (mapcar '(lambda (x) 
                                                 (if (<= l3 x l4) 
                                                   x 
                                                   nil 
                                                 ) 
                                               ) 
                                              ll 
                                      ) 
                                      nstr 
                              ) 
                   ) 
            ) 
          ) 
        ) 
        (if (or (<= l1 0.) (>= l1 zl)) 
          str 
          (nth (1+ (vl-position 
                     (last (vl-remove-if '(lambda (x) (> x l1)) ll)) 
                     ll 
                   ) 
               ) 
               nstr 
          ) 
        ) 
      ) 
    ) 
  ) 
)

eachy · 发表于 2013-12-8 08:40:54

test

(defun c:tt (/ e el p1 p2 str ne)
(if (and (setq e (ssget ":L:S" '((0 . "text"))))
(setq p1 (getpoint "\nFirst Point: "))
(setq p2 (XD::Doc:Getcorner p1 "\nSecond point: "))
)
(progn
(setq e (ssname e 0)
el (entget e)
str (XD::Text:StringBetween e p1 p2)
el (subst (cons 1 str) (assoc 1 el) el)
el (subst (cons 10 (trans p1 1 0)) (assoc 10 el) el)
)
(entmakex el)
(vl-cmdf ".move" "L" "" "_none" p1) ;_Move
(while (/= (getvar "cmdactive") 0)
(vl-cmdf pause)
)
)
)
(princ)
)

/db_自贡黄明儒_ · 发表于 2013-12-13 11:37:09

我最关心的是pick框内对象左键增，右键减{:soso_e113:}

st788796 · 发表于 2013-12-13 11:39:22

/db_自贡黄明儒_ 发表于 2013-12-13 11:37
我最关心的是pick框内对象左键增，右键减

这个可以有{:soso_e100:}

st788796 · 发表于 2013-12-13 12:10:19

1 Mtext 单行的要用到 RegexpS 提取字串，多行就要分出行来，分别处理
2 非 API 的用 Command UCS O 选项放到文字上就可以获得一个 UCS ，剩下的就可以利用楼主的代码

dyjwyqz5221 · 发表于 2019-5-13 15:55:58

这个函数对于像钢筋符号这类的，需要自己做下调整

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

[文本] (XD::Text:StringBetween)获取Text一点或两点间String

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

点评

点评