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

它山之石

最初由 urljit 发布
[B]楼上的，我觉得相反，如果按照我说的那个方法，岂不是可以马上改那个字符了吗？看看程序的执行过程：命令，回车，选择（对准位置），键入新内容，回车。ok了 [/B]

　　事实是不用对话框，程序的执行过程也同你说的那样：“命令，回车，选择（对准位置），键入新内容，回车。ok了”。我觉得加上对话框没有太大的意义。
　　另复29楼，同时选中两个字符修改是可以的，但问题是那样就不通用了，也许有人又说要同时改3个字符呢。所以最好的办法就是一个一个的改。

urljit

做为编程得尽量考虑其他情况的发生，有了对话框就给了用户修改其他字符的机会和权力，这样做为一个程序生存下去的机会就很大 ，否则，在如此多的程序海洋里面，只有和dos类似的功能是很容易被淘汰的。正如现在的社会对人才的需求一样：需要的是“复合型人才”

swaywood

最初由 urljit 发布
[B]

为什么不可能？ [/B]

任何编程语言都有缺陷，lisp更不例外

复31楼

你可以做到不点选呀，用户爱选几个字就选几个字

它山之石

　　对程序又进行了改进。修正了一些小BUG，并补充了一些功能，主要是对一下标及加圈字符的支持。未采纳urljit的建议（其实是我不知如何实现）。加载后在命令行输入“PMGZ”即可。这次做为附件上传。

;;;V041012新增功能
;;;   1、修正了字符改色时出现的不连续及与大于7的号相同时不能改变的问题，
;;;      确保使颜色号保持在7之内且不与实体色相同。
;;;   2、修正了选取上下标及加圈字符时显示不在原位的错误。
;;;   3、增加了输入新字符与图中加圈字符个数不一致时的容错性，给出提示并退出程序

swaywood

老大，能否做出改两个字的来，期待着

amanjmy

傻问php是什么东西啊

urljit

php是粘贴程序代码用的

它山之石

最初由 swaywood 发布
[B]老大，能否做出改两个字的来，期待着 [/B]

    1、你所谓的改两个字是包含你点选字符的前面的还是后面的字符？这样做对你很必要吗？
  2、把你的要求说清楚。也许我会帮你修改一下程序，但你就只能一次改两个字而不能改一个字了，至于是否会带来其它问题也不知道。
　3、至于33楼所说的“可以不点选，用户爱选几个就选几个”就与本主题“修改字符串中一个用鼠标指定的字符”不符了。不过倒给我提供了另外一个思路。如果点选到了字符，就修改选到的那个字符，如果点在字符串外面，就自动变为框选，选中几个字符就修改那几个。

bluesky1000

有对话框的就好了，另外有时候可能会需要修改二个或几个连续的字符，希望能加入这些功能。

swaywood

最初由 它山之石 发布
[B]

    1、你所谓的改两个字是包含你点选字符的前面的还是后面的字符？这样做对你很必要吗？
  2、把你的要求说清楚。也... [/B]

我觉得很有必要，经常，复制文字是因为它包含有我要的内容，但不一定完全一样，所以我需要将不要的部分修改……
另外，作为程序本身而言如果能选改两个获以上的文字将更通用
正如你第3点里所说的

我想你可以精确控制一个字符的位置而不至于错位，那你肯定同样能精确的将与选框相交的文字找到

urljit

石：遇到问题了，上！我等你的好消息。

zjfcumt

用了一下34楼的程序，真的很方便！谢谢！！

litss

它山之石的pmgz程序不错：）。不过测试了一下，觉得还可以改进一下：
1、原程序在最初使用时，对undo点设置的命令没有放在(setvar "CMDECHO" 0)之后，导致用户可以直接看到一大串不“友好”的东西，呵呵，是不是应该稍微挪一下位置啊？
2、关于(setvar "CMDECHO" 0) 的问题，我个人觉得，在使用这个命令之前，还是应该先(setq oldcmd (getvar "cmdecho"))一下，到了程序末再(setvar "CMDECHO" oldcmd)，以保证不对用户原有环境做修改。
3、是否能把用户输入的字符作为全局变量自动记忆下来，然后实现连续点选修改相同内容，直至用户敲回车退出？因为多数情况下，要改东西就肯定不止一处的。为了同一内容不断按键盘不太合算。

它山之石

楼上的建议我会考虑的，但现在很忙，等把这套图出去后再来修改这个程序。

nuance

