批量修改文字高度及型式

baoxiaozhong

2. (defun c:fixtext ( / ss1 index newht newstyle styledata defwidth ename txtobj)
   
3. (setq ss1 (ssget (list (cons 0 "*text")))
   
4.       index 0
   
5.       newht (getstring "\n输入文字高度: ")
   
6.       newstyle (getstring "\输入文字型式: ")
   
7. )
   
8. (if (setq styledata (tblsearch "style" newstyle))
   
9.     (progn
   
10.        (setq defwidth (cdr (assoc 41 styledata)))
    
11.        (while (setq ename (ssname ss1 index))
    
12.               (setq txtobj (vlax-ename->vla-object ename))
    
13.               (vlax-put-property txtobj 'Height newht)
    
14.               (vlax-put-property txtobj 'StyleName newstyle)
    
15.               (if (vlax-property-available-p txtobj 'ScaleFactor)
    
16.                   (vlax-put-property txtobj 'ScaleFactor defwidth)
    
17.               )
    
18.               (setq index (1+ index))
    
19.        )
    
20.     )
    
21.     (princ "\n输入文字型式不存在!")
    
22. )
    
23. (princ)
    
24. )

(defun c:fixtext ( / ss1 index newht newstyle styledata defwidth ename txtobj)<br /> (setq ss1 (ssget (list (cons 0 "*text")))<br />       index 0<br />       newht (getstring "\n输入文字高度: ")<br />       newstyle (getstring "\输入文字型式: ")<br /> )<br /> (if (setq styledata (tblsearch "style" newstyle))<br />     (progn<br />        (setq defwidth (cdr (assoc 41 styledata)))<br />        (while (setq ename (ssname ss1 index))<br />               (setq txtobj (vlax-ename->vla-object ename))<br />               (vlax-put-property txtobj 'Height newht)<br />               (vlax-put-property txtobj 'StyleName newstyle)<br />               (if (vlax-property-available-p txtobj 'ScaleFactor)<br />                   (vlax-put-property txtobj 'ScaleFactor defwidth)<br />               )<br />               (setq index (1+ index))<br />        )<br />     )<br />     (princ "\n输入文字型式不存在!")<br /> )<br /> (princ)<br /> )

如何在输入文字高度及输入文字型式这二行增加，如果输入为空白(直接按ENTER)，自定输入为某值?

chg

(initget 128)
(setq newht (getstring "\n输入文字高度: <3>"))
;;;如果直接回车，就默认高度是3，这里也可以用一个全局变量记住上次输入的数值
;;判断是否是直接回车
（if (null newht)
   (progn
    (setq newht 3)......
    )))
;;下面的方法和这个一样

baoxiaozhong

chg 发表于 2016-7-5 12:45
(initget 128)
(setq newht (getstring "\n输入文字高度: "))
;;;如果直接回车，就默认高度是3，这里也可 ...

2. (defun c:fixtext ( / ss1 index newht newstyle styledata defwidth ename txtobj)
   
3. (setq ss1 (ssget (list (cons 0 "*text")))
   
4.       index 0
   
5.       (initget 128)
   
6.       (setq newht (getstring "\输入文字高度: <375>"))
   
7.        (if (null newht)
   
8.         (progn
   
9.          (setq newht 375)
   
10.         )
    
11.        )
    
12.       (setq newstyle (getstring "\n输入文字型式: <aa-txt>"))
    
13.        (if (null newstyle)
    
14.         (progn
    
15.          (setq newstyle aa-txt)
    
16.         )
    
17.        )
    
18.       
    
19. )
    
20. (if (setq styledata (tblsearch "style" newstyle))
    
21.     (progn
    
22.        (setq defwidth (cdr (assoc 41 styledata)))
    
23.        (while (setq ename (ssname ss1 index))
    
24.               (setq txtobj (vlax-ename->vla-object ename))
    
25.               (vlax-put-property txtobj 'Height newht)
    
26.               (vlax-put-property txtobj 'StyleName newstyle)
    
27.               (if (vlax-property-available-p txtobj 'ScaleFactor)
    
28.                   (vlax-put-property txtobj 'ScaleFactor defwidth)
    
29.               )
    
30.               (setq index (1+ index))
    
31.        )
    
32.     )
    
33.     (princ "\n文字型式不存在")
    
34. )
    
35. (princ)
    
36. )

(defun c:fixtext ( / ss1 index newht newstyle styledata defwidth ename txtobj)<br /> (setq ss1 (ssget (list (cons 0 "*text")))<br />       index 0<br />       (initget 128)<br />       (setq newht (getstring "\输入文字高度: <375>"))<br />        (if (null newht)<br />         (progn<br />          (setq newht 375)<br />         )<br />        ) <br />       (setq newstyle (getstring "\n输入文字型式: <aa-txt>"))<br />        (if (null newstyle)<br />         (progn<br />          (setq newstyle aa-txt)<br />         )<br />        )<br />       <br /> )<br /> (if (setq styledata (tblsearch "style" newstyle))<br />     (progn<br />        (setq defwidth (cdr (assoc 41 styledata)))<br />        (while (setq ename (ssname ss1 index))<br />               (setq txtobj (vlax-ename->vla-object ename))<br />               (vlax-put-property txtobj 'Height newht)<br />               (vlax-put-property txtobj 'StyleName newstyle)<br />               (if (vlax-property-available-p txtobj 'ScaleFactor)<br />                   (vlax-put-property txtobj 'ScaleFactor defwidth)<br />               )<br />               (setq index (1+ index))<br />        )<br />     )<br />     (princ "\n文字型式不存在")<br /> )<br /> (princ)<br /> )

依你上面的说明进行修改，但是显示文法错误，是那里错了?

ll_j

baoxiaozhong 发表于 2016-7-5 13:20
依你上面的说明进行修改，但是显示文法错误，是那里错了?

输入文字高度使用getdist，不是使用getstring。

baoxiaozhong

ll_j 发表于 2016-7-5 16:12
输入文字高度使用getdist，不是使用getstring。

修正为 getdist ，还是会出现文法错误，如果没有新设判断语法，getstring是可以正常执行的。

ll_j

baoxiaozhong 发表于 2016-7-5 16:46
修正为 getdist ，还是会出现文法错误，如果没有新设判断语法，getstring是可以正常执行的。

第一个setq的闭括号位置错了。
格式化后已经可以看出，initget开始的输入部分已经变成setq的内容了。

baoxiaozhong

ll_j 發表於 2016-7-5 17:01
第一個setq的閉括號位置錯了。
格式化後已經可以看出，initget開始的輸入部分已經變成setq的內容了。

我用過 ULTRAEDIT 的LISP 格式確認過了，第一個 setq ss1 左括號，確認是對應到輸入文字型式的右括號後面，也就是第六個setq之前的if 左括號前，我上面編碼排版，就是我用 ULTRAEDIT 調整過的。

ll_j

baoxiaozhong 发表于 2016-7-5 17:26
我用過 ULTRAEDIT 的LISP 格式確認過了，第一個 setq ss1 左括號，確認是對應到輸入文字型式的右括號後面 ...

这一段：

1. (defun c:fixtext ( / ss1 index newht newstyle styledata defwidth ename txtobj)
   
2. (setq ss1 (ssget (list (cons 0 "*text")))      index 0
   
3. )                                                         ;比括号应该在这里
   
4.       (initget 128)
   
5.       (setq newht (getstring "\输入文字高度: <375>"))
   
6.        (if (null newht)
   
7.         (progn         (setq newht 375)        )
   
8.        )
   
9.       (setq newstyle (getstring "\n输入文字型式: <aa-txt>"))
   
10. ...
    

(defun c:fixtext ( / ss1 index newht newstyle styledata defwidth ename txtobj)<br /> (setq ss1 (ssget (list (cons 0 "*text")))      index 0<br /> )                                                         ;比括号应该在这里<br />       (initget 128)<br />       (setq newht (getstring "\输入文字高度: <375>"))<br />        (if (null newht)<br />         (progn         (setq newht 375)        )<br />        ) <br />       (setq newstyle (getstring "\n输入文字型式: <aa-txt>")) <br /> ...<br />

baoxiaozhong

ll_j 发表于 2016-7-5 19:36
这一段：

已解決了，謝謝。

kugoo999

很强大，谢谢