baoxiaozhong 发表于 2016-7-5 09:30:17

批量修改文字高度及型式

(defun c:fixtext ( / ss1 index newht newstyle styledata defwidth ename txtobj)
(setq ss1 (ssget (list (cons 0 "*text")))
      index 0
      newht (getstring "\n输入文字高度: ")
      newstyle (getstring "\输入文字型式: ")
)
(if (setq styledata (tblsearch "style" newstyle))
    (progn
       (setq defwidth (cdr (assoc 41 styledata)))
       (while (setq ename (ssname ss1 index))
            (setq txtobj (vlax-ename->vla-object ename))
            (vlax-put-property txtobj 'Height newht)
            (vlax-put-property txtobj 'StyleName newstyle)
            (if (vlax-property-available-p txtobj 'ScaleFactor)
                  (vlax-put-property txtobj 'ScaleFactor defwidth)
            )
            (setq index (1+ index))
       )
    )
    (princ "\n输入文字型式不存在!")
)
(princ)
)如何在输入文字高度及输入文字型式这二行增加，如果输入为空白(直接按ENTER)，自定输入为某值?

chg 发表于 2016-7-5 12:45:09

本帖最后由 chg 于 2016-7-5 12:47 编辑

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

baoxiaozhong 发表于 2016-7-5 13:20:47

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

(defun c:fixtext ( / ss1 index newht newstyle styledata defwidth ename txtobj)
(setq ss1 (ssget (list (cons 0 "*text")))
      index 0
      (initget 128)
      (setq newht (getstring "\输入文字高度: <375>"))
       (if (null newht)
      (progn
         (setq newht 375)
      )
       )
      (setq newstyle (getstring "\n输入文字型式: <aa-txt>"))
       (if (null newstyle)
      (progn
         (setq newstyle aa-txt)
      )
       )
      
)
(if (setq styledata (tblsearch "style" newstyle))
    (progn
       (setq defwidth (cdr (assoc 41 styledata)))
       (while (setq ename (ssname ss1 index))
            (setq txtobj (vlax-ename->vla-object ename))
            (vlax-put-property txtobj 'Height newht)
            (vlax-put-property txtobj 'StyleName newstyle)
            (if (vlax-property-available-p txtobj 'ScaleFactor)
                  (vlax-put-property txtobj 'ScaleFactor defwidth)
            )
            (setq index (1+ index))
       )
    )
    (princ "\n文字型式不存在")
)
(princ)
)依你上面的说明进行修改，但是显示文法错误，是那里错了?

ll_j 发表于 2016-7-5 16:12:03

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

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

baoxiaozhong 发表于 2016-7-5 16:46:32

ll_j 发表于 2016-7-5 16:12 static/image/common/back.gif
输入文字高度使用getdist，不是使用getstring。

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

ll_j 发表于 2016-7-5 17:01:58

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

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

baoxiaozhong 发表于 2016-7-5 17:26:22

本帖最后由 baoxiaozhong 于 2016-7-5 17:30 编辑

ll_j 發表於 2016-7-5 17:01 static/image/common/back.gif
第一個setq的閉括號位置錯了。
格式化後已經可以看出，initget開始的輸入部分已經變成setq的內容了。
我用過 ULTRAEDIT 的LISP 格式確認過了，第一個 setq ss1 左括號，確認是對應到輸入文字型式的右括號後面，也就是第六個setq之前的if 左括號前，我上面編碼排版，就是我用 ULTRAEDIT 調整過的。

ll_j 发表于 2016-7-5 19:36:06

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

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

baoxiaozhong 发表于 2016-7-5 20:59:32

ll_j 发表于 2016-7-5 19:36 static/image/common/back.gif
这一段：

已解決了，謝謝。

kugoo999 发表于 2019-1-23 16:31:15

很强大，谢谢
页: [1]
查看完整版本: 批量修改文字高度及型式