删除TEXT实体最后一个字符的几种方法

newer · 发表于 2016-9-9 11:50:52

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

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

×

(defun c:foo (/ ss)
(if (setq ss (ssget "_:L" '((0 . "TEXT"))))
((lambda (i / e ed s)
(while (setq e (ssname ss (setq i (1+ i))))
(setq ed (entget e))
(setq s (assoc 1 ed))
(setq ed (subst
(cons 1 (substr (cdr s) 1 (1- (strlen (cdr s)))))
s
ed
)
)
(entmod ed)
)
) -1
)
(prompt "\n** Nothing selected ** ")
)
(princ)
)

(defun c:tt( / e i n s x )
(setq n 1) ;; Number of characters to remove from end of string
(if (setq s (ssget "_:L" '((0 . "TEXT"))))
(repeat (setq i (sslength s))
(setq e (ssname s (setq i (1- i)))
x (cdr (assoc 1 (entget e)))
)
(if (< n (strlen x))
(entmod (list (cons -1 e) (cons 1 (substr x 1 (- (strlen x) n)))))
)
)
)
(princ)
)

(defun c:tt ( / e i n s x ) ;; define function, declare local variables
(setq n 1) ;; Number of characters to remove from end of string
(if ;; If the following expression returns a non-nil value
(setq s ;; Assign the following value to the symbol 's'
(ssget ;; Collect a selection set of
"_:L" ;; Object on unlocked layers
'((0 . "TEXT")) ;; whose entity type (DXF Group 0) = TEXT
) ; end ssget
) ;; end setq
(repeat ;; repeat a set of expressions a number of times
(setq i ;; Assign the following value to the symbol 'i'
(sslength s) ;; Number of items in the selection set
) ;; end setq
(setq e ;; Assign the following value to the symbol 'e'
(ssname s ;; Retrieve the entity name at a specific index in the set
(setq i (1- i)) ;; Decrement the counter variable 'i'
) ;; end ssname
x ;; Assign the following value to the symbol 'x'
(cdr ;; Return the second item of the dotted pair
(assoc 1 ;; Retrieve the dotted pair with DXF Group 1 (the text string)
(entget e) ;; Retrieve the DXF data for the entity assigned to the symbol 'e'
) ;; end assoc
) ;; end cdr
) ;; end setq
(if ;; If the following expression returns a non-nil value
(< n (strlen x)) ;; If the length of the text string is greater than the number of characters to be subtracted
(entmod ;; Modify the following DXF data
(list ;; Contruct a list of DXF data
(cons -1 e) ;; Create a dotted pair with the entity to be modified (1 . <entity-name>)
(cons 1 ;; Create a dotted pair with the new string value (DXF Group 1)
(substr x ;; Return a substring of the entity text string
1 ;; from the first character
(- (strlen x) n) ;; spanning the length of the string minus the number of characters to be removed
) ;; end substr
) ;; end cons
) ;; end list
) ;; end entmod
) ;; end if
) ;; end repeat
) ;; end if
(princ) ;; Suppress the return of the last evaluated expression
)

(defun c:tt ( / e i n s x ) ;; define function, declare local variables 
 
    (setq n 1) ;; Number of characters to remove from end of string 
 
    (if ;; If the following expression returns a non-nil value 
        (setq s ;; Assign the following value to the symbol 's' 
            (ssget ;; Collect a selection set of 
                "_:L" ;; Object on unlocked layers 
                '((0 . "TEXT")) ;; whose entity type (DXF Group 0) = TEXT 
            ) ; end ssget 
        ) ;; end setq 
        (repeat ;; repeat a set of expressions a number of times 
            (setq i ;; Assign the following value to the symbol 'i' 
                (sslength s)  ;; Number of items in the selection set 
            ) ;; end setq 
            (setq e ;; Assign the following value to the symbol 'e' 
                (ssname s ;; Retrieve the entity name at a specific index in the set 
                    (setq i (1- i)) ;; Decrement the counter variable 'i' 
                ) ;; end ssname 
                x ;; Assign the following value to the symbol 'x' 
                (cdr ;; Return the second item of the dotted pair 
                    (assoc 1 ;; Retrieve the dotted pair with DXF Group 1 (the text string) 
                        (entget e) ;; Retrieve the DXF data for the entity assigned to the symbol 'e' 
                    ) ;; end assoc 
                ) ;; end cdr 
            ) ;; end setq 
            (if ;; If the following expression returns a non-nil value 
                (< n (strlen x)) ;; If the length of the text string is greater than the number of characters to be subtracted 
                (entmod ;; Modify the following DXF data 
                    (list ;; Contruct a list of DXF data 
                        (cons -1 e) ;; Create a dotted pair with the entity to be modified (1 . <entity-name>) 
                        (cons 1 ;; Create a dotted pair with the new string value (DXF Group 1) 
                            (substr x ;; Return a substring of the entity text string 
                                1 ;; from the first character 
                                (- (strlen x) n) ;; spanning the length of the string minus the number of characters to be removed 
                            ) ;; end substr 
                        ) ;; end cons 
                    ) ;; end list 
                ) ;; end entmod 
            ) ;; end if 
        ) ;; end repeat 
    ) ;; end if 
    (princ) ;; Suppress the return of the last evaluated expression 
)

VLISP

[it618postdisplay>0]

(defun c:tt (/ *error* oldnomutt ss odoc s)
(vl-load-com)
(princ "\rtt ")
(defun *error* (msg)
(and
oldnomutt
(setvar 'nomutt oldnomutt)
)
(if odoc
(vla-endundomark odoc)
)
(cond
((not msg)) ; normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or
; (quit)
((princ (strcat "\n** Error: " msg " ** ")))
) ; fatal error, display it
(princ)
)
(prompt "\nSelect text objects to remove last character: ")
(and
(setq oldnomutt (getvar 'nomutt))
(setvar 'nomutt 1)
)
(if (setq ss (ssget "_:L" '((0 . "TEXT"))))
(progn
(vla-startundomark (setq odoc (vla-get-activedocument
(vlax-get-acad-object)
)
)
)
(vlax-for x (setq ss (vla-get-activeselectionset odoc))
(setq s (vla-get-textstring x))
;|
(vla-put-textstring
x
(vl-string-subst
""
(substr s (strlen s) 1)
s)))
|;
(vla-put-textstring x (substr s 1 (1- (strlen s))))
)
(vla-endundomark odoc)
(vla-delete ss)
(setvar 'nomutt oldnomutt)
)
(progn
(setvar 'nomutt oldnomutt)
(prompt "\n** Nothing selected ** ")
)
)
(princ)
)

(defun c:tt (/ *error* oldnomutt ss odoc s) 
  (vl-load-com) 
  (princ "\rtt ") 
  (defun *error* (msg) 
    (and 
      oldnomutt 
      (setvar 'nomutt oldnomutt) 
    ) 
    (if odoc 
      (vla-endundomark odoc) 
    ) 
    (cond 
      ((not msg))                       ; normal exit 
      ((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or 
                                       ; (quit) 
      ((princ (strcat "\n** Error: " msg " ** "))) 
    )                                       ; fatal error, display it 
    (princ) 
  ) 
  (prompt "\nSelect text objects to remove last character: ") 
  (and 
    (setq oldnomutt (getvar 'nomutt)) 
    (setvar 'nomutt 1) 
  ) 
  (if (setq ss (ssget "_:L" '((0 . "TEXT")))) 
    (progn 
      (vla-startundomark (setq odoc (vla-get-activedocument 
                                                            (vlax-get-acad-object) 
                                    ) 
                         ) 
      ) 
      (vlax-for x (setq ss (vla-get-activeselectionset odoc)) 
                (setq s (vla-get-textstring x)) 
;| 
        (vla-put-textstring 
          x 
          (vl-string-subst 
            "" 
            (substr s (strlen s) 1) 
            s))) 
            |; 
                (vla-put-textstring x (substr s 1 (1- (strlen s)))) 
      ) 
      (vla-endundomark odoc) 
      (vla-delete ss) 
      (setvar 'nomutt oldnomutt) 
    ) 
    (progn 
      (setvar 'nomutt oldnomutt) 
      (prompt "\n** Nothing selected ** ") 
    ) 
  ) 
  (princ) 
)

[/it618postdisplay]

上面的代码都不支持中文，中文还是按2个字节处理，如果最后一个字符是汉字，那么上面代码最后字符会乱码。下面代码支持中文，中文字符长度按1处理

(defun c:tt()
(setq n 1) ;; Number of characters to remove from end of string
(if (setq s (ssget "_:L" '((0 . "TEXT"))))
(repeat (setq i (sslength s))
(setq e (ssname s (setq i (1- i)))
x (cdr (assoc 1 (entget e)))
)
(if (< n (strlen x))
(entmod (list (cons -1 e) (cons 1 (xdrx_string_substr x 1 (xdrx_string_length x)))))
)
)
)
(princ)
)

上面代码使用了XDRX API的字符串处理函数
全部用API改写的话，下面：

(defun c:tt ()
(if (setq s (ssget "_:L" '((0 . "TEXT"))))
(mapcar
'(lambda (x)
(setq old (xdrx_getpropertyvalue x "textstring")
newstr (xdrx_string_substr old 1 (xdrx_string_length old))
)
(xdrx_setpropertyvalue x "textstring" newstr)
)
(xdrx_pickset->ents s)
)
)
(princ)
)

WhoCanSay · 发表于 2016-9-9 14:44:39

N版这段时间都在大总结，good job!!!

yoyoho · 发表于 2016-9-9 17:03:46

学习!学习!!!

HLCAD · 发表于 2016-9-9 17:05:22

版主热心，向版主致敬！

q3_2006 · 发表于 2016-9-9 20:32:03

还从来没用VLSP方法..学习..

Lisphk · 发表于 2016-9-9 21:13:39

谢谢N版，向N版学习。

kqqt6236 · 发表于 2020-6-29 19:55:55

正好用得上，感谢。

liulisheng · 发表于 2020-11-17 00:00:01

感谢版主大作

wrf610051 · 发表于 2020-11-17 06:30:25

回复学习，谢谢大师的分享。

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

[每日一码] 删除TEXT实体最后一个字符的几种方法

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