本来是想修改它山之石的程序作为己用，研究了很久但没看懂，自己试着编了一个。
1、支持UCS。
2、可修改TEXT和ATTRIB。
3、支持%%*。
4、支持上下标，但要固定，本例中％％151上标开始，％％152上标结束，
％％153下标开始，％％154下标结束，不同的字体修改相应源程序即可。
5、支持汉字及双字节字符。
6、不支持加圈字符。
7、不支持TEXTSTYLE中的upside down,backwards,vertical,oblique angles。
8、使用了vl-remove函数，R14不能用。
9、以亮显方式显示修改字符。
10、有一个很多程序都有的问题，如果程序被强行中断，不能去处新生成的实体。
11、原本是想可以支持框选，但是如果框选的起末点是空格的话，还没想好怎样处理。
    wkai版主的程序不知道是怎样考虑这个问题的，希望赐教。

(defun c:ppp (/ obj obj-name pt-select dxfdata text-value-old dxfdata-2 obj-2 dxfdata-3
              list-whichchar-charlen-xy-supersubscript which-char-main char-len-main
              xy-mian super-sub-script-main newstr text-value-new
              layer iflock dxflayer dxflayer2)
(command "undo" "be")
(if (setq obj (nentsel "\npick a char to modify / <exit>:")) ;if0
   (progn;0
      (setq obj-name (car obj) pt-select (cadr obj))
      (setq pt-select (trans pt-select 1 0))
      (setq dxfdata (entget obj-name))
      (setq text-value-old (cdr (assoc 1 dxfdata)))
      (if (wcmatch (cdr (assoc 0 dxfdata)) "TEXT,ATTRIB");if1
         (progn;1
            (setq dxfdata-2 dxfdata)
            (if (= "TEXT" (cdr (assoc 0 dxfdata-2)))
               (progn
                  (if (= 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 dxfdata))))))
                     (progn  (alert "object is on a locked layer !")(exit)))
                  
                  (entmake dxfdata-2)
               );progn
            );if
            (if (= "ATTRIB" (cdr (assoc 0 dxfdata-2)))
               (progn
                  (if (= 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 (entget (cdr (assoc 330 dxfdata)))))))))
                     (progn  (alert "object is on a locked layer !")(exit)))
                  
                  (setq dxfdata-2 (subst (cons 0 "TEXT") (assoc 0 dxfdata-2) dxfdata-2))
                  (setq dxfdata-2 (vl-remove (assoc 2  dxfdata-2) dxfdata-2))
                  (setq dxfdata-2 (vl-remove (assoc 70 dxfdata-2) dxfdata-2))
                  (setq dxfdata-2 (vl-remove (assoc 74 dxfdata-2) dxfdata-2))
                  (entmake dxfdata-2)
               )
            );if
            (setq obj-2 (entlast))
            (setq dxfdata-3 (entget obj-2))
            (setq dxfdata-3 (subst (cons 72 2) (assoc 72 dxfdata-3) dxfdata-3))
            (setq dxfdata-3 (subst (cons 73 0) (assoc 73 dxfdata-3) dxfdata-3))
            
            (setq list-whichchar-charlen-xy-supersubscript (get-whichchar-charlen-xy-supersubscript pt-select dxfdata-3))
            (setq which-char-main       (car    list-whichchar-charlen-xy-supersubscript))
            (setq char-len-main         (cadr   list-whichchar-charlen-xy-supersubscript))
            (setq xy-main               (caddr  list-whichchar-charlen-xy-supersubscript))
            (setq super-sub-script-main (cadddr list-whichchar-charlen-xy-supersubscript))
            
            (setq dxfdata-3 (subst (cons 11 xy-main) (assoc 11 dxfdata-3) dxfdata-3))
            (setq dxfdata-3 (subst (cons 1 (strcat super-sub-script-main
                                    (substr text-value-old (+ 1 (- which-char-main char-len-main)) char-len-main)))
                                       (assoc 1 dxfdata-3) dxfdata-3))
            (entmod dxfdata-3)
            (redraw (cdr (assoc -1 dxfdata-3)) 3)            
            
            (setq newstr (getstring (strcat "\nenter to remove / ["
                                       (substr (cdr (assoc 1 dxfdata))
                                               (+ 1 (- which-char-main char-len-main))
                                               char-len-main)
                                       "]:"))
            );setq k
          
            (setq text-value-new (strcat (substr text-value-old 1 (- which-char-main char-len-main))
                                                   newstr
                                         (substr text-value-old (+ 1 which-char-main))
                                         ));setq text-value
            (setq dxfdata (subst (cons 1 text-value-new) (assoc 1 dxfdata) dxfdata))
            (if (= "TEXT" (cdr (assoc 0 dxfdata)))
               (entmake dxfdata)
            );if
            (if (= "ATTRIB" (cdr (assoc 0 dxfdata)))
               (progn
                  (setq layer (cdr (assoc 8 dxfdata)))
                  (setq iflock 0)
                  (if (= 4 (cdr (assoc 70 (tblsearch "layer" layer))))
                     (progn
                        (setq iflock 1)
                        (setq dxflayer (entget (tblobjname "layer" layer)))
                        (setq dxflayer2 dxflayer)
                        (setq dxflayer (subst (cons 70 0) (assoc 70 dxflayer) dxflayer))
                        (entmod dxflayer)
                     )
                  )
                  
                  (entmod dxfdata)
                  (entupd (cdr (assoc 330 dxfdata)))
                  
               );progn
            );if
            (entdel (cdr (assoc -1 dxfdata-2)))
            (entdel (cdr (assoc -1 dxfdata-3)))
            (if (= 1 iflock)(entmod dxflayer2))         
         );progn1
         (alert "\nselected object is not a TEXT or a ATTRIB !")
      );if1
   );progn0
   (princ "\nno object is selected !")
);if0
(command "undo" "end")
(princ)
);defun

