我想加谁，我就左击谁；我想减谁，我就右击谁；我想退出

/db_自贡黄明儒_ · 发表于 2013-12-17 16:48:36

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

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

×

我想加谁，我就左击谁；我想减谁，我就右击谁；我想退出，我就击改变不了的字符。
密切注视eachy和st788796的帖子，st788796说这个功能可以有，但只见楼梯响，不见人下来，自己搞了一个，又不太理想.

(defun C:SBJJ (/ CHANGESTR+ CHANGESTR- EN H LENLIST PT PTT SCL STY X XLIST Y)
;;1 击鼠标左右键时执行
;;Flag(T,左击；nil右击)
(defun leftPick (e pt Flag / EN H PT1 SCL STR STY X Y)
(set 'en (entget e))
(mapcar '(lambda (x y) (set y (cdr (assoc x en))))
(list 7 1 40 41)
(list 'sty 'str 'h 'scl)
)
(setq pt (trans pt 1 0)) ;wcs
(cond ((equal (cdr (assoc 0 en)) "TEXT")
(vl-cmdf "_.ucs" "OB" e) ;转到对象坐标系
(setq pt1 (trans pt 0 1)) ;当前ucs
(vl-cmdf "_.ucs" "_p") ;恢复ucs
(TextleftPick e en sty str h scl pt1 T Flag)
)
(T (MTextleftPick e en sty h scl pt Flag))
)
)
;;2 多行文本变化
(defun MTextleftPick
(e en sty h scl pt Flag / 4P E1 EN1 I N NEWSTR PT1 SS STR1 STR2 Flag1)
(vla-copy (vlax-ename->vla-object e))
(vl-cmdf "_.explode" (entlast))
(setq ss (ssget "_P"))
(setq NewStr "")
(setq i 0)
(repeat (setq n (sslength ss))
(setq e1 (ssname ss i))
(setq en1 (entget e1))
(setq str1 (cdr (assoc 1 en1)))
(vl-cmdf "_.ucs" "OB" e1) ;转到对象坐标系
(setq pt1 (trans pt 0 1)) ;当前ucs
(setq 4p (HH:Text4p sty str1 h 1))
(vl-cmdf "_.ucs" "_p") ;恢复ucs
(if (HH:PtInPts 4p pt1)
(if (setq str2 (TextleftPick e1 en1 sty str1 h 1 pt1 nil Flag))
(setq NewStr (strcat NewStr str2 "\\P"))
(setq Flag1 T)
)
(if (equal (1- n) i)
(setq NewStr (strcat NewStr str1))
(setq NewStr (strcat NewStr str1 "\\P"))
)
)
(setq i (1+ i))
)
(vl-cmdf "_.erase" ss "")
(if Flag1
nil
(entmod (subst (cons 1 NewStr) (assoc 1 en) en))
)
)
;;3 单行文本变化
;;Flag1(T,entmod en;nil str更新后的内容)
;;Left(T,左击,执行ChangeStr+;nil,右击,执行ChangeStr-)
(defun TextleftPick (e en sty str h scl pt Flag1 Left / DO
FLAG H LENLIST N NEWSTR PTX SCL SINCHR
STR1 STY X XLIST
)
(setq SinChr (XD::String:SingleChr str))
(setq xlist "")
(mapcar '(lambda (x)
(setq xlist (strcat xlist x))
(setq LenList (cons (XD::String:Len sty xlist h scl) LenList))
)
SinChr
)
(setq ptx (car pt))
(setq Flag T
n 0
)
(while Flag
(if (< (car LenList) ptx)
(setq Flag nil)
(setq LenList (cdr LenList))
)
(setq n (1+ n))
)
(setq n (1+ (- (length SinChr) n))) ;点取的是n+1
(setq NewStr "")
(repeat n
(setq NewStr (strcat NewStr (car SinChr)))
(setq SinChr (cdr SinChr))
)
(if Left
(setq do ChangeStr+)
(setq do ChangeStr-)
)
(if (setq str1 (do (car SinChr)))
(progn
(setq NewStr (strcat NewStr str1))
(setq SinChr (cdr SinChr))
(while SinChr
(setq NewStr (strcat NewStr (car SinChr)))
(setq SinChr (cdr SinChr))
)
(if flag1
(entmod (subst (cons 1 NewStr) (assoc 1 en) en))
NewStr
)
)
)
)
;;4 + 左击时
(defun ChangeStr+ (str / S STR1 STR2 STR3 STR4 STR5)
(setq str1 (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
(setq str2 (list "零" "壹" "贰" "叁" "伍" "陆" "柒" "捌" "玖" "拾"))
(setq str3 (list "０" 　 "一" "二" "三" "四" "五" "六" "七" "八" "九" "十"))
(setq str4 (list "㈠" "㈡" "㈢" "㈣" "㈤" "㈥" "㈦" "㈧" "㈨" "㈩"))
(setq str5 (list "①" "②" "③" "④" "⑤" "⑥" "⑦" "⑧" "⑨" "⑩"))
(cond ((setq s (member str str1)) (memstr s str1))
((and (> (ascii str) 64) (< (ascii str) 91))
(cond ((equal (ascii str) 90) "A")
(T (chr (1+ (ascii str))))
)
)
((and (> (ascii str) 96) (< (ascii str) 123))
(cond ((equal (ascii str) 122) "a")
(T (chr (1+ (ascii str))))
)
)
((setq s (member str str2)) (memstr s str2))
((setq s (member str str3)) (memstr s str3))
((setq s (member str str4)) (memstr s str4))
((setq s (member str str5)) (memstr s str5))
)
)
;;5
(defun memstr (s str1)
(if (= (length s) 1)
(car str1)
(cadr s)
)
)
;;6 - 右击时
(defun ChangeStr- (str / S STR1 STR2 STR3 STR4 STR5)
(setq str1 (list "9" "8" "7" "6" "5" "4" "3" "2" "1" "0"))
(setq str2 (list "拾" "玖" "捌" "柒" "陆" "伍" "叁" "贰" "壹" "零"))
(setq str3 (list "十" "九" "八" "七" "六" "五" "四" "三" "二" "一" "０"))
(setq str4 (list "㈩" "㈨" "㈧" "㈦" "㈥" "㈤" "㈣" "㈢" "㈡" "㈠"))
(setq str5 (list "⑩" "⑨" "⑧" "⑦" "⑥" "⑤" "④" "③" "②" "①"))
(cond ((setq s (member str str1)) (memstr s str1))
((and (> (ascii str) 64) (< (ascii str) 91))
(cond ((equal (ascii str) 65) "Z")
(T (chr (1- (ascii str))))
)
)
((and (> (ascii str) 96) (< (ascii str) 123))
(cond ((equal (ascii str) 97) "z")
(T (chr (1+ (ascii str))))
)
)
((setq s (member str str2)) (memstr s str2))
((setq s (member str str3)) (memstr s str3))
((setq s (member str str4)) (memstr s str4))
((setq s (member str str5)) (memstr s str5))
)
)
;;7 本程序主程序
(princ "\n请点选要修改的字符:(左键+1右键-1)")
(while
(cond ((and (setq pt (grread t 4 2)) ;获取grread值
(equal (car pt) 5)
)
(progn
(setq ptt (cadr pt)
en (nentselp ptt)
)
t
)
)
((and (equal (car pt) 3) en (ssget (cadr en) '((0 . "*TEXT")))) ;3为左键
(leftPick (car en) (cadr en) T)
)
((and (or (equal (car pt) 11) (equal (car pt) 25))
en
(ssget (cadr en) '((0 . "*TEXT")))
) ;右键
(leftPick (car en) (cadr en) nil)
)
)
)
(princ)
)
;;pt是否在点集内
(defun HH:PtInPts (Pts pt / COUNT PTS1 VA X Y)
(setq Count 0)
(setq Pts1 (append (cdr Pts) (list (car Pts))))
(mapcar '(lambda (x y)
(setq va (- (angle pt x) (angle pt y)))
(cond ((> va pi) (setq va (- va pi)))
((< va (* -1 pi)) (setq va (+ va pi)))
)
(setq Count (+ Count va))
)
Pts
Pts1
)
(< (abs (- (abs Count) pi)) 0.000001)
)
;;text四角点
;;(HH:PtInPts (HH:Text4p sty str h scl) pt);返回pt是否在text内
(defun HH:Text4p (sty str h scl / P1 P2 P3 P4)
(and (or (not sty)
(= sty "")
(not (tblsearch "style" sty))
)
(setq sty (getvar "textstyle"))
)
(setq p1 (textbox (list (cons 1 str) (cons 7 sty) (cons 40 h) (cons 41 scl))))
(setq p3 (cadr p1))
(setq p1 (car p1))
(setq p2 (list (car p1) (cadr p3)))
(setq p4 (list (car p3) (cadr p1)))
(list p1 p2 p3 p4)
)

(defun C:SBJJ (/ CHANGESTR+ CHANGESTR- EN H LENLIST PT PTT SCL STY X XLIST Y) 
   
  ;;1 击鼠标左右键时执行 
  ;;Flag(T,左击；nil右击) 
  (defun leftPick (e pt Flag / EN H PT1 SCL STR STY X Y) 
    (set 'en (entget e)) 
    (mapcar '(lambda (x y) (set y (cdr (assoc x en)))) 
            (list 7 1 40 41) 
            (list 'sty 'str 'h 'scl) 
    ) 
    (setq pt (trans pt 1 0))                                    ;wcs 
    (cond ((equal (cdr (assoc 0 en)) "TEXT") 
           (vl-cmdf "_.ucs" "OB" e)                            ;转到对象坐标系 
           (setq pt1 (trans pt 0 1))                            ;当前ucs 
           (vl-cmdf "_.ucs" "_p")                            ;恢复ucs 
           (TextleftPick e en sty str h scl pt1 T Flag) 
          ) 
          (T (MTextleftPick e en sty h scl pt Flag)) 
    ) 
  ) 
  ;;2 多行文本变化 
  (defun MTextleftPick 
         (e en sty h scl pt Flag / 4P E1 EN1 I N NEWSTR PT1 SS STR1 STR2 Flag1) 
    (vla-copy (vlax-ename->vla-object e)) 
    (vl-cmdf "_.explode" (entlast)) 
    (setq ss (ssget "_P")) 
    (setq NewStr "") 
    (setq i 0) 
    (repeat (setq n (sslength ss)) 
      (setq e1 (ssname ss i)) 
      (setq en1 (entget e1)) 
      (setq str1 (cdr (assoc 1 en1))) 
      (vl-cmdf "_.ucs" "OB" e1)                                    ;转到对象坐标系 
      (setq pt1 (trans pt 0 1))                                    ;当前ucs    
      (setq 4p (HH:Text4p sty str1 h 1)) 
      (vl-cmdf "_.ucs" "_p")                                    ;恢复ucs    
      (if (HH:PtInPts 4p pt1) 
        (if (setq str2 (TextleftPick e1 en1 sty str1 h 1 pt1 nil Flag)) 
          (setq NewStr (strcat NewStr str2 "\\P")) 
          (setq Flag1 T) 
        ) 
        (if (equal (1- n) i) 
          (setq NewStr (strcat NewStr str1)) 
          (setq NewStr (strcat NewStr str1 "\\P")) 
        ) 
      ) 
      (setq i (1+ i)) 
    ) 
    (vl-cmdf "_.erase" ss "") 
    (if        Flag1 
      nil 
      (entmod (subst (cons 1 NewStr) (assoc 1 en) en)) 
    ) 
  ) 
  ;;3 单行文本变化 
  ;;Flag1(T,entmod en;nil str更新后的内容) 
  ;;Left(T,左击,执行ChangeStr+;nil,右击,执行ChangeStr-) 
  (defun TextleftPick (e     en           sty         str   h     scl   pt         Flag1 Left  /           DO 
                       FLAG  H           LENLIST     N     NEWSTR         PTX   SCL   SINCHR 
                       STR1  STY   X         XLIST 
                      ) 
    (setq SinChr (XD::String:SingleChr str)) 
    (setq xlist "") 
    (mapcar '(lambda (x) 
               (setq xlist (strcat xlist x)) 
               (setq LenList (cons (XD::String:Len sty xlist h scl) LenList)) 
             ) 
            SinChr 
    ) 
    (setq ptx (car pt)) 
    (setq Flag T 
          n 0 
    ) 
    (while Flag 
      (if (< (car LenList) ptx) 
        (setq Flag nil) 
        (setq LenList (cdr LenList)) 
      ) 
      (setq n (1+ n)) 
    ) 
    (setq n (1+ (- (length SinChr) n)))                            ;点取的是n+1 
    (setq NewStr "") 
    (repeat n 
      (setq NewStr (strcat NewStr (car SinChr))) 
      (setq SinChr (cdr SinChr)) 
    ) 
    (if        Left 
      (setq do ChangeStr+) 
      (setq do ChangeStr-) 
    ) 
    (if        (setq str1 (do (car SinChr))) 
      (progn 
        (setq NewStr (strcat NewStr str1)) 
        (setq SinChr (cdr SinChr)) 
        (while SinChr 
          (setq NewStr (strcat NewStr (car SinChr))) 
          (setq SinChr (cdr SinChr)) 
        ) 
        (if flag1 
          (entmod (subst (cons 1 NewStr) (assoc 1 en) en)) 
          NewStr 
        ) 
      ) 
    ) 
  ) 
  ;;4 + 左击时 
  (defun ChangeStr+ (str / S STR1 STR2 STR3 STR4 STR5) 
    (setq str1 (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")) 
    (setq str2 (list "零" "壹" "贰" "叁" "伍" "陆" "柒" "捌" "玖" "拾")) 
    (setq str3 (list "０" 　 "一" "二" "三" "四" "五" "六" "七" "八" "九" "十")) 
    (setq str4 (list "㈠" "㈡" "㈢" "㈣" "㈤" "㈥" "㈦" "㈧" "㈨" "㈩")) 
    (setq str5 (list "①" "②" "③" "④" "⑤" "⑥" "⑦" "⑧" "⑨" "⑩")) 
    (cond ((setq s (member str str1)) (memstr s str1)) 
          ((and (> (ascii str) 64) (< (ascii str) 91)) 
           (cond ((equal (ascii str) 90) "A") 
                 (T (chr (1+ (ascii str)))) 
           ) 
          ) 
          ((and (> (ascii str) 96) (< (ascii str) 123)) 
           (cond ((equal (ascii str) 122) "a") 
                 (T (chr (1+ (ascii str)))) 
           ) 
          ) 
          ((setq s (member str str2)) (memstr s str2)) 
          ((setq s (member str str3)) (memstr s str3)) 
          ((setq s (member str str4)) (memstr s str4)) 
          ((setq s (member str str5)) (memstr s str5)) 
    ) 
  ) 
  ;;5 
  (defun memstr        (s str1) 
    (if        (= (length s) 1) 
      (car str1) 
      (cadr s) 
    ) 
  )   
  ;;6 - 右击时 
  (defun ChangeStr- (str / S STR1 STR2 STR3 STR4 STR5) 
    (setq str1 (list "9" "8" "7" "6" "5" "4" "3" "2" "1" "0")) 
    (setq str2 (list "拾" "玖" "捌" "柒" "陆" "伍" "叁" "贰" "壹" "零")) 
    (setq str3 (list "十" "九" "八" "七" "六" "五" "四" "三" "二" "一" "０")) 
    (setq str4 (list "㈩" "㈨" "㈧" "㈦" "㈥" "㈤" "㈣" "㈢" "㈡" "㈠")) 
    (setq str5 (list "⑩" "⑨" "⑧" "⑦" "⑥" "⑤" "④" "③" "②" "①")) 
    (cond ((setq s (member str str1)) (memstr s str1)) 
          ((and (> (ascii str) 64) (< (ascii str) 91)) 
           (cond ((equal (ascii str) 65) "Z") 
                 (T (chr (1- (ascii str)))) 
           ) 
          ) 
          ((and (> (ascii str) 96) (< (ascii str) 123)) 
           (cond ((equal (ascii str) 97) "z") 
                 (T (chr (1+ (ascii str)))) 
           ) 
          ) 
          ((setq s (member str str2)) (memstr s str2)) 
          ((setq s (member str str3)) (memstr s str3)) 
          ((setq s (member str str4)) (memstr s str4)) 
          ((setq s (member str str5)) (memstr s str5)) 
    ) 
  ) 
  ;;7 本程序主程序   
  (princ "\n请点选要修改的字符:(左键+1右键-1)") 
  (while 
    (cond ((and        (setq pt (grread t 4 2))                    ;获取grread值 
                (equal (car pt) 5) 
           ) 
           (progn 
             (setq ptt (cadr pt) 
                   en  (nentselp ptt) 
             ) 
             t 
           ) 
          ) 
          ((and (equal (car pt) 3) en (ssget (cadr en) '((0 . "*TEXT")))) ;3为左键 
           (leftPick (car en) (cadr en) T) 
          ) 
          ((and        (or (equal (car pt) 11) (equal (car pt) 25)) 
                en 
                (ssget (cadr en) '((0 . "*TEXT"))) 
           )                                                    ;右键 
           (leftPick (car en) (cadr en) nil) 
          ) 
    ) 
  )   
  (princ) 
) 
 
;;pt是否在点集内 
(defun HH:PtInPts (Pts pt / COUNT PTS1 VA X Y) 
  (setq Count 0) 
  (setq Pts1 (append (cdr Pts) (list (car Pts)))) 
  (mapcar '(lambda (x y) 
             (setq va (- (angle pt x) (angle pt y))) 
             (cond ((> va pi) (setq va (- va pi))) 
                   ((< va (* -1 pi)) (setq va (+ va pi))) 
             ) 
             (setq Count (+ Count va)) 
           ) 
          Pts 
          Pts1 
  ) 
  (< (abs (- (abs Count) pi)) 0.000001) 
) 
;;text四角点 
;;(HH:PtInPts (HH:Text4p sty str h scl)  pt);返回pt是否在text内 
(defun HH:Text4p (sty str h scl / P1 P2 P3 P4) 
  (and (or (not sty) 
           (= sty "") 
           (not (tblsearch "style" sty)) 
       ) 
       (setq sty (getvar "textstyle")) 
  ) 
  (setq p1 (textbox (list (cons 1 str) (cons 7 sty) (cons 40 h) (cons 41 scl)))) 
  (setq p3 (cadr p1)) 
  (setq p1 (car p1)) 
  (setq p2 (list (car p1) (cadr p3))) 
  (setq p4 (list (car p3) (cadr p1))) 
  (list p1 p2 p3 p4) 
)

st788796 · 发表于 2013-12-17 17:08:05

涉及到里面的多个相同字符的定位，XD::Text:StringBetween可能要改造一下，返回多个时的position及字串

/db_自贡黄明儒_ · 发表于 2013-12-17 18:20:04

st788796 发表于 2013-12-17 17:08
涉及到里面的多个相同字符的定位，XD::Text:StringBetween可能要改造一下，返回多个时的position及字串

与相同字符没有关系，我是每个字符都计算长度了的。问题是你的那个预测文本长度，不知是我使用不灵，还是本来对汉字长度测不准？

st788796 · 发表于 2013-12-18 07:03:42

/db_自贡黄明儒_ 发表于 2013-12-17 18:20
与相同字符没有关系，我是每个字符都计算长度了的。问题是你的那个预测文本长度，不知是我使用不灵，还是 ...

比如文本中有三个 1 ，点击了中间的 1，这时替换时要给起始位置才能替换中间的

/db_自贡黄明儒_ · 发表于 2013-12-18 08:16:39

st788796 发表于 2013-12-18 07:03
比如文本中有三个 1 ，点击了中间的 1，这时替换时要给起始位置才能替换中间的

对于三个111，本程序是可以判断的。关键是汉字长度测不准

st788796 · 发表于 2013-12-18 13:31:16

/db_自贡黄明儒_ 发表于 2013-12-18 08:16
对于三个111，本程序是可以判断的。关键是汉字长度测不准

这个还要考虑进位吧

sicky111 · 发表于 2013-12-18 22:05:34

跟两位大师一起学习。

cjrun · 发表于 2014-1-1 21:39:50

汉字宽度与字体也有关系，中英混排再加上符号，确实很难测准！不知道版主大大有没有好的方法！？

拉契 · 发表于 2014-3-20 11:08:21

XD::String:SingleChr
http://bbs.xdcad.net/forum.php?m ... sortid%26sortid%3D1

XD::String:Len
http://bbs.xdcad.net/forum.php?mod=viewthread&tid=671081
命令: ; 错误: 参数太多这是怎么回事？

lucas3 · 发表于 2014-3-20 17:04:46

拉契发表于 2014-3-20 11:08
XD::String:SingleChr
http://bbs.xdcad.net/forum.php?mod=viewthread&tid=672036&extra=page%3D1%26filt ...

我这里也是，黄大师解释一下呀！

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

[研讨] 我想加谁，我就左击谁；我想减谁，我就右击谁；我想退出

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

点评

点评

点评

点评

点评