[LISP函数]：请高手出招啊

pipi002004

请高手出招帮忙修改达到想要的效果
附原程序
(defun c:wzlj(/ OSM DISX0 DISX DISXi DISY DISYi nam_1 nam0 namx namy nm ET1 ET I)
  (cmdla0)
  (command "undo" "be")
  (SETQ TXT "" )
  (SETQ TXT1 "" )
  (PRINC "\n 框选要连接的文字：")
  (setq ss(ssget))
  (setq ssx(ssadd))
  (setq ssy(ssadd))
;      =================================
(WHILE (<= 1 (SSLENGTH ss))
  (setq i 0)
  (SETQ DISX0(CAR(cdr(assoc 10 (entget(ssname ss 0))))))
  (SETQ DISX DISX0)
  (SETQ nam0(cdr(assoc 0 (entget(ssname ss 0)))))
  (SETQ nam_1(cdr(assoc -1 (entget(ssname ss 0)))))

(IF (="TEXT" nam0)
  (PROGN     
     (REPEAT (SSLENGTH ss)
        (setq et(entget(ssname ss i)))
        (setq nam_1(cdr(assoc -1 et)))
        (setq nam0(cdr(assoc 0 et)))
        (setq Disxi(CAR(cdr(assoc 10 et))))
   
           (IF (="TEXT" nam0)
               (PROGN
                   (IF (<= DISXI DISX)
                        (PROGN     
                        (SETQ DISX DISXi)
                        (setq namx nam_1)
                        )
                   )
               )
           )
        (setq i(+ i 1))
     )  ;end repeat
  (SSADD namx ssx)
  (SSDEL namx ss)
  )
  (SSDEL nam_1 ss)
);end if

);end while
;      =================================
(WHILE (<= 1 (SSLENGTH ssx))
  (setq i 0)
  (SETQ DISY0(CADR(cdr(assoc 10 (entget(ssname ssx 0))))))
  (SETQ DISY DISY0)
  (SETQ nam0(cdr(assoc 0 (entget(ssname ssx 0)))))
  (SETQ nam_1(cdr(assoc -1 (entget(ssname ssx 0)))))

   
     (REPEAT (SSLENGTH ssx)
        (setq et(entget(ssname ssx i)))
        (setq nam_1(cdr(assoc -1 et)))
        (setq nam0(cdr(assoc 0 et)))
        (setq DisYi(CADR(cdr(assoc 10 et))))
   
           ;(IF (="TEXT" nam0)
               ;(PROGN
                   (IF (>= DISYI DISY)
                        (PROGN     
                        (SETQ DISY DISYi)
                        (setq namy nam_1)
                        )
                   )
               ;)
          ; )
        (setq i(+ i 1))
     )  ;end repeat
  (SSADD namy ssy)
  (SSDEL namy ssx)


);end while
;      =================================
  (setq i 0)
     (REPEAT (SSLENGTH ssy)
        (setq et1(entget(ssname ssy i)))
        (setq TXT1(cdr(assoc 1 et1)))
        (SETQ TXT(STRCAT TXT TXT1))
            (IF (= i 0)
                 (PROGN
                 (command "copy" (ssname ssy i) "" '(0 0) "")
                 (setq nm(entget(entlast)))
                 )
            )   
        (setq i(+ i 1))
     )

  (SETQ ENT(SUBST(CONS 1 TXT)(ASSOC 1 nm)nm))
  (ENTMOD ent)
  (command "erase" ssy "")   
  (command "undo" "e")
  (cmdla1)
  (redraw)
  (princ)
)

(DEFUN CMDLA0 ()
  (SETQ ODERR *ERROR*)
  (SETQ *ERROR* CCY_ERR)
  (SETQ CMD (GETVAR "CMDECHO"))
  (SETQ OOM (GETVAR "orthomode"))
  (SETQ OSM (GETVAR "osmode"))
  (SETQ HLT (GETVAR "highlight"))
  (SETQ RMODE (GETVAR "regenmode"))
  (SETQ ODLTP (GETVAR "celtype"))      ; 记录当前线型设置
  (SETQ ODCLR (GETVAR "cecolor"))      ; 记录当前颜色设置
  (SETQ ODLAY (GETVAR "clayer"))       ; 记录当前层
  (SETQ ODSTY (GETVAR "textstyle"))    ; 记录当前文本样式
  (SETQ ODTSZ (GETVAR "textsize"))     ; 记录当前文本高度
  (SETQ ODZIN (GETVAR "dimzin"))       ; 记录主单位值消零处理方式
  (SETQ ODFR (GETVAR "filletrad"))
  (SETVAR "regenmode" 0)
  (SETVAR "CMDECHO" 0)
  (PRINC)
)
(DEFUN CMDLA1 ()
  (SETVAR "CMDECHO" CMD)
  (SETVAR "orthomode" OOM)
  (SETVAR "osmode" OSM)
  (SETVAR "highlight" HLT)
  (SETVAR "regenmode" RMODE)
  (SETVAR "celtype" ODLTP)
  (SETVAR "cecolor" ODCLR)
  (SETVAR "textstyle" ODSTY)
  (SETVAR "textsize" ODTSZ)
  (COMMAND "layer" "s" ODLAY "")
  (SETVAR "dimzin" ODZIN)               ; 恢复主单位值消零处理方式
  (SETVAR "filletrad" ODFR)
  (PRINC)
)
(DEFUN CCY_ERR (MSG)
  (PRINC (STRCAT "\n错误:" MSG "\n"))  ; 打印错误原因
  (CMDLA1)                               ; 调用函数CMDLA1恢复程序开始前的设置
  (SETQ *ERROR* ODERR)                       ; 恢复原来的*ERROR*
  (PRINC)
)

zxmmelly

是顺序的问题，不要框选，最好单选，然后按选的顺序来连接就行了吧

andyhua5240

楼主用文字修改大师吧，是免费的，而且有楼主想要的功能，而且还要多。就在这个版块，文字修改大师v10.3，找找吧！
而且文字连接后的效果，与楼主选择的顺序有很大的关系的！

gucci218

(defun c:l()
  (setvar "cmdecho" 0)
  (setq ss (ssget)
        lst '()
        i    0)
(repeat (sslength ss)
(setq ent (ssname ss i)
        entt (cdr (assoc 1 (entget ent)))
        lst (cons entt lst)       
        i  (1+ i)
)
)
(setq lm (acad_strlsort lst)
        j 0       
)

(repeat (length lm)
(setq ent (nth j lm))
(command "text" (getpoint "\n插入点:") "20" "" ent "")
(setq j (1+ j))
)
(princ)
)

marcoyuwen

按插入点排序(使用vl-sort)后再连接文字内容

雨箭风刀

提取文本字符串内容为表txtlst
(setq newtxt (apply 'strcat (acad_strlsort txtlit)))
newtxt即为要的字符串