设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [求助]：如何用程序修改字符串中的一个用鼠标指定的字符 ...
1234下一页
返回列表 发新帖
楼主: hewb

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

[复制链接]
它山之石
发表于 2004-9-22 18:20:15 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
惭愧，被批评还在用R14。
因为单位好多人都在用，我得为大家写程序。所以也在用了。2004也在用。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

urljit
发表于 2004-9-23 14:05:17 | 显示全部楼层
JUSTIFYTEXT 是什么版本的cad命令？抑或是et的？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

它山之石
发表于 2004-9-24 09:26:16 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
我在各位高手的基础上对程序进行了改进，用于R14版本。功能如下，各位继续完善吧。

;;;V040901新增功能
;;;   1、可以直接从屏幕上点取要修改的字符，然后输入新的字符就自动完成修改。
;;;   2、下个版本将增加对%%特殊字符及双字节汉字的支持。

;;;V040921新增功能
;;;   1、增加对%%特殊字符的支持，但对上下标有时选不到上下标的字符，对加圈字符无效。
;;;   2、增加对双字节字符包括汉字的支持。
;;;   3、修正了有时会选取后面字符的错误。
;;;   4、下个版本将增加亮显程序取得的字符的功能。

  3. ;;;       =======================================
  4. ;;;       |         屏幕文字自动修改软件        |
  5. ;;;       |          Update: 04.09.21           |
  6. ;;;       =======================================


  9. (defun chgterr (s)
  10.   (if (/= s "命令被取消")                ; If an error (such as CTRL-C) occurs
  11.     (princ (strcat "\n错误: " s))        ; while this command is active...
  12.   )
  13.   (setvar "CMDECHO" 0)
  14.   (command "undo" "e")
  15.   (setq p nil)                                ; Free selection set
  16.   (setq *error* olderr)                        ; Restore old *error* handler
  17.   (princ)
  18. )


  21. ;;;主程序

  23. (defun C:PMGZ (/          olderr　*error*　oldEcho           sel
  24.                pt          ent             el                text           ent1
  25.                el1          LOOP             cnt        new_char   ch
  26.                step          cnt1             chh        cch           pdhz
  27.               )


  30.   (command "undo" "be")
  31.   (setq        olderr        *error*                        ; Initialize variables
  32.         *error*        chgterr
  33.   )

  35.   (setvar "CMDECHO" 0)
  36.   (command "ucs" "w")
  37.   (if (setq sel (entsel "\n点取要修改的字符<退出>："))
  38.     (progn
  39.       (setq pt        (cadr sel)
  40.             ent        (car sel)
  41.       )
  42.       (if (= (cdr (assoc 0 (setq el (entget ent)))) "TEXT")
  43.         (progn
  44.           (setq text (cdr (assoc 1 el)))
  45.           (entmake el)
  46.           (setq        ent1 (entlast)
  47.                 el1  (entget ent1)
  48.           )


  51. ;;;如果不是左对齐方式，改为左对齐方式(FOR R14)          
  52.           (setq dq1 (setq dqb1 (assoc 72 el1)))
  53.           (setq dq2 (setq dqb2 (assoc 73 el1)))
  54.           (if (/= dq1 0)
  55.             (progn
  56.               (setq p11 (assoc 11 el1))        ;p11---对齐点表
  57.               (setq p11b '(0.0 0.0 0.0)) ;p11b---对齐点坐标
  58.               (setq el1 (subst (cons 11 p11b) p11 el1)) ;置换对齐点表
  59.               (setq dq 0)                ;设定对齐方式为左侧对齐
  60.               (setq el1 (subst (cons 72 dq) dqb1 el1)) ;置换对齐方式表
  61.               (if (/= dq2 0)
  62.                 (setq el1 (subst (cons 73 dq) dqb2 el1))
  63.               )                                ;置换对齐方式表
  64.               (entmod el1)                ;更新字符串表
  65.             )
  66.           )
  67. ;;;R2004版改变字符对齐方式为左对齐。
  68. ;;;      (if (or (/= (cdr (assoc 72 el1)) 0)
  69. ;;;         (/= (cdr (assoc 73 el1)) 0)
  70. ;;;          )
  71. ;;;        (command "justifytext" ent1 "" "l")
  72. ;;;        )

  74.           (setq        cnt 1
  75.                 LOOP T
  76.           )
  77.           (setq el1 (entget ent1))
  78.           (while (and LOOP (<= cnt (strlen text)))


  81.             (if        (wcmatch (substr text cnt 5) "%%*")
  82.               (if (wcmatch (substr text cnt 5) "%%[0-9][0-9][0-9]")
  83.                 (setq step 5)
  84.                 (setq step 3)
  85.               )                                ;endif
  86.               (setq step 1)
  87.             )                                ;endif
  88.             (if        (= (substr text cnt 1) " ")
  89.               (progn
  90.                 (setq cnt1 1)
  91.                 (while (= (substr text (+ cnt cnt1) 1) " ")
  92.                   (setq step cnt1)
  93.                   (setq cnt1 (1+ cnt1))
  94.                 )
  95.               )
  96.             )
  97.             (setq ch (substr text cnt step))
  98.             (if        (= step 5)
  99.               (progn
  100.                 (setq chh ch)
  101.                 (setq cch (substr text cnt 4))
  102.                 (setq ch (substr text (+ cnt 4) 1))

  104.               )
  105.             )

  107.             (if        (= step 3)
  108.               (progn
  109.                 (setq chh ch)
  110.                 (setq cch (substr text cnt 2))
  111.                 (setq ch (substr text (+ cnt 2) 1))
  112.               )
  113.             )
  114.             (setq pdhz (ascii ch))
  115.             (if        (> pdhz 127)
  116.               (progn
  117.                 (setq step 2)
  118.                 (setq ch (substr text cnt step))
  119.                 ;(setq chh ch)
  120.               )
  121.                 ;(setq chh ch)
  122.             )
  123.             (setq cnt (+ cnt (1- step)))
  124.             (entmod (setq el1 (subst (cons 1 (substr text 1 cnt))
  125.                                      (assoc 1 el1)
  126.                                      el1
  127.                               )
  128.                     )
  129.             )
  130.             (if        (setq xx (CheckWidth ent1 pt))
  131.               (progn

  133.                 (entdel ent1)
  134.                 (if (or (= step 5) (= step 3))
  135.                   (progn
  136.                     (setq
  137.                       new_char (getstring T
  138.                                           (strcat "\n请输入新的字符 ["
  139.                                                   chh
  140.                                                   "<--"
  141.                                                   ch
  142.                                                   "]:"
  143.                                                  )
  144.                                )
  145.                     )
  146.                     (if        (/= new_char "")
  147.                       (setq new_char (strcat cch new_char))
  148.                     )
  149.                   )
  150.                   (setq
  151.                     new_char (getstring
  152.                                T
  153.                                (strcat "\n请输入新的字符 [" ch "]:")
  154.                              )
  155.                   )
  156.                 )
  157.                 (if (/= new_char "")
  158.                   (entmod
  159.                     (subst
  160.                       (cons 1
  161.                             (strcat (substr text 1 (- cnt step))
  162.                                     new_char
  163.                                     (substr text (1+ cnt))
  164.                             )
  165.                       )
  166.                       (assoc 1 el)
  167.                       el
  168.                     )
  169.                   )
  170.                 )
  171.                 (setq LOOP nil)
  172.               )
  173.             )                                ;endif
  174.             (setq cnt (1+ cnt))
  175.           )
  176.         )                                ;progn
  177.         (alert "所选实体类型不是“TEXT”！")
  178.       )                                        ;endif
  179.     )                                        ;progn
  180.     (princ "\nNo object selected!")
  181.   )                                        ;endif

  183.   (setq *error* olderr)                        ; Restore old *error* handler
  184.   (command "undo" "e")


  187. )

  189. ;;----------------------------------------
  190. (defun CheckWidth (textent selpt / );ll ur hbox)
  191.   (command "ucs" "Object" textent)
  192.   (setq selpt (trans selpt 0 1))
  193.   (setq        ll   (car (textbox (entget textent)))
  194.         ur   (cadr (textbox (entget textent)))
  195.         wid  (abs (- (car ur) (car ll)))
  196.         wid1 (abs (- (car selpt) (car ll)))
  197.         hbox (/ (PickBoxSize) 2.0)
  198.   )
  199.   (command "ucs" "p")
  200.   (if (> wid (- wid1 hbox))
  201.     T
  202.     nil
  203.   )
  204. )

  206. ;;----------------------------------------

  208. (defun PickBoxSize (/ SS VS PB SWP SHP AR WSD PPDU BOX)
  209.   (setq        SS   (getvar "SCREENSIZE")        ; screen size in pixels
  210.         VS   (getvar "VIEWSIZE")        ; screen height in drawing units
  211.         PB   (getvar "pickbox")                ; get current pickbox size
  212.         SWP  (car SS)                        ; width of screen in pixels
  213.         SHP  (cadr SS)                        ; height of screen in pixels
  214.         AR   (/ SWP SHP)                ; aspect ratio width/height
  215.         WSD  (* VS AR)                        ; width of screen dwg units = ratio timesheight
  216.         PPDU (/ WSD SWP)                ; pixels per drawing unit
  217.         BOX  (/ (* VS (* 2 PB)) SHP)        ; drawing units per pixel
  218.   )
  219. )


  222. ;;;V040901新增功能
  223. ;;;   1、可以直接从屏幕上点取要修改的字符，然后输入新的字符就自动完成修改。
  224. ;;;   2、下个版本将增加对%%特殊字符及双字节汉字的支持。

  226. ;;;V040921新增功能
  227. ;;;   1、增加对%%特殊字符的支持，但对上下标有时选不到上下标的字符，对加圈字符无效。
  228. ;;;   2、增加对双字节字符包括汉字的支持。
  229. ;;;   3、修正了有时会选取后面字符的错误。
  230. ;;;   4、下个版本将增加亮显程序取得的字符功能。



