[讨论]：程序:改变文字高度

啵浪鼓

呵呵,xyp1964还在线啊...

我说的change后不用p的,如下:
Command:  CHANGE
Select objects: 1 found
Select objects:  Specify change point or [Properties]:
Specify new text insertion point <no change>:
Enter new text style <STANDARD>:
Specify new height <5.00>:
Specify new rotation angle <0.0000>:
Enter new text <Q'TY:1>:

xyp1964

[php]
(defun c:ct ()
  (setq        h  (ureal 1 "" "\n字高" h)
        ss  (ssget '((0 . "TEXT,DIMENSION")))
        h1 (/ h 1.5)
        h2 (/ h 5)
        i  -1
  )
  (while (setq si (ssname ss (setq i (1+ i))))
    (setq mode (cdr (assoc 0 (entget si))))
    (if        (= "TEXT" mode)
      (command "change" si "" "" "" "" h "" "")
    )
    (if        (= "DIMENSION" mode)
      (command "dimoverride" "dimtxt" h        "dimasz" h1 "dimexe" h2        "dimexo" h2 "" si "")
    )
  )
  (princ)
)
(defun ureal (bit kwd msg def / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  )
  (initget bit kwd)
  (setq inp (getreal msg))
  (if inp
    inp
    def
  )
)
[/php]

啵浪鼓

哇,xyp1964你的程序偶看不懂了,不知这段程序表示要做什么动作了?
(defun ureal (bit kwd msg def / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
      bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  )
  (initget bit kwd)
  (setq inp (getreal msg))
  (if inp
    inp
    def
  )
)


还有9楼的这段程序里的d,不知为什么要这样设置
      (if (= "TEXT" (cdr (assoc 0 (entget si))))
        (progn
        (setq D (entget si) d (subst (cons 40 h) (assoc 40 d) d))
        (entmod d)
        )
      )

david96007

我建议大家多研究一下entmod、entmake等函数，感觉比command直接多了，可以减少出错的机会！
比如要创建新实体，用entmake的话，可以直接创建到指定的层，如果层不存在，则先创建层；而用command创建新实体的话，要指定到特定的层，不是先改变当前层的设置，就是要在创建实体后修改实体的属性，远不如entmake直接！


(setq d (entget si))；取得实体的“数据”
(setq d (subst (cons 40 h) (assoc 40 d) d)) ;用新的文字高度进行替换，并将更新后的“数据”表d再次赋值给d，以便用entmod进行修改！

有些名词我说不清楚，不知楼上的是否能明白？！

xyp1964

最初由 啵浪鼓 发布
[B]哇,xyp1964你的程序偶看不懂了,不知这段程序表示要做什么动作了?
(defun ureal (bit kwd msg def / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
      bit (* 2 (fix (/ bit 2))... [/B]

ureal的作用：保持缺省值！
可以试试10楼的程序。

啵浪鼓

哦,原来xyp1964加写了保留了记住上次输入的值了,呵呵,这下程序更强了,但正如16楼ljpnb所说,这可能是change命令中的一个bug,所以这句(command "change" si "" "" "" "" h "" "")命令还是依然造成字的歪斜...是否你的程序与9楼的程序相接合,这样就可以达到最佳效果了???

还有,我想在TEXT,DIMENSION里再加MTEXT的选项,如下程序:
(defun c:ct ()
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq h (ureal 1 "" "\nEnter text hight:" h)
    ss  (ssget '((0 . "TEXT,DIMENSION,MTEXT")))
    h1 (/ h 1.5)
    h2 (/ h 5)
    i  -1)
  (while (setq si (ssname ss (setq i (1+ i))))
    (setq mode (cdr (assoc 0 (entget si))))
    (if (= "TEXT" mode)
        (command "change" si "" "" "" "" h "" "")
    )
    (if (= "MTEXT" (cdr (assoc 0 (entget si))))
        (command "scaletext" si "" "existing" h)
    )
    (if (= "DIMENSION" mode)
      (command "dimoverride" "dimtxt" h    "dimasz" h1 "dimexe" h2    "dimexo" h2 "" si "")
    )
  )
  (princ)
)
(defun ureal (bit kwd msg def / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
      bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  )
  (initget bit kwd)
  (setq inp (getreal msg))
  (if inp
    inp
    def
  )
(command "undo" "e")
(princ)
)

下面这一句的命令scaletext会出现溢出的现象,也就是选了很多MTEXT后此指令就不能再写了,好像是占用了内存还是什么的,必须是重开图档或是重启CAD此指令才生效,如果运行了多次又得重开了,唉!搞不懂了
    (if (= "MTEXT" (cdr (assoc 0 (entget si))))
        (command "scaletext" si "" "existing" h))

david96007

把(command "scaletext" si "" "existing" h)换成以下试试：

2. (progn
   
3.         (setq d        (entget si)
   
4.               old_h (cdr (assoc 40 d))
   
5.               old_w (cdr (assoc 41 d))
   
6.               new_w (* old_w (/ h old_h))
   
7.               d        (subst (cons 40 h) (assoc 40 d) d)
   
8.               d            (subst (cons 41 new_w) (assoc 41 d) d)
   
9.         )
   
10.         (entmod d)
    
11.       )
    

(progn<br />         (setq d        (entget si)<br />               old_h (cdr (assoc 40 d))<br />               old_w (cdr (assoc 41 d))<br />               new_w (* old_w (/ h old_h))<br />               d        (subst (cons 40 h) (assoc 40 d) d)<br />               d            (subst (cons 41 new_w) (assoc 41 d) d)<br />         )<br />         (entmod d)<br />       )<br />

啵浪鼓

谢谢david96007,你前面的回答我还没来得及说谢呢,你真是热心,感动ing

能告诉我你的QQ吗:

我是从事五金模具设计工作的,希望以后请多指教~!
QQ:22903161
QQ群:9803179
邮箱:jacky_2k@163.com

david96007

不好意思，没有QQ！上网从不聊天，从不玩游戏！是不是很落伍啊？！

ahbbwcc

change命令不能改变字的高度

啵浪鼓

呵呵,真得很落"无"

xyp1964

sub_upd自定义函数的用法：
格式：(sub_upd obj dxfmode value)
说明：obj，实体；dxfmode，dxf代码；value，dxf代码所对应的修改值。
实例，改变字的高度为500：(sub_upd (car(entsel)) 40 500)

啵浪鼓

哦,lisp好多函数都不知道,买的书也大多没时间看,只有在网上看看高手们的杰作自已再东拼西凑一番,呵呵~!

saoaduan

送上一个我自己写的，简简单单，不象楼上的兄弟那样有那么多行



;;改文字高度

(defun c:th ( / ent ent_date old_gd_list old_gd new_gd new_gd_list)
   (setq ent (entsel "\n请选择要改高度文字："))
   (setq ent_date (entget (car ent)))
   (setq old_gd_list (assoc 40 ent_date))
   (setq old_gd (cdr old_gd_list))
   (princ "\n原文字高度为＝")
   (princ old_gd)
   (setq new_gd (getreal "请输入新的高度："))
   (setq new_gd_list (cons 40 new_gd))
   (setq ent_date (subst new_gd_list old_gd_list ent_date))
   (entmod ent_date)
   (princ)
)
(prompt  "\n******th--改文字高度******")
(princ)

狂刀

下面这一句的命令scaletext会出现溢出的现象,也就是选了很多MTEXT后此指令就不能再写了,好像是占用了内存还是什么的,必须是重开图档或是重启CAD此指令才生效,如果运行了多次又得重开了,唉!搞不懂了
(if (= "MTEXT" (cdr (assoc 0 (entget si))))
(command "scaletext" si "" "existing" h))


scaletext支持选集,如果不考虑dim,.一句话搞定

(command ".scaletext" (ssget) "" "" )

另：ｘｙｐ长老的程序　ｃｔ有缺陷
１．不支持属性．
２．测试过程中倾斜的ｍｔｅｘｔ会改变方向
３．ｄｉｍ字高修改实际意义有待思考．如果全局比例不是１，改出的字高不是真实字高．

我写了一个，大伙试试看
xth = 更改字高 -----------by 狂刀
支持: *TEXT,ATTRIBUTE, ATTDEF,DIMENSION,LEADER.
　支持预选.
转贴的网页里有下载连接和演示

[iframe h=600 w=100%]http://www.xdcad.net/forum/showthread.php?s=&postid=1779428#post1779428[/iframe]