(defun get-whichchar-charlen-xy-supersubscript (pt-select-sub dxfdata-sub
   / pt-left text-angle text-value loop which-char char-len box-1 box-2 str-wid
     pt-dummy-1 pt-dummy-2 pt-dummy dist wid-from-left-to-right box super-sub-script)
(setq pt-left (cdr (assoc 10 dxfdata-sub)))
(setq text-angle (cdr (assoc 50 dxfdata-sub)))
(setq text-value (cdr (assoc 1 dxfdata-sub)))
(setq which-char 0)
(setq loop t)
(setq super-sub-script "")

(setq pt-dummy-1 (polar pt-left text-angle 100.0))
(setq pt-dummy-2 (polar pt-select-sub (+ (/ pi 2.0) text-angle) 100.0))
(setq pt-dummy (inters pt-left pt-dummy-1 pt-select-sub pt-dummy-2 nil))
(setq dist (distance pt-left pt-dummy))

(while loop
   (setq char-len 1)

   (if (wcmatch (substr text-value (+ 1 which-char) 5) "%%*");if1
   (if (wcmatch (substr text-value (+ 1 which-char) 5) "%%[0-9][0-9][0-9]")
      (setq char-len 5)
      (if (wcmatch (substr text-value (+ 1 which-char) 5) "%%[0-9][0-9][~0-9]")
         (setq char-len 4)
         (if (and (wcmatch (substr text-value (+ 1 which-char) 5) "%%[0-9][0-9]")
                  (= 4 (strlen (substr text-value (+ 1 which-char) 5))))
            (setq char-len 4)
            (setq char-len 3)
         )
      )
   )
   );if1

   ;%%151--start of superscript
   ;%%152--end of superscript
   ;%%153--start of subscript
   ;%%154--end of subscript
   ;%%155--start of subscript
   ;%%156--end of subscript
   (if (wcmatch (substr text-value (+ 1 which-char) 5) "%%151,%%152,%%153,%%154,%%155,%%156")
       (setq super-sub-script (strcat super-sub-script (substr text-value (+ 1 which-char) 5))))

   (if (> (ascii (substr text-value (+ 1 which-char) 1)) 159);if2
      (setq char-len 2)
   );if2

   (setq which-char (+ which-char char-len))
   
   (setq box-1 (textbox (subst (cons 1 (strcat "A" (substr text-value 1 which-char)))
                               (assoc 1 dxfdata-sub) dxfdata-sub)))
   (setq box-2 (textbox (subst (cons 1 "A") (assoc 1 dxfdata-sub) dxfdata-sub)))
   (setq str-wid (abs (- (- (car (car box-1)) (car (cadr box-1)))
                           (- (car (car box-2)) (car (cadr box-2))))))
   (setq box (textbox (subst (cons 1 (substr text-value 1 which-char))
                                 (assoc 1 dxfdata-sub) dxfdata-sub)))
   (setq wid-from-left-to-right (car (cadr box)))      

   (if (> str-wid dist)(setq loop nil))
   
);while
   
(list which-char char-len (polar pt-left text-angle wid-from-left-to-right) super-sub-script)
);defun-sub