论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

urljit
发表于 2004-9-24 20:12:55 | 显示全部楼层
以下代码中，应该能实现亮显所选文字了
[PHP]
;;;       =======================================
;;;       |         屏幕文字自动修改软件        |
;;;       |          Update: 04.09.21           |
;;;       =======================================


(defun chgterr (s)
  (if (/= s "命令被取消")                ; If an error (such as CTRL-C) occurs
    (princ (strcat "\n错误: " s))        ; while this command is active...
  )
  (setvar "CMDECHO" 0)
  (command "undo" "e")
  (setq p nil)                                ; Free selection set
  (setq *error* olderr)                        ; Restore old *error* handler
  (princ)
)


;;;主程序

(defun C:PMGZ (/          olderr　*error*　oldEcho           sel
               pt          ent             el                text           ent1
               el1          LOOP             cnt        new_char   ch
               step          cnt1             chh        cch           pdhz
              )


  (command "undo" "be")
  (setq        olderr        *error*                        ; Initialize variables
        *error*        chgterr
  )

  (setvar "CMDECHO" 0)
  (command "ucs" "w")
  (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)
          )


;;;如果不是左对齐方式，改为左对齐方式(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)                ;更新字符串表
            )
          )
;;;R2004版改变字符对齐方式为左对齐。
;;;      (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))
            (if        (= step 5)
              (progn
                (setq chh ch)
                (setq cch (substr text cnt 4))
                (setq ch (substr text (+ cnt 4) 1))

              )
            )

            (if        (= step 3)
              (progn
                (setq chh ch)
                (setq cch (substr text cnt 2))
                (setq ch (substr text (+ cnt 2) 1))
              )
            )
            (setq pdhz (ascii ch))
            (if        (> pdhz 127)
              (progn
                (setq step 2)
                (setq ch (substr text cnt step))
                                        ;(setq chh ch)
              )
                                        ;(setq chh ch)
            )
            (setq cnt (+ cnt (1- step)))
            (entmod (setq el1 (subst (cons 1 (substr text 1 cnt))
                                     (assoc 1 el1)
                                     el1
                              )
                    )
            )
            (redraw (cdr(assoc -1 el)) 3)
            (if        (setq xx (CheckWidth ent1 pt))
              (progn

                (entdel ent1)
                (if (or (= step 5) (= step 3))
                  (progn
                    (setq
                      new_char (getstring T
                                          (strcat "\n请输入新的字符 ["
                                                  chh
                                                  "<--"
                                                  ch
                                                  "]:"
                                                 )
                               )
                    )
                    (if        (/= new_char "")
                      (setq new_char (strcat cch new_char))
                    )
                  )
                  (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 "所选实体类型不是“TEXT”！")
      )                                        ;endif
    )                                        ;progn
    (princ "\nNo object selected!")
  )                                        ;endif

  (setq *error* olderr)                        ; Restore old *error* handler
  (command "undo" "e")
  (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
  )
)

