[求助]：如何用程序修改字符串中的一个用鼠标指定的字符,

hewb · 发表于 2004-8-27 21:59:04

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

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

×

假设CAD屏幕上有一字符串"HRB235"，用entsel选择该字符串，选择点落在字符"2"上，如何通过Lisp实现将"HRB235"改为"HRB335"（仅通过键盘输入一个字符3）？

aidraft · 发表于 2004-8-28 01:45:24

[php]
;;Written by AIdraft 28/8/04
(defun C:CHTXT
   (/ oldEcho sel pt ent el text ent1 el1 LOOP cnt new_char)
  (setq oldEcho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (if (setq sel (entsel "\n选择单行文字："))
(progn
   (setq pt (cadr sel)
      ent (car sel))
   (if (= (cdr (assoc 0 (setq el (entget ent)))) "TEXT")
(progn
   (setq text (cdr (assoc 1 el)))
   (entmake el)
   (setq ent1 (entlast)
el1  (entget ent1))
   (if (or (/= (cdr (assoc 72 el1)) 0)
   (/= (cdr (assoc 73 el1)) 0))
      (command "justifytext" ent1 "" "l")
      )
   (setq cnt 1
LOOP T)
   (setq el1 (entget ent1))
   (while (and LOOP (<= cnt (strlen text)))
      (entmod (setq el1 (subst (cons 1 (substr text 1 cnt))
      (assoc 1 el1)
      el1)))
      (if (CheckWidth ent1 pt)
      (progn
(entdel ent1)
(setq pos cnt)
(setq
   new_char (getstring
      (strcat "\n<"
      (substr text cnt 1)
      ">:")))
(if (/= new_char "")
   (entmod
      (subst
      (cons 1
      (strcat (substr text 1 (1- cnt))
      new_char
      (substr text (1+ cnt))))
      (assoc 1 el)
      el))
   )
(setq LOOP nil)
)
      ) ;endif
      (setq cnt (1+ cnt))
      )
   ) ;progn
(alert "选择了非单行文字！")
) ;endif
   ) ;progn
(princ "\n没有选择到图元！")
) ;endif
  (setvar "CMDECHO" oldEcho)
  (princ)
  )
;;----------------------------------------
(defun CheckWidth  (textent selpt / ll ur)
  (command "ucs" "Object" textent)
  (setq selpt (trans selpt 0 1))
  (setq ll (car (textbox (entget textent)))
ur (cadr (textbox (entget textent)))
wid  (abs (- (car ur) (car ll)))
wid1 (abs (- (car selpt) (car ll))))
  (command "ucs" "p")
  (if (> wid wid1) T nil)
  )

[/php]

它山之石 · 发表于 2004-8-28 17:00:13

1、好。当为纯数字或字母时非常方便。
2、但当字符串中有汉字或特殊字符时（如钢筋符号%%130）出　　错，估计是不能正确的判断文字宽度。
3、为什么非要求字符串为左对齐方式呢？
楼主有时间给完善一下吧。

hewb · 发表于 2004-8-28 21:13:04

谢谢，下下来研究研究。
争取解决三楼的第二个问题。

aidraft · 发表于 2004-8-29 10:35:54

最初由它山之石发布
[B]1、好。当为纯数字或字母时非常方便。
2、但当字符串中有汉字或特殊字符时（如钢筋符号%%130）出　　错，估计是不能正确的判断文字宽度。
3、为什么非要求字符串为左对齐方式呢？
楼主有时间给完善一下吧。 [/B]

2. 这个问题提得好，得好好想想。
3. 程序并没有要求字符串为左对齐方式

wkai · 发表于 2004-8-29 16:08:52

这个支持转义字符 .
substr_txt 替换文字 strcat_txt 连接文字内容
cut_txt 截断文字 chgln_txt 截断文字并换行

[swf w=679 h=386]http://p4.xdcad.net/forum/file_upload/225498_subtxt.swf[/swf]

aidraft · 发表于 2004-8-30 10:55:09

[php]

;;Written by AIdraft 28/8/04
;;Revised on 30/08/04 for specical chars such as "%%c" and "%%130", etc.
;;Pickbox size is considered, errors handled.
;;Spaces considered.

(defun C:CHTXT
         (/    oldEcho       sel pt    ent    el    text
ent1 el1 LOOP cnt new_char    olderr ch
step cnt1
)
  (defun chtxt_err (msg)
(if ENT1
   (if (not (vlax-erased-p ent1))
(entdel ent1)
)
   )
(if oldEcho
   (setvar "CMDECHO" oldEcho)
   )
(setq *error* olderr)
)
  (setq olderr *error*
*error* chtxt_err
)
  (setq oldEcho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "ucs" "w")
  (if (setq sel (entsel "\nSelect text:"))
(progn
   (setq pt (cadr sel)
      ent (car sel)
      )
   (if (= (cdr (assoc 0 (setq el (entget ent)))) "TEXT")
(progn
   (setq text (cdr (assoc 1 el)))
   (entmake el)
   (setq ent1 (entlast)
el1  (entget ent1)
)
   (if (or (/= (cdr (assoc 72 el1)) 0)
   (/= (cdr (assoc 73 el1)) 0)
   )
      (command "justifytext" ent1 "" "l")
      )
   (setq cnt 1
LOOP T
)
   (setq el1 (entget ent1))
   (while (and LOOP (<= cnt (strlen text)))
      (if (wcmatch (substr text cnt 5) "%%*")
      (if (wcmatch (substr text cnt 5) "%%[0-9][0-9][0-9]")
(setq step 5)
(setq step 3)
) ;endif
      (setq step 1)
      ) ;endif
      (if (= (substr text cnt 1) " ")
      (progn
(setq cnt1 1)
(while (= (substr text (+ cnt cnt1) 1) " ")
   (setq step cnt1)
   (setq cnt1 (1+ cnt1))
   )
)
      )
      (setq ch (substr text cnt step))
      (setq cnt (+ cnt (1- step)))
      (entmod (setq el1 (subst (cons 1 (substr text 1 cnt))
      (assoc 1 el1)
      el1
      )
   )
      )
      (if (CheckWidth ent1 pt)
      (progn
(entdel ent1)
(setq
   new_char (getstring T
      (strcat "\n<"
      ch
      ">:"
      )
      )
   )
(if (/= new_char "")
   (entmod
      (subst
      (cons 1
      (strcat (substr text 1 (- cnt step))
      new_char
      (substr text (1+ cnt))
      )
      )
      (assoc 1 el)
      el
      )
      )
   )
(setq LOOP nil)
)
      ) ;endif
      (setq cnt (1+ cnt))
      )
   ) ;progn
(alert "Invalid object!")
) ;endif
   ) ;progn
(princ "\nNo object selected!")
) ;endif
  (setvar "CMDECHO" oldEcho)
  (setq *error* olderr)
  (princ)
  )
;;----------------------------------------
(defun CheckWidth (textent selpt / ll ur hbox)
  (command "ucs" "Object" textent)
  (setq selpt (trans selpt 0 1))
  (setq ll (car (textbox (entget textent)))
ur (cadr (textbox (entget textent)))
wid  (abs (- (car ur) (car ll)))
wid1 (abs (- (car selpt) (car ll)))
hbox (/ (PickBoxSize) 2.0)
)
  (command "ucs" "p")
  (if (> wid (- wid1 hbox))
T
nil
)
  )
;;;This function is found in Autodesk Discussion Group
;;;Author: McSwain, R.K.
(defun PickBoxSize (/ SS VS PB SWP SHP AR WSD PPDU BOX)
  (setq SS (getvar "SCREENSIZE") ; screen size in pixels
VS (getvar "VIEWSIZE") ; screen height in drawing units
PB (getvar "pickbox") ; get current pickbox size
SWP  (car SS) ; width of screen in pixels
SHP  (cadr SS) ; height of screen in pixels
AR (/ SWP SHP) ; aspect ratio width/height
WSD  (* VS AR) ; width of screen dwg units = ratio timesheight
PPDU (/ WSD SWP) ; pixels per drawing unit
BOX  (/ (* VS (* 2 PB)) SHP) ; drawing units per pixel
)
  )

[/php]

hewb · 发表于 2004-8-31 19:45:54

在wkai和ardraft的提示下才写出来的。可解决中文字符的修改。
但字符串首有空格时，定位不准，请高手指正。

;;;200409261213___________________________
;;;字符串转换为表_________________________
(defun text_to_lst (text / n Len char strlst)
(setq n 1
   len (strlen text)
)
(while (<= n Len)
(if (wcmatch (substr text n 5) "%%*")
      (if (wcmatch (substr text n 5) "%%[0-9][0-9][0-9]")
(setq step 5
      char (substr text n step)
      strLst (cons char StrLst)
)
(setq step 3
      char (substr text n step)
      StrLst (cons Char StrLst)
)
      ) ;endif
      (progn
(setq step 1
      char (substr text n step)
)
(if (> (ascii char) 159)
      (progn (substr text (1+ n) 1)
   (setq strlst (cons (substr text n 2) strlst))
   (setq n (1+ n))
      )
      (setq strlst (cons char strlst))
)
      )
) ;endif
(setq n (+ n step))
)
(reverse strlst)
)
;;;测量TEXT中的每个字的宽度___________________
(defun GetPtofchar (en / str ang p lst pts pp n p0)
(setq el (entget en))
(mapcar '(lambda (x y) (set x (cdr (assoc y el))))
      '(str ang p)
      '(1 50 10)
)
(setq lst (text_to_lst str))
(while lst
(setq
      pts (append
      pts
      (list
(cadr
      (textbox
(subst (cons 1 (apply 'strcat lst))
         (assoc 1 el)
         el
)
      )
)
      )
)
)
(setq lst (reverse (cdr (reverse lst))))
)
(setq pts (mapcar 'car pts))
(setq pts (reverse pts))
(setq p0 (polar p ang (caar (textbox el))))
(setq pp (cons p (mapcar '(lambda (x) (polar p0 ang x)) pts)))
pp
)
;;;以上函数源自wkai和aidraft的程序

(vl-load-com)
(defun c:Chtxt (/ Lst1 en eo pt str str_lst ptlst n n1 dslst tmlst
   Loc_char ch1)
(setq Lst1 nil)
(while (not Lst1)
(setq Lst1 (entsel "\n选择一个字符串..."))
)
(setq en (car lst1)
   eo (vlax-ename->vla-object en)
   pt (cadr lst1)
)
(if (= (vla-get-ObjectName eo) "AcDbText")
(progn
      (setq str    (vla-get-textstring eo)
   Str_lst (text_to_lst str)
      )
      (command "undo" "BE")
      (setq ptlst (GetPtofChar en))
      (setq n (length ptlst))
      (setq dslst (mapcar '(lambda (x) (list (distance pt x)))
ptlst
)
      )
      (setq n1 0
   Lst1 '()
      )
      (repeat (length ptlst)
(setq lst1 (append lst1 (list n1)))
(setq n1 (1+ n1))
      )
      (setq ptlst (mapcar 'cons lst1 Ptlst))
      (setq tmlst
      (vl-sort
   (mapcar 'append dslst ptlst)
   (function (lambda (x y) (< (car x) (car y))))
      )
      )
      (setq Loc_char (min (cadar tmlst) (cadadr tmlst)))
      (setq
ch1 (getstring
(strcat "\n新字符<"
(nth loc_char str_lst)
">"
)
      )
      )
      (setq str_lst (ReplaceNth Loc_char Str_lst ch1))
      (vla-put-textstring eo (apply 'strcat str_lst))
      (vla-update eo)
      (command "undo" "E")
      (vlax-release-object eo)
)
(princ "\n不是字符串！")
)
(princ)
)

(defun ReplaceNth (n lst val / len lst1 m)
(setq len  (length lst)
   lst1 '()
   m 0
)
(repeat len
(if (= m n)
      (setq lst1 (cons val Lst1))
      (setq Lst1 (cons (nth m Lst) lst1))
)
(setq m (1+ m))
)
(setq lst1 (reverse lst1))
)

aidraft · 发表于 2004-8-31 20:16:57

楼上我修改后的程序考虑了空格问题

回车的时候应该不改变，而不是删除该字符。
还应该考虑pickbox的尺寸（注意我楼上程序的最后一段）。不考虑pickbox有时会选到后面的字符。

hewb · 发表于 2004-9-1 08:27:12

1、串首空格问题已明白。
2、以前调试的时候，确实会选到后面的字符，原来是PICKBOX在起作用。
谢谢楼上。

逐月飞鸿 · 发表于 2004-9-13 19:57:17

wkai斑竹的太经典了，构思新颖巧妙！妙！我们要向他多多学习！强力推荐大家下载应用！
不知道wkai斑竹的editxt.rar。的代码我们有幸学习不？

jinsong-liao · 发表于 2004-9-14 09:39:38

一群cad应用技术的默默探索者，值得我学习！！！

armand · 发表于 2004-9-15 02:29:10

还有这么厉害的程序啊。

它山之石 · 发表于 2004-9-22 16:55:39

　　谢谢各位高手能采纳我的意见并将程序完善。我测试了一下，结果如下　：
　　1、我用的是R14，将以下代码改掉，就可在R14下用了。
　　2、转义字符%%***已解决。更好的处理办法是只修改最后的数字，如将%%130改为%%131，只要输入1即可。
　　3、汉字还是有问题。在R14下是问号。
　　4、有时会错误选到后面字符的问题也解决。
　　5、如果能在屏幕上将选中的字符亮显或变色以醒目提示就堪称完美了。
　　

(if (or (/= (cdr (assoc 72 el1)) 0)
(/= (cdr (assoc 73 el1)) 0)
)
(command "justifytext" ent1 "" "l")
)

替换成以下代码

;;;如果不是左对齐方式，改为左对齐方式(FOR R14)
(setq dq1 (setq dqb1 (assoc 72 el1)))
(setq dq2 (setq dqb2 (assoc 73 el1)))
(if (/= dq1 0)
(progn
(setq p11 (assoc 11 el1)) ;p11---对齐点表
(setq p11b '(0.0 0.0 0.0)) ;p11b---对齐点坐标
(setq el1 (subst (cons 11 p11b) p11 el1)) ;置换对齐点表
(setq dq 0) ;设定对齐方式为左侧对齐
(setq el1 (subst (cons 72 dq) dqb1 el1)) ;置换对齐方式表
(if (/= dq2 0)
(setq el1 (subst (cons 73 dq) dqb2 el1))
) ;置换对齐方式表
(entmod el1) ;更新字符串表
)
)

　　汉字问题也解决了，包括双字节字符。只要将代码改成下面：

(setq ch (substr text cnt step))

(setq ch (substr text cnt step))
(setq pdhz (ascii ch))
(if (> pdhz 58)
(progn
(setq step 2)
(setq ch (substr text cnt step))
)
)

Free-Lancer · 发表于 2004-9-22 18:16:51

最初由它山之石发布
[B]　　谢谢各位高手能采纳我的意见并将程序完善。我测试了一下，结果如下　：
　　1、我用的是R14，将以下代码改掉，就可在R14下用了。
　　2、转义字符%%***已解决。更好的处理办法是只修改最后的数字，如将%%130改... [/B]

什么原因还使用R14？业余编程的早该抛弃了，浪费时间。

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

[求助] [求助]：如何用程序修改字符串中的一个用鼠标指定的字符,

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

相关帖子