求改一代码

wgij007 · 发表于 2021-1-20 09:07:33

本帖最后由 wgij007 于 2021-1-21 11:36 编辑

原贴在那忘了，就在明经里的

不要选择直接换行与空格 2种，谢谢了

;;;*****文字合并程序开始*****
(defun c:hbh (/ lst)
  (setq oldaun (getvar "aunits"))
  (setvar "aunits" 3)
  (setvar "osmode" 15359)
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (princ "\n★功能：文字合并。\n \n")
  (setq ss (ssget '((0 . "MTEXT,TEXT"))))
  (setvar "osmode" 0)
  (initget "E S A")
  (if (not (setq kword
               (getkword
                  "\n在合并文字之间加：[换行(E)/空格(S)/直接合并(A)]<E>"
               )
         )
   )
(setq kword "E")
  )
  (setvar "osmode" 0)
  (setq lst '())
  (while (> (sslength ss) 0)
(setq entnam (ssname ss 0)
      entdat (entget entnam)
)
(setq pt  (cdr (assoc 10 entdat))       ;读取文字的插入点坐标
      txt (cdr (assoc 1 entdat))       ;读取文字内容
      zg  (cdr (assoc 40 entdat))       ;读取文字的字高
      lst (cons (list pt txt zg) lst) ;将点坐标、内容、字高组成表
      ss  (ssdel entnam ss)             ;选择集中删除当前的文字对象
)
(entdel entnam)                      ;删除文字对象
  )
  (setq
lst
   (vl-sort lst
(function
            (lambda       (e1 e2)
               (if (equal (cadr (car e1)) (cadr (car e2)) 1e-4)
                  (> (car (car e1)) (car (car e2)))
                  (< (cadr (car e1)) (cadr (car e2)))
               )
            )
            )
   )
  )
  (setq str "")
  (cond       ((= kword "S")
      (foreach e lst
         (setq str (strcat (cadr e) " " str))
      )
      )
      ((= kword "E")
      (foreach e lst
         (setq str (strcat (cadr e) "\n" str))
      )
      )
      ((= kword "A")
      (foreach e lst
         (setq str (strcat (cadr e) str))
      )
      )
  )
  (command "MTEXT" pt "H" zg "W" 0 str "")
  (princ "\n★提示:文字合并完成.\n")
  (princ)
  (setvar "aunits" oldaun)
  (command "undo" "e")
  (setvar "osmode" 15359)
  (princ)
)
;;;*****文字合并程序结束****

bssurvey · 发表于 2021-1-20 09:07:34

wgij007 发表于 2021-1-21 11:39
可能我表达不清楚，我想说的是不选择空格与换行，直接执行空格或换行两种代码.

;這樣嗎
;;;*****文字合并换行程序开始*****
(defun c:hbh (/ lst)
  (setq oldaun (getvar "aunits"))
  (setvar "aunits" 3)
  (setvar "osmode" 15359)
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (princ "\n★功能：文字合并。\n \n")
  (setq ss (ssget '((0 . "MTEXT,TEXT"))))
  (setvar "osmode" 0)
  (setq lst '())
  (while (> (sslength ss) 0)
(setq entnam (ssname ss 0)
      entdat (entget entnam)
)
(setq pt  (cdr (assoc 10 entdat))       ;读取文字的插入点坐标
      txt (cdr (assoc 1 entdat))       ;读取文字内容
      zg  (cdr (assoc 40 entdat))       ;读取文字的字高
      lst (cons (list pt txt zg) lst) ;将点坐标、内容、字高组成表
      ss  (ssdel entnam ss)             ;选择集中删除当前的文字对像
)
(entdel entnam)                      ;删除文字对像
  )
  (setq
lst
   (vl-sort lst
(function
            (lambda       (e1 e2)
               (if (equal (cadr (car e1)) (cadr (car e2)) 1e-4)
                  (> (car (car e1)) (car (car e2)))
                  (< (cadr (car e1)) (cadr (car e2)))
               )
            )
            )
   )
  )
  (setq str "")
  (foreach e lst
(setq str (strcat (cadr e) "\n" str))
  )
  (command "MTEXT" pt "H" zg "W" 0 str "")
  (princ "\n★提示:文字合并完成.\n")
  (princ)
  (setvar "aunits" oldaun)
  (command "undo" "e")
  (setvar "osmode" 15359)
  (princ)
)
;;;*****文字合并换行程序结束****

;;;*****文字合并空格程序开始*****
(defun c:hb (/ lst)
  (setq oldaun (getvar "aunits"))
  (setvar "aunits" 3)
  (setvar "osmode" 15359)
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (princ "\n★功能：文字合并。\n \n")
  (setq ss (ssget '((0 . "MTEXT,TEXT"))))
  (setvar "osmode" 0)
  (setq lst '())
  (while (> (sslength ss) 0)
(setq entnam (ssname ss 0)
      entdat (entget entnam)
)
(setq pt  (cdr (assoc 10 entdat))       ;读取文字的插入点坐标
      txt (cdr (assoc 1 entdat))       ;读取文字内容
      zg  (cdr (assoc 40 entdat))       ;读取文字的字高
      lst (cons (list pt txt zg) lst) ;将点坐标、内容、字高组成表
      ss  (ssdel entnam ss)             ;选择集中删除当前的文字对像
)
(entdel entnam)                      ;删除文字对像
  )
  (setq
lst
   (vl-sort lst
(function
            (lambda       (e1 e2)
               (if (equal (cadr (car e1)) (cadr (car e2)) 1e-4)
                  (> (car (car e1)) (car (car e2)))
                  (< (cadr (car e1)) (cadr (car e2)))
               )
            )
            )
   )
  )
  (setq str "")
  (foreach e lst
(setq str (strcat (cadr e) " " str))
  )
  (command "MTEXT" pt "H" zg "W" 0 str "")
  (princ "\n★提示:文字合并完成.\n")
  (princ)
  (setvar "aunits" oldaun)
  (command "undo" "e")
  (setvar "osmode" 15359)
  (princ)
)
;;;*****文字合并空格程序结束****

bssurvey · 发表于 2021-1-20 10:48:56

(princ "\n★功能：文字合并。\n \n");這行可以拿掉
(setq ss (ssget "X" '((0 . "MTEXT,TEXT")))) ;在這行加"X"就會自動把所有的文字合并了

wgij007 · 发表于 2021-1-21 11:39:04

bssurvey 发表于 2021-1-20 10:48
(princ "\n★功能：文字合并。\n \n");這行可以拿掉
(setq ss (ssget "X" '((0 . "MTEXT,TEXT")))) ;在 ...

可能我表达不清楚，我想说的是不选择空格与换行，直接执行空格或换行两种代码.

wgij007 · 发表于 2021-1-21 17:04:15

bssurvey 发表于 2021-1-20 10:48
(princ "\n★功能：文字合并。\n \n");這行可以拿掉
(setq ss (ssget "X" '((0 . "MTEXT,TEXT")))) ;在 ...

感谢

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

[提问] 求改一代码

最佳答案

浏览过的版块