[编程申请]：将以斜杠/开头且含字符]的字符串加上前缀Z

lengliqun

求一lsp程序，将以斜杠/开头且含字符]的字符串加上前缀Z，如将/3]20变成Z3]20，如不以斜杠/开头
但含/含]如3]30/3]20则不得变化，能全选，谢谢。

zxq0220

加字母Z
[php]
(DEFUN C:ADD-Z ()
(PRINC "\nPlease Select Text(s) 请选择文字 :")
(SETQ SS (SSGET "X" '((0 . "TEXT")))
       I 0)
(REPEAT (SSLENGTH SS)
  (SETQ ENT (ENTGET (SSNAME SS I)) I (1+ I)
        STR (CDR (ASSOC 1 ENT)))
  (IF (AND (WCMATCH STR "/*") (WCMATCH STR "*]*")) (PROGN
   (SETQ ENT (SUBST (CONS 1 (STRCAT STR "Z" STR)) (CONS 1 STR) ENT))
   (ENTMOD ENT)
  ))
)
(PRINC)
)
[/php]
减字母Z
[php]
(DEFUN C:DEL-Z ()
(PRINC "\nPlease Select Text(s) 请选择文字 :")
(SETQ SS (SSGET "X" '((0 . "TEXT")))
       I 0)
(REPEAT (SSLENGTH SS)
  (SETQ ENT (ENTGET (SSNAME SS I)) I (1+ I)
        STR (CDR (ASSOC 1 ENT))
        SL (STRLEN STR))
  (IF (AND (WCMATCH STR "Z/*")) (WCMATCH STR "*]*")) (PROGN
   (SETQ ENT (SUBST (CONS 1 (SUBSTR STR 2 (1- SL)) (CONS 1 STR) ENT))
   (ENTMOD ENT)
  ))
)
(PRINC)
)
[/php]

lengliqun

ADD-Z 可用，但如　/2]20　变成了　/2]20Z/2]20　，而我要求如　/2]20　变成　Z/2]20　请求修改，谢谢。　DEL-Z 在R2002下有语法错误。

sofondzh

关注。。。非常感激无私行为

zxq0220

更改后程序
加字母
[php]
(DEFUN C:ADD-Z ()
(PRINC "\nPlease Select Text(s) 请选择文字 :")
(SETQ SS (SSGET "X" '((0 . "TEXT"))))
(SETQ I 0)
(REPEAT (SSLENGTH SS)
  (SETQ ENT (ENTGET (SSNAME SS I)) I (1+ I)
        STR (CDR (ASSOC 1 ENT)))
  (IF (AND (WCMATCH STR "/*") (WCMATCH STR "*]*")) (PROGN
   (SETQ ENT (SUBST (CONS 1 (STRCAT "Z" STR)) (CONS 1 STR) ENT))
   (ENTMOD ENT)
  ))
)
(PRINC)
)
[/php]
减字母
[php]
(DEFUN C:DEL-Z ()
(PRINC "\nPlease Select Text(s) 请选择文字 :")
(SETQ SS (SSGET "X" '((0 . "TEXT"))))
(SETQ I 0)
(REPEAT (SSLENGTH SS)
  (SETQ ENT (ENTGET (SSNAME SS I)) I (1+ I)
        STR (CDR (ASSOC 1 ENT))
        SL (STRLEN STR))
  (IF (AND (WCMATCH STR "Z/*") (WCMATCH STR "*]*")) (PROGN
   (SETQ ENT (SUBST (CONS 1 (SUBSTR STR 2 (1- SL))) (CONS 1 STR) ENT))
   (ENTMOD ENT)
  ))
)
(PRINC)
)
[/php]

lengliqun

可以用了，谢谢！

xyp1964

一个程序就够了：
[php]
;;;加载通用函数
;;;下载：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
(load "xyp_lib")
;;;替换首字母"/－－－"的文本为"Z－－－－"
(DEFUN C:test ()
  (SETQ        SS (SSGET "X" '((0 . "TEXT")))
        n  -1
  )
  (while (setq s1 (ssname ss (setq n (1+ n))))
    (setq txtold (dxf 1 (entget s1)))
    (if        (= (substr txtold 1 1) "/")
      (progn
        (setq txtnew (vl-string-subst "Z" "/" txtold))
        (SUB_UPD s1 1 txtnew)
      )
    )
  )
  (PRINC)
)
[/php]