(完成)[编程申请]：要求：选定字符，则字符自动向右（向上）复制一次，复制后两字符间

lengliqun

要求：选定字符，则字符自动向右（向上）复制一次，复制后两字符间距为400如图示。谢谢。(附图)

maplesu

刚才没有弄明白，看了图，你这个很难控制，原则上说不同的字体的宽都有一定的变化，要保证间距时400就算求得了字数但是每个字符的宽度没有办法确定（因为有的字体不是宽度＝字高的）

eachy

最初由 lengliqun 发布
[B]要求：选定字符，则字符自动向右（向上）复制一次，复制后两字符间距为400如图示。谢谢。(附图) [/B]

请注意所提供图中使用的字体，尽量使用 宋体 之类的系统字体，否则没法看到内容。

hi71400

;这是点一个,处理一个的东
                                        ;『真搞不懂有什么用』[php]
(defun c:cp1 (/ obj ent typ pt1 pt2 ang old_os)
  (setq old_os (getvar "osmode"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (setq obj (car (entsel "\n选择文字：")))
  (if obj
    (progn
      (setq ent        (entget obj)
            typ        (cdr (assoc 0 ent))
      )
      (if (= typ "TEXT")
        (progn
          (setq        pt1 (cdr (assoc 10 ent));pt1 为文字基点,ang为文字的转角
                ang (cdr (assoc 50 ent))
                PT2 (POLAR PT1 ANG 400)
          )
          (command "copy" obj "" pt1 pt2)
        )

      )
    )
  )
  (setvar "osmode" old_os)
  (princ)
)                                        ;这是可成批处理的程序。
(defun c:cp2 (/ ss sslen obj ent pt1 pt2 ang old_os)
  (princ "\n选择需要copy的文字：[可多选]")
  (setq old_os (getvar "osmode"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (setq ss (ssget '((0 . "TEXT"))))
  (setq sslen (sslength ss))
  (while (> sslen 0)
    (setq obj (ssname ss (setq sslen (1- sslen))))
    (setq ent (entget obj)
          pt1 (cdr (assoc 10 ent))        ;pt1 为文字基点,ang为文字的转角
          ang (cdr (assoc 50 ent))
          PT2 (POLAR PT1 ANG 400)
    )
    (command "copy" obj "" pt1 pt2)
  )
  (setvar "osmode" old_os)
  (princ)
)[/php]

lengliqun

谢谢各位，hi71400之编程可用,建议完成。
结构专业有用，我单位之平法表示法要求支座两边的梁标注钢筋长度，而这两个长度的数值相同，数值（字符）间隔400左右，故求编程。

hi71400

其实我也是没认真看图。真要按间距控制，还应该用txtBOX求文字框的大小。
不过，楼主说行了就也就算了。
另外，斑竹呀，能不能给一分积分鼓励鼓励啊？
－－俺可是费了四五十分钟才编出来的喔
哈哈