明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 19126|回复: 201

请高手帮忙修改一下源代码(文字打断)

  [复制链接]
发表于 2012-4-30 12:18 | 显示全部楼层 |阅读模式
本帖最后由 sz721 于 2012-4-30 16:33 编辑

这是一段日本网站下载的文字打断源代码。功能:把单行文字在任意位置分割成两行(使用A和D键用于动态切换位置)。在测试纯数字时没有问题,但是用于中文字就不行了,会出现乱码现象。我想应该是日文字符的全角半角字符长度和中文字符的不同。请高手修改一下代码,谢谢!

  1. (defun c:dd1 ( / ObjName ObjType)
  2.   (princ "\n 把单行文字列在任意位置分割成两行(A和D键用于切换位置)")
  3. (setq *error* *myerror*)   
  4. (setq AcadVersion (getvar "acadver"))
  5. (princ "\n AcadVersion :  ")(princ AcadVersion)
  6. (while (null ObjName)
  7.   (setvar "ERRNO" 0)
  8.   (setq ObjName (car (entsel)))
  9.   (if ObjName (setq ObjType (cdr(assoc 0 (entget ObjName)))))
  10.   (cond ((= (getvar "ERRNO") 52) (exit))
  11.     ((= ObjType "TEXT")(Procedure_814))
  12.     ((/= ObjType "TEXT")(setq ObjName nil))
  13.   )
  14. )
  15. (setq *error* nil)
  16. (princ)
  17. )
  18. (defun Procedure_814()
  19. (princ "\n [A] [D] 键、改变分割移动的位置")
  20. (setq Data1 (entget ObjName))
  21. (entdel ObjName)
  22. (setq Contents (cdr (assoc 1 Data1)))
  23. (setq TextH (cdr (assoc 40 Data1)))
  24. (setq Ang (cdr (assoc 50 Data1)))
  25. (setq ContentsL (StringToList Contents))
  26. (setq Len (length ContentsL))
  27. (if (and (= (cdr (assoc 72 Data1)) 0)(= (cdr (assoc 73 Data1)) 0)) (setq Co 10)(setq Co 11))
  28. (setq Loc1 (cdr (assoc Co Data1)))
  29. (setq Delta (SD8446 (list  0 (* -1.2 TextH)) '(0 0) Ang))
  30. (setq SPt (fix (* 0.5 Len)))
  31. (setq SepL (ListSeparate ContentsL SPt))
  32. (setq StrL (mapcar 'ListToString SepL))
  33. (setq Data1 (subst (cons 1 (car StrL))(assoc 1 Data1) Data1))
  34. (if (entmake Data1)(setq ObjName1 (entlast)))
  35. (setq Data2 (subst (cons  1 (cadr StrL))(assoc 1 Data1) Data1))
  36. (setq Data2 (subst (cons Co (mapcar '+ Loc1 Delta))(assoc Co Data2) Data2))
  37. (if (entmake Data2)(setq ObjName2 (entlast)))
  38.         (setq PtX nil)
  39. (while (and (/= (car PtX) 3)(/= (car PtX) 11))
  40.   (setq PtX (grread nil 2 0))
  41.   (setq KeyX (cadr PtX))
  42.   (cond  ((or (= KeyX 97)(= KeyX 65))
  43.      (if (/= SPt 1)(setq SPt (1- SPt)))
  44.     )
  45.     ((or(= KeyX 100)(= KeyX 68))
  46.      (if (/= SPt (1- Len))(setq SPt (1+ SPt)))
  47.     )
  48.   )
  49.   (cond ((or (= KeyX 100)(= KeyX 97)(= KeyX 65)(= KeyX 68))
  50.     (setq SepL (ListSeparate ContentsL SPt))
  51.     (setq StrL (mapcar 'ListToString SepL))
  52.     (setq Data1 (subst (cons 1 (car StrL))(assoc 1 Data1) Data1))
  53.     (setq Data2 (subst (cons  1 (cadr StrL))(assoc 1 Data2) Data2))
  54.     (if ObjName1 (entdel ObjName1))
  55.     (if ObjName2 (entdel ObjName2))
  56.     (if (entmake Data1)(setq ObjName1 (entlast)))
  57.     (if (entmake Data2)(setq ObjName2 (entlast)))
  58.     )
  59.   )
  60. )
  61. )
  62. (defun StringToList ( SSS / A_DATA A_LIST)
  63. (setq AcadVersion (getvar "acadver"))
  64. (cond  
  65.    ((or (= 17.0 (atof (substr AcadVersion 1 4)))
  66.     (and (= 17.2 (atof (substr AcadVersion 1 4)))(/= (ver) "Visual LISP 2009 (en)")))
  67.     (while ( /= SSS "")
  68.      (setq A_DATA (logand 224 (ascii SSS)))
  69.      (setq A_LIST (append A_LIST (list (substr SSS 1 1))))
  70.      (setq SSS (substr SSS 2))
  71.     )
  72.    )
  73.    (T
  74.       (while ( /= SSS "")
  75.      (setq A_DATA (logand 224 (ascii SSS)))
  76.      (if (or (= A_DATA 224) (= A_DATA 128))
  77.       (progn(setq A_LIST (append A_LIST (list (substr SSS 1 2))))
  78.            (setq SSS (substr SSS 3))
  79.         )
  80.       (progn(setq A_LIST (append A_LIST (list (substr SSS 1 1))))
  81.            (setq SSS (substr SSS 2))
  82.       )
  83.      )
  84.     )
  85.    )
  86. )
  87.   A_LIST
  88. )
  89. (defun ListToString ( LLL / NewString)
  90. (setq NewString "")
  91. (while (/= LLL nil)
  92.      (setq NewString (strcat NewString (car LLL)))
  93.      (setq LLL (cdr LLL))
  94. )
  95. NewString
  96. )
  97. (defun SD8446 ( PointA PointB Ang / XA YA XB YB PointC)
  98. (setq  XA2(- (car PointA) (car PointB))
  99.    YA2(- (cadr PointA) (cadr PointB))
  100. )
  101. (setq PointC (list (- (* XA2 (cos Ang))(* YA2 (sin Ang))) (+ (* XA2 (sin Ang))(* YA2 (cos Ang)))))
  102. (setq PointC (mapcar '+ PointC PointB))
  103. PointC
  104. )
  105. (defun ListSeparate(GivenList BreakPoint)
  106. (setq i 0 L1 nil)
  107. (repeat BreakPoint
  108.   (setq L1 (append L1 (list (nth i GivenList))))
  109.   (setq i (1+ i))
  110. )
  111. (setq i BreakPoint L2 nil)
  112. (repeat (- (length GivenList) BreakPoint)
  113.   (setq L2 (append L2 (list (nth i GivenList))))
  114.   (setq i (1+ i))
  115. )
  116. (setq TheList (list L1 L2))
  117. TheList
  118. )
  119. (princ)
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2012-5-1 09:03 | 显示全部楼层
看来郎兄出手了,顶一下
回复 支持 0 反对 1

使用道具 举报

发表于 2012-4-30 14:27 | 显示全部楼层
还差个函数STRINGTOLIST
no function definition: STRINGTOLIST
 楼主| 发表于 2012-4-30 16:36 | 显示全部楼层
print1985 发表于 2012-4-30 14:27
还差个函数STRINGTOLIST
no function definition: STRINGTOLIST

不好意思,少了两个函数,已经补上。请测试。
发表于 2012-5-1 01:52 | 显示全部楼层
(defun c:aa (/ objname objtype)
  (princ "\n 把单行文字列在任意位置分割成两行(A和D键用于切换位置)")
  (setq *error* *myerror*)
  (setq acadversion (getvar "acadver"))
  (princ "\n AcadVersion :  ")
  (princ acadversion)
  (while (null objname)
    (setvar "ERRNO" 0)
    (setq objname (car (entsel)))
    (if objname
      (setq objtype (cdr (assoc 0 (entget objname))))
    )
    (cond
      ((= (getvar "ERRNO") 52)
        (exit)
      )
      ((= objtype "TEXT")
        (procedure_814)
      )
      ((/= objtype "TEXT")
        (setq objname nil)
      )
    )
  )
  (setq *error* nil)
  (princ)
)
(defun procedure_814 ()
  (princ "\n [A] [D] 键、改变分割移动的位置")
  (setq data1 (entget objname))
  (entdel objname)
  (setq contents (cdr (assoc 1 data1)))
  (setq texth (cdr (assoc 40 data1)))
  (setq ang (cdr (assoc 50 data1)))
  (setq contentsl (stringtolist contents))
  (setq len (length contentsl))
  (if (and
        (= (cdr (assoc 72 data1)) 0)
        (= (cdr (assoc 73 data1)) 0)
      )
    (setq co 10)
    (setq co 11)
  )
  (setq loc1 (cdr (assoc co data1)))
  (setq delta (sd8446 (list 0 (* -1.2 texth)) '(0 0) ang))
  (setq spt (fix (* 0.5 len)))
  (setq sepl (listseparate contentsl spt))
  (setq strl (mapcar
               'listtostring
               sepl
             )
  )
  (setq data1 (subst
                (cons 1 (car strl))
                (assoc 1 data1)
                data1
              )
  )
  (if (entmake data1)
    (setq objname1 (entlast))
  )
  (setq data2 (subst
                (cons 1 (cadr strl))
                (assoc 1 data1)
                data1
              )
  )
  (setq data2 (subst
                (cons co (mapcar
                           '+
                           loc1
                           delta
                         )
                )
                (assoc co data2)
                data2
              )
  )
  (if (entmake data2)
    (setq objname2 (entlast))
  )
  (setq ptx nil)
  (while (and
           (/= (car ptx) 3)
           (/= (car ptx) 11)
         )
    (setq ptx (grread nil 2 0))
    (setq keyx (cadr ptx))
    (cond
      ((or
         (= keyx 97)
         (= keyx 65)
       )
        (if (/= spt 1)
          (setq spt (1- spt))
        )
      )
      ((or
         (= keyx 100)
         (= keyx 68)
       )
        (if (/= spt (1- len))
          (setq spt (1+ spt))
        )
      )
    )
    (cond
      ((or
         (= keyx 100)
         (= keyx 97)
         (= keyx 65)
         (= keyx 68)
       )
        (setq sepl (listseparate contentsl spt))
        (setq strl (mapcar
                     'listtostring
                     sepl
                   )
        )
        (setq data1 (subst
                      (cons 1 (car strl))
                      (assoc 1 data1)
                      data1
                    )
        )
        (setq data2 (subst
                      (cons 1 (cadr strl))
                      (assoc 1 data2)
                      data2
                    )
        )
        (if objname1
          (entdel objname1)
        )
        (if objname2
          (entdel objname2)
        )
        (if (entmake data1)
          (setq objname1 (entlast))
        )
        (if (entmake data2)
          (setq objname2 (entlast))
        )
      )
    )
  )
)
(defun stringtolist (sss / a_data a_list)
  (setq acadversion (getvar "acadver"))
  (cond
    ((or
       (= 17.0 (atof (substr acadversion 1 4)))
       (and
         (= 17.2 (atof (substr acadversion 1 4)))
         (/= (ver) "Visual LISP 2009 (en)")
       )
     )
      (while (/= sss "")
        (setq a_data (logand 224 (ascii sss)))
        (if (> (ascii (setq nn (substr sss 1 1))) 160)
          (setq nn (substr sss 1 2)
                sss (substr sss 3)
          )
          (setq sss (substr sss 2))
        )
        (setq a_list (append
                       a_list
                       (list nn)
                     )
        )
      )
    )
    (t
      (while (/= sss "")
        (setq a_data (logand 224 (ascii sss)))
        (if (or
              (= a_data 224)
              (= a_data 128)
            )
          (progn
            (setq a_list (append
                           a_list
                           (list (substr sss 1 2))
                         )
            )
            (setq sss (substr sss 3))
          )
          (progn
            (if (> (ascii (setq nn (substr sss 1 1))) 160)
              (setq nn (substr sss 1 2)
                    sss (substr sss 3)
              )
              (setq sss (substr sss 2))
            )
            (setq a_list (append
                           a_list
                           (list nn)
                         )
            )
          )
        )
      )
    )
  )
  a_list
)
(defun listtostring (lll / newstring)
  (setq newstring "")
  (while (/= lll nil)
    (setq newstring (strcat newstring (car lll)))
    (setq lll (cdr lll))
  )
  newstring
)
(defun sd8446 (pointa pointb ang / xa ya xb yb pointc)
  (setq xa2 (- (car pointa) (car pointb))
        ya2 (- (cadr pointa) (cadr pointb))
  )
  (setq pointc (list (- (* xa2 (cos ang)) (* ya2 (sin ang))) (+ (* xa2 (sin ang)) (* ya2 (cos ang)))))
  (setq pointc (mapcar
                 '+
                 pointc
                 pointb
               )
  )
  pointc
)
(defun listseparate (givenlist breakpoint)
  (setq i 0
        l1 nil
  )
  (repeat breakpoint
    (setq l1 (append
               l1
               (list (nth i givenlist))
             )
    )
    (setq i (1+ i))
  )
  (setq i breakpoint
        l2 nil
  )
  (repeat (- (length givenlist) breakpoint)
    (setq l2 (append
               l2
               (list (nth i givenlist))
             )
    )
    (setq i (1+ i))
  )
  (setq thelist (list l1 l2))
  thelist
)
(princ)



点评

adc
谢谢分享,切断的位置能不能调整一下,最好是在鼠标点击的位置。  发表于 2012-9-10 12:20
非常感谢!学习了。  发表于 2012-5-1 08:07
发表于 2012-5-1 07:13 | 显示全部楼层
StringToList有关于双字节处理的
发表于 2012-5-1 07:14 | 显示全部楼层
发表于 2012-5-1 08:27 | 显示全部楼层
感谢分享!
发表于 2012-5-1 08:39 | 显示全部楼层
谢谢分享,回复学习
发表于 2012-5-1 09:32 | 显示全部楼层
看看版主是如何做到的
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 03:49 , Processed in 0.237394 second(s), 36 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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