鬼魔 发表于 2007-2-12 15:19:00

[求助]求批量属性文字转文字

<p>就是还没定义块前的属性文字</p><p>转成单行或多行文字都可</p>

SWAYWOOD 发表于 2007-2-12 21:27:00

估计这段对你有用
((= (cdr (assoc 0 ENTS)) "INSERT")
    (setq J (+ J 1))
    (princ (strcat "\n正在处理第<"
   (itoa (+ J 1))
   ">个图元，请稍候..."
    )
    )
    (setq ENTB (tblobjname "block" (cdr (assoc 2 ENTS))))
    (setq ENTSB (entget ENTB))
    ;;放过特殊情况
    ;;2007-01-25修改为在说明中找指定文字
    (if (vl-string-search
   "SPECIAL TEXTSTYLE"
   (if (cdr (assoc 4 ENTSB))
   (cdr (assoc 4 ENTSB))
   ""
   )
      )
      (setq LOOP NIL)
      (progn
      ;;如果是属性块,ENT，如果不是，ENTB
      (if (assoc 66 ENTS)
   (setq ENT (entnext ENT))
   (setq ENT (entnext ENTB))
      )
      (setq LOOP t)
      )
    )
    ;;以下处理INSERT中的属性文字
    ;;取得块的插入点
    ;;进入块中图元的循环
    (while
      (and ENT LOOP)
       (setq ELIST (entget ENT))
       ;;以下开始处理
       (if (or (= (cdr (assoc 0 ELIST)) "TEXT")
      (= (cdr (assoc 0 ELIST)) "ATTRIB")
    )
;;以下IF语句是2007-1-16加入的，对字体是SM的情况加以减化
(if (/= (cdr (assoc 7 ELIST)) "SM")
    ;;如果图元是TEXT或ATTRIB，进行以下处理
    (progn
      (setq TXB (textbox ELIST))
      ;;得到旧的文字总宽度
      (setq
      OLD_WIDTH (- (car (cadr TXB)) (car (car TXB)))
      )
      ;;得到旧的文字总宽度
      (setq ELIST
      (subst (cons 7 "SM") (assoc 7 ELIST) ELIST)
      )
      (setq ELIST (subst (cons 41 0.7)
         (assoc 41 ELIST)
         ELIST
    )
      )
      (entmod ELIST)
      (entmod ENTS)
      (setq TXB (textbox ELIST))
      ;;得到文字宽度
      (setq
      NEW_WIDTH (- (car (cadr TXB)) (car (car TXB)))
      )
      ;;如果新的文字宽度比旧的文字宽度宽，则对文字宽度进行修改
      (if (> NEW_WIDTH OLD_WIDTH)
      (setq ELIST
      (subst (cons 41 (* 0.7 (/ OLD_WIDTH NEW_WIDTH)))
      (assoc 41 ELIST)
      ELIST
      )
      )
      )
    )
    ;;如果字体是SM，保证其宽度比例不能超过0.7
    (if (> (cdr (assoc 41 ELIST)) 0.7)
      (setq ELIST
      (subst (cons 41 0.7) (assoc 41 ELIST) ELIST)
      )
    )
)
       )
       (entmod ELIST)
       (setq ENT (entnext ENT))
       (if ENT
(if (= (cdr (assoc 0 (entget ENT))) "SEQEND")
    (setq LOOP NIL)
)
       )
    )
    (if (not (assoc 66 ENTS))
      (entmod ENTSB)
    )
    (entmod ENTS)
   )

鬼魔 发表于 2007-2-13 10:56:00

<p>不是很懂这个。。。</p><p>na </p>

龙龙仔 发表于 2007-2-14 07:50:00

;;求批量屬性文字轉文字
;;就是還沒定義塊前的屬性文字
;;By LUCAS
(defun C:CH_ATTDEF_TXT (/ LST N SS X)
(prompt "\nSelect \"Attdef\" Objects: ")
(if (setq SS (ssget '((0 . "ATTDEF"))))
    (progn
      (setq N 0)
      (repeat (sslength SS)
(setq LST '((0 . "TEXT")))
(mapcar
   '(lambda (X)
      (if (not (member (car X) '(-1 2 0 330 5 1 3 70 74 100)))
      (setq LST (cons X LST))
      (if (= (car X) 2)
   (setq LST (cons (cons 1 (cdr X)) LST))
      )
      )
    )
   (entget (ssname SS N))
)
(setq LST (reverse LST)
       N   (1+ N)
)
(entmake LST)
      )
      (command "_.erase" SS "")
    )
)
(princ)
)
(princ "\nType Ch_Attdef_Txt,By Lucas\n")
(princ)

无痕 发表于 2007-2-14 14:13:00

本帖最后由 作者 于 2007-2-14 14:25:18 编辑

06年以前好像也写过，这个是在我电脑上找到的，不象是我自己写的

;; 属性转文本　
(defun C:TAG2TXT ()
(setq sset (ssget '((0 . "ATTDEF"))))
(setq num (sslength sset) itm 0)
(while (< itm num)
    (setq hnd (ssname sset itm))
    (setq ent (entget hnd))
    (setq new '((0 . "TEXT")))
    (setq new (append new (list (cons 1 (cdr (assoc 2 ent))))))
    (setq dolst (list 7 8 10 11 39 40 41 50 51 62 71 72 73))
    (foreach grp dolst
      (setq addto (assoc grp ent))
      (if (/= addto nil)
      (setq new (append new (list (assoc grp ent))))
      )
    )
    (entdel hnd)
    (entmake new)
    (setq itm (1+ itm))
)
(princ)
)

鬼魔 发表于 2007-2-14 21:40:00

谢谢楼上的2位朋友,这程序解决了大忙了

tcsl9621 发表于 2007-2-14 23:46:00

用CAD扩展工具好了。那里就有。

鬼魔 发表于 2007-2-15 21:25:00

<p>回楼上的 </p><p>那个是定义块后的&nbsp;&nbsp; </p>

剧毒噬骨 发表于 2013-1-1 11:31:38

我是来求工具的 ，我也需要这个，还没学习好 代码怎么用呀
页: [1]
查看完整版本: [求助]求批量属性文字转文字