;;----------------------------------------

(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
  )
)


;;;V040901新增功能
;;;   1、可以直接从屏幕上点取要修改的字符，然后输入新的字符就自动完成修改。
;;;   2、下个版本将增加对%%特殊字符及双字节汉字的支持。

;;;V040921新增功能
;;;   1、增加对%%特殊字符的支持，但对上下标有时选不到上下标的字符，对加圈字符无效。
;;;   2、增加对双字节字符包括汉字的支持。
;;;   3、修正了有时会选取后面字符的错误。
;;;   4、下个版本将增加亮显程序取得的字符功能。
;;;----------------------------------------------------------------------------
(PRINC "\n  CHTXT  已加载。以PMGZ启动命令。")
(princ)


[/PHP]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

它山之石
发表于 2004-9-27 14:19:32 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
还是试试我的这个程序吧。
是改变颜色，醒目的不得了。


  3. ;;;       =======================================
  4. ;;;       |         屏幕文字自动修改软件        |
  5. ;;;       |          Update: 04.09.24           |
  6. ;;;       =======================================


  9. (defun chgterr (s)
  10.   (if (/= s "命令被取消")                ; If an error (such as CTRL-C) occurs
  11.     (princ (strcat "\n错误: " s))        ; while this command is active...
  12.   )
  13.   (setvar "CMDECHO" 0)
  14.   (command "undo" "e")
  15.   (setq p nil)                                ; Free selection set
  16.   (setq *error* olderr)                        ; Restore old *error* handler
  17.   (princ)
  18. )


  21. ;;;主程序

  23. (defun C:PMGZ (/          olderr　*error*　oldEcho           sel cloo cllo
  24.                pt          ent             el                text           ent1
  25.                el1          LOOP             cnt        new_char   ch
  26.                step          cnt1             chh        cch           pdhz
  27.               )
  28.   (princ (strcat "\n***屏幕字符自动修改软件V040924  ***"))
  29.   (princ)

  31.   (command "undo" "be")
  32.   (setq        olderr        *error*                        ; Initialize variables
  33.         *error*        chgterr
  34.   )
  35.   (setq ucskg (getvar "ucsicon"))
  36.   (setvar "CMDECHO" 0)
  37.   (command "ucs" "w")
  38.   (if (setq sel (entsel "\n点取要修改的字符<退出>："))
  39.     (progn
  40.       (setq pt        (cadr sel)
  41.             ent        (car sel)
  42.       )
  43.       (if (= (cdr (assoc 0 (setq el (entget ent)))) "TEXT")
  44.         (progn

  46.           (setq text (cdr (assoc 1 el)))
  47.           (entmake el)
  48.           (setq        ent1 (entlast)
  49.                 el1  (entget ent1)
  50.           )

  52. ;;;测试修改颜色，如何得到随层的颜色号？

  54.           (if (setq cllo (assoc 62 el1))
  55.               (setq cloo (cdr cllo))
  56.                (setq cloo (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 el1))))))
  57.            )

  59.   (if clo
  60.     (setq clo clo)
  61.     (setq clo cloo)

  63.   )
  64.             (setq clo (+ 1 clo))
  65.             (if (= clo cloo) (setq clo (+ clo 1)))

  67. (while (or (>= clo 7)(<= clo 0))

  69.             (if (>= clo 7) (setq clo (- clo 7)))
  70.             (if (<= clo 0)(setq clo (+ cloo 1)))
  71.             (if (= clo cloo) (setq clo (+ clo 1)))

  73. )

  75.           (command "change" ent1 "" "p" "c" clo "")



  79.           (setvar "ucsicon" 0)

  81. ;;;如果不是左对齐方式，改为左对齐方式(FOR R14)          
  82.           (setq dq1 (setq dqb1 (assoc 72 el1)))
  83.           (setq dq2 (setq dqb2 (assoc 73 el1)))
  84.           (if (/= dq1 0)
  85.             (progn
  86.               (setq p11 (assoc 11 el1))        ;p11---对齐点表
  87.               (setq p11b '(0.0 0.0 0.0)) ;p11b---对齐点坐标
  88.               (setq el1 (subst (cons 11 p11b) p11 el1)) ;置换对齐点表
  89.               (setq dq 0)                ;设定对齐方式为左侧对齐
  90.               (setq el1 (subst (cons 72 dq) dqb1 el1)) ;置换对齐方式表
  91.               (if (/= dq2 0)
  92.                 (setq el1 (subst (cons 73 dq) dqb2 el1))
  93.               )                                ;置换对齐方式表
  94.               (entmod el1)                ;更新字符串表
  95.             )
  96.           )
  97. ;;;R2004版改变字符对齐方式为左对齐。
  98. ;;;      (if (or (/= (cdr (assoc 72 el1)) 0)
  99. ;;;         (/= (cdr (assoc 73 el1)) 0)
  100. ;;;          )
  101. ;;;        (command "justifytext" ent1 "" "l")
  102. ;;;        )

  104.           (setq        cnt 1
  105.                 LOOP T
  106.           )
  107.           (setq el1 (entget ent1))
  108.           (while (and LOOP (<= cnt (strlen text)))


  111.             (if        (wcmatch (substr text cnt 5) "%%*")
  112.               (if (wcmatch (substr text cnt 5) "%%[0-9][0-9][0-9]")
  113.                 (setq step 5)
  114.                 (setq step 3)
  115.               )                                ;endif
  116.               (setq step 1)
  117.             )                                ;endif
  118.             (if        (= (substr text cnt 1) " ")
  119.               (progn
  120.                 (setq cnt1 1)
  121.                 (while (= (substr text (+ cnt cnt1) 1) " ")
  122.                   (setq step cnt1)
  123.                   (setq cnt1 (1+ cnt1))
  124.                 )
  125.               )
  126.             )
  127.             (setq ch (substr text cnt step))
  128.             (if        (= step 5)
  129.               (progn
  130.                 (setq chh ch)
  131.                 (setq cch (substr text cnt 4))
  132.                 (setq ch (substr text (+ cnt 4) 1))

  134.               )
  135.             )

  137.             (if        (= step 3)
  138.               (progn
  139.                 (setq chh ch)
  140.                 (setq cch (substr text cnt 2))
  141.                 (setq ch (substr text (+ cnt 2) 1))
  142.               )
  143.             )
  144.             (setq pdhz (ascii ch))
  145.             (if        (> pdhz 127)
  146.               (progn
  147.                 (setq step 2)
  148.                 (setq ch (substr text cnt step))
  149.                 ;(setq chh ch)
  150.               )
  151.                 ;(setq chh ch)
  152.             )
  153.             (setq cnt (+ cnt (1- step)))
  154.             (entmod (setq el1 (subst (cons 1 (substr text 1 cnt))
  155.                                      (assoc 1 el1)
  156.                                      el1
  157.                               )
  158.                     )
  159.             )

  161.             (if        (CheckWidth ent1 pt)
  162.               (progn

  164. ;;;将字符串改为右对齐，以保证取得的字符位置不变。
  165.   (setq dq (cdr (setq dqb (assoc 72 el1)))) ; dq---对齐方式;dqb---对齐方式表
  166.   (setq zfang (cdr (assoc 50 el1)))        ;zfang---字符角度
  167.   (setq p11 (assoc 11 el1))                ;p11---对齐点表
  168.   (setq p10b (cdr (setq p10 (assoc 10 el1)))) ;p10---位置点表 ;p10b---位置点坐标
  169.   (setq el1 (subst (cons 11 p10b) p11 el1)) ;用位置点替换对齐点并置换对齐点表
  170.   (setq dq 2)                                ;设定对齐方式为右侧对齐

  172.   (setq el1 (subst (cons 72 dq) dqb el1)) ;置换对齐方式表

  174.   (entmod el1)                                ;更新字符串表

  176.   (setq el1 (entget ent1))                ;由实体名重新获得字符串实体表
  177.   (setq p10b (cdr (setq p10 (assoc 10 el1)))) ;p10b---位置点坐标
  178.   (setq p11b (cdr (setq p11 (assoc 11 el1)))) ;p11b---对齐点坐标
  179.   (setq pl (distance p11b P10b))        ;pl---位置点与对齐点间距离
  180.   (setq p11b (polar p11b zfang pl))        ;得到新的对齐点坐标
  181.   (setq el1 (subst (cons 11 p11b) p11 el1)) ;置换对齐点表
  182.   (entmod el1)               

  184.                 (if (or (= step 5) (= step 3))
  185.                     (setq xszf chh )
  186.                     (setq xszf ch )

  188.                 )
  189.             (entmod (setq el1 (subst (cons 1 xszf)
  190.                                      (assoc 1 el1)
  191.                                      el1
  192.                               )
  193.                     )

  195.             )


  198.                 (setvar "ucsicon" ucskg)
  199. ;                (entdel ent1)
  200.                 (if (or (= step 5) (= step 3))
  201.                   (progn
  202.                     (setq
  203.                       new_char (getstring T
  204.                                           (strcat "\n请输入新的字符 ["
  205.                                                   chh
  206.                                                   "<--"
  207.                                                   ch
  208.                                                   "]:"
  209.                                                  )
  210.                                )
  211.                     )
  212.                     (if        (/= new_char "")
  213.                       (setq new_char (strcat cch new_char))
  214.                     )
  215.                   )
  216.                   (setq
  217.                     new_char (getstring
  218.                                T
  219.                                (strcat "\n请输入新的字符 [" ch "]:")
  220.                              )
  221.                   )
  222.                 )
  223.                 (entdel ent1)

  225.                 (if (/= new_char "")

  227.                   (entmod
  228.                     (subst
  229.                       (cons 1
  230.                             (strcat (substr text 1 (- cnt step))
  231.                                     new_char
  232.                                     (substr text (1+ cnt))
  233.                             )
  234.                       )
  235.                       (assoc 1 el)
  236.                       el
  237.                     )
  238.                   )
  239.                 )
  240.                 (setq LOOP nil)
  241.               )
  242.             )                                ;endif
  243.             (setq cnt (1+ cnt))
  244.           )
  245.         )                                ;progn
  246.         (alert "所选实体类型不是“TEXT”！")
  247.       )                                        ;endif
  248.     )                                        ;progn
  249.     (princ "\nNo object selected!")
  250.   )                                        ;endif


  253.   (setq *error* olderr)                        ; Restore old *error* handler
  254.   (command "undo" "e")

  256.   (princ (strcat "\n***屏幕字符自动修改软件V040924 ***"))
  257. (princ)
  258. )
  259. ;;----------------------------------------
  260. (defun CheckWidth (textent selpt / ll ur hbox)
  261.   (command "ucs" "Object" textent)
  262.   (setq selpt (trans selpt 0 1))
  263.   (setq        ll   (car (textbox (entget textent)))
  264.         ur   (cadr (textbox (entget textent)))
  265.         wid  (abs (- (car ur) (car ll)))
  266.         wid1 (abs (- (car selpt) (car ll)))
  267.         hbox (/ (PickBoxSize) 2.0)
  268.   )
  269.   (command "ucs" "p")
  270.   (if (> wid (- wid1 hbox))
  271.     T
  272.     nil
  273.   )
  274. )


  277. (defun PickBoxSize (/ SS VS PB SWP SHP AR WSD PPDU BOX)
  278.   (setq        SS   (getvar "SCREENSIZE")        ; screen size in pixels
  279.         VS   (getvar "VIEWSIZE")        ; screen height in drawing units
  280.         PB   (getvar "pickbox")                ; get current pickbox size
  281.         SWP  (car SS)                        ; width of screen in pixels
  282.         SHP  (cadr SS)                        ; height of screen in pixels
  283.         AR   (/ SWP SHP)                ; aspect ratio width/height
  284.         WSD  (* VS AR)                        ; width of screen dwg units = ratio timesheight
  285.         PPDU (/ WSD SWP)                ; pixels per drawing unit
  286.         BOX  (/ (* VS (* 2 PB)) SHP)        ; drawing units per pixel
  287.   )
  288. )


  291. ;;;V040901新增程序
  292. ;;;   1、可以直接从屏幕上点取要修改的字符，然后输入新的字符就自动完成修改。
  293. ;;;   2、下个版本将增加对%%特殊字符及双字节汉字的支持。

  295. ;;;V040921新增功能
  296. ;;;   1、增加对%%特殊字符的支持，但对上下标有时选不到上下标的字符，对加圈字符无效。
  297. ;;;   2、增加对双字节字符（包括汉字）的支持。
  298. ;;;   3、修正了有时会选取后面字符的错误。
  299. ;;;   4、程序运行时将坐标系图标关闭，以防止更改坐系时的闪烁现象。
  300. ;;;   5、增加了一步回退功能。
  301. ;;;   6、修正了字符串内包含空格时无法正确得到所需字符的错误。
  302. ;;;   7、下个版本将增加亮显程序取得的字符功能。

  304. ;;;V040924新增功能
  305. ;;;   1、增加亮显程序取得的字符功能。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

urljit
发表于 2004-9-29 13:42:37 | 显示全部楼层
楼上的朋友，你的程序在我这里既没亮显也没变色，是不是我的机器有问题？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

lsjjm
发表于 2004-9-30 11:22:27 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
19楼的程序不能亮显
20楼的程序不亮显也不变色
另外: 程序不用那么繁琐吧? VLISP会更简单.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xxb8601
发表于 2004-9-30 20:45:55 | 显示全部楼层
我用了20楼的，很好
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

urljit
发表于 2004-10-3 08:45:16 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
(redraw (cdr(assoc -1 el)) 3) 就是亮显的语句，可能位置不合适？或再增加？在我的机器上运行正常呀？等我回头再试试吧。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

它山之石
发表于 2004-10-5 16:03:15 | 显示全部楼层
　　我程序是为R14写的。主要是改色前要将字符改为右对齐并保持位置不变。所以略费了些周折。在2004中只用一句就可以了。
　　我在自己的机器上R14用的很正常，真的会变换不同的颜色，很好玩的。但没在更高版本上测试。
　　等有时间我会做个FLASH演示给大家看看。
　　下个版本将增加对上下标及加圈字符的支持。另外本版本在改变%%字符时只需要改变最后一个字符即可，事实上大多数使用时都是如此。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

urljit
发表于 2004-10-15 21:57:27 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
诸位，能否在此基础上增加对话框功能，即：让选中的字符在对话框里面被选取。如图
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

它山之石
发表于 2004-10-25 09:18:38 | 显示全部楼层
　　倒是个好建议，只是我觉得有点“简单问题复杂化了”。我们编程的目的就是加快制图速度，用对话框就慢了。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

urljit
发表于 2004-10-25 11:52:47 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
楼上的，我觉得相反，如果按照我说的那个方法，岂不是可以马上改那个字符了吗？看看程序的执行过程：命令，回车，选择（对准位置），键入新内容，回车。ok了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

swaywood
发表于 2004-10-25 21:09:35 | 显示全部楼层
最初由 urljit 发布
[B]诸位，能否在此基础上增加对话框功能，即：让选中的字符在对话框里面被选取。如图 [/B]

如果那个“i”是你自己选中的倒可以，如果是lisp程序选中的，不可能

复20楼

我在2004上可以正常运行
另外我有一个建议，通常在改文字时可能会改的字不止一个字，能否做到让两个字变色？从而被替换 ？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

urljit
发表于 2004-10-25 21:23:38 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最初由 swaywood 发布
[B]
如果那个“i”是你自己选中的倒可以，如果是lisp程序选中的，不可能

复20?.. [/B]


为什么不可能？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

下一页 »
1234下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-5-11 00:18 , Processed in 0.455696 second(s), 53 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表