【分享明经——发程序、拜新年专贴】

sxh_why

发个我的最经典的心得，能不能帮到爬楼的弟兄，能不能领悟，全靠缘分。高手就别看了。

Terry Miller 写了一个超级经典的批处理命令，藏在他一堆乱哄哄的程序里，排在一个很不起眼的位置。

hhh454

恭祝大家虎年行大运，财源滚滚来，大吉大利，万事如意，身体健康，祝明经好上加好，传一个网上的程序，程序说明：

    此软件能解决CAD文字编辑、排版的不足，能轻易实现统一CAD文字字高、用水平方式和垂直方式对CAD文字进行排版处理。

使用方法

    软件加载：打开菜单：工具----加载应用程序，即成功加载程序了。程序加载后，会暗示命令帮助提示

*********************************************************
                  文字排版命令程序命令表
            QA........以垂直方式对齐排列各文字行
            QW........以水平方式对齐排列各文字行
            QS........统一字高

 里面是一对乱码，可以用。

 

dkj0322

很精彩，本人是新手，受益匪浅

 

自贡黄明儒

;;;文字递增

;;;根据caoyin的刷子函数写成如下函数;空格键不能中断

;;;;;;;;;;;;
;;;功能,如果是文字末尾不是数,则加1.如果是数,取出来作为基数HH:Textnum
(defun textIncrease ( / BOOL E ENT HH:TEXTNUM HH:TEXTPRE I OB1 OBA OBALENGTH OBN OBT OTXT PTN)
  (lt:error-init (list nil 0 nil))
;;;取得文字
  (setq bool T)
  (while bool
    (setq ob1 (entsel "\n选择要修改的任何文本:"))
    (SETQ obn (car ob1)   ;图元
   ptn (car (cdr ob1))  ;拾取点
    ) ;_ 结束SETQ
    (setq obt (car (nentselp ptn)))
    (setq oba (cdr (assoc 0 (entget obt))))
    (if (or (= oba "TEXT")
     (= oba "MTEXT")
     (= oba "ATTRIB")
     (= oba "ATTDEF")
 ) ;_ 结束or
      (setq bool nil)
      (princ "\n必须选择文字,重来:")
    ) ;_ 结束if
  )     ;end while

  (setq ent (entget obt))
  (if (= oba "ATTDEF")
    (setq otxt (cdr (assoc 2 ent)))
    (setq otxt (cdr (assoc 1 ent)))
  )     ; end if

  (if (obaEndIsNumber otxt)
    (progn
      (setq bool T i 0)
      (setq obaLength (strlen otxt))
      (while bool
 (setq e (ascii (substr otxt obaLength 1))) 
 (if (or (and (> e 47) (< e 58)))
   (progn
            (setq obaLength (1- obaLength))
            (setq i (1+ i))
           )
   (setq bool nil)         
 ) ;_ 结束if
 (if (= i (strlen otxt)) (setq bool nil))
      ) ;_ 结束while
      (setq obaLength (- (strlen otxt) i));前缀长度
      (setq HH:Textpre (substr otxt 1 obaLength))
      (setq HH:Textnum (substr otxt (+ 1 obaLength) i))
    ) ;_ 结束progn
    (progn
      (setq HH:Textpre otxt)
      (setq HH:Textnum "1")
      (setq otxt (strcat otxt "1"))
      (if (= oba "ATTDEF")
 (progn
   (entmod (subst (cons 2 otxt) (assoc 2 ent) ent))
   (entupd obn)
 ) ;_ 结束progn
 (progn
   (entmod (subst (cons 1 otxt) (assoc 1 ent) ent))
   (entupd obn)
 ) ;_ 结束progn
      ) ;_ 结束if
    ) ;_ 结束progn
  ) ;_ 结束if

  (lt:match
    (cadr ob1)
    '(2 2)
    (list "\n选择要改变的文字: "
   '((0 . "*TEXT,INSERT"))
    ) ;_ 结束list
    '(lambda (x / ent)
;;;(setq x (car (entsel)))
       (setq ent (entget x))
       (setq HH:Textnum (itoa (1+ (atoi HH:Textnum))))
       (setq otxt (strcat HH:Textpre HH:Textnum))
;;;获得块名,之后用entnext访问它的名成元
       (if (= "INSERT" (cdr (assoc 0 ent)))
  (progn
    (setq firn (ENTNEXT (CDR (ASSOC -1 ENT))))
    (if firn (setq bool T))
    (while bool     
      (SETQ ENT (ENTGET firn))     
      (if (or (= (CDR (ASSOC 0 ent)) "TEXT")
       (= (CDR (ASSOC 0 ent)) "MTEXT")
                     (= (CDR (ASSOC 0 ent)) "ATTRIB")        
   ) ;_ end of or
        (progn (entmod (subst (cons 1 otxt) (assoc 1 ent) ent))
        (setq bool nil)
        ) ;_ end of progn
        (progn (if (= (cdr (assoc 0 ent)) "ATTDEF")
   (entmod (subst (cons 2 otxt) (assoc 2 ent) ent))
   (setq bool nil)
        ) ;_ end of if
        ) ;_ end of progn
      ) ;_ end of if
      (entupd firn)
      (entupd x)
      (setq firn (entnext firn))
      (if firn
        (setq bool nil)
      ) ;_ end of if
    ) ;_ end of while
  ) ;_ end of progn
  (entmod (subst (cons 1 otxt) (assoc 1 ent) ent))
       ) ;_ end of if

     ) ;_ 结束lambda
  ) ;_ 结束lt:match
  (lt:error-restore)

) ;_ 结束defun

 

;;;所取字符串末尾是不是数,返回真假
(defun obaEndIsNumber (otxt / E OBALENGTH)
  (setq obaLength (strlen otxt))
  (setq e (ascii (substr otxt obaLength 1)))
  (and (> e 47) (< e 58))
) ;_ 结束defun
;;; 结束defun obaEndIsNumber

cable2004

这里是CAD知识的海洋，是中国工程的的CAD之家。

daiguafan

绝对好贴

顶下，学习中

xiaxiang

发现了，顶起来，大家来学习

xjf

   经典贴
，学习中

gzbccy

我来的太晚了，发现这边的高手真是多啊

sean_huang88

happy new year