[原创]：匹配字高 --- xdapi & Vlisp 方式对照

eachy

;;                                                                         ;;
;; 今后将陆续提供一些程序的讲解，主要以本人所写的程序为主（晓东工具箱中的程;;
;; 序尽可能提供 api 与 Vlisp 对照方式。希望这种方式可以给大家学习lisp以更大;;
;; 的帮助，而不仅仅是把源码贴上来。同时希望有时间和愿意为论坛作些奉献的朋友;;
;; 参与到源码讲解中来，可以是自己的程序，也可以用搜集来的程序，讲讲思路，中;;
;; 间有什么技巧，即授人以鱼同时也授人以渔。程序不论难易，只要你有心就够了。;;
;;                                                                         ;;

[PHP]
;; 匹配字高 --- xdapi & Vlisp 方式对照
;;=========================================================================;;
;;                                                                         ;;
;;   本程序仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊用  ;;
;;   途之适应性, 以及商业销售所隐含作出的保证, 在此一概予以否认。          ;;
;;                                                                         ;;
;;                      晓东家园 [www .xdcad.net] 作者： eachy 2004.04.06   ;;
;;                                                                         ;;
;;                                                      eachy @ xdcad.net    ;;
;;=========================================================================;;
;;                                                                         ;;
;; 以下程序为本人为晓东工具箱中所写的一个程序，程序中使用的是XDAPI，这里   ;;
;; 用Vlisp的方式写出来，大家可以对比着理解学习 xdapi 和 Vlisp/Lisp         ;;
;;                                                                         ;;
;; xdrx_entsel 功能Lisp类似方式参见论坛相关帖子                            ;;
;;                                                                         ;;
;; ea:string_tok 功能为字符串拆分，参见论坛以前帖子                        ;;
;;                                                                         ;;
;; xdrx_begin xdrx_end Lisp类似方式参加论坛  ea:begin ea:end 相关帖子      ;;
;;                                                                         ;;
;; ea:clearset 清除Acitve选择集 Item BUG，参见论坛相关帖子                 ;;
;;                                                                         ;;
;; 相关讨论建议请访问 晓东CAD家园   http :// www .xdcad .net[/url]                   ;;
;;                                                                         ;;
;;-------------------------------------------------------------------------;;
;; 功能：匹配字高，使某一高度范围内文字统一修改至指定高度                  ;;
;;-------------------------------------------------------------------------;;
;;                                                                         ;;
;;         *****转贴或修改请保持以上完整信息*****                          ;;
;;                                                                         ;;
;;=========================================================================;;
;|
本程序重点是构造字高的选择集，

技巧：

1 在 if 条件中 用 or 构造不同的选项条件

2 程序结构上对 activeselectionset 的应用
|;
(defun c:ematch_txth (/                tf          e            #txth
                      #filter_txth          #filter   #string   ss
                      obj        thisdrawing
                     )
  (princ "\n\t欢迎使用 晓东家园 [www .xdcad .net] CAD辅助工具!")
  (ea:clearset)
  (if (or (setq e (entsel "\n选择源文字确定高度<回车输入高度>: "));双重选项
          (setq #txth (getreal "\n输入文字高度: "))
      )
    (progn
      (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
      (vla-startundomark thisdrawing)        ;xdrx_begin
      (if e
        (progn
          (setq obj (vlax-ename->vla-object (car e)))
          (setq #txth (vla-get-height obj)) ;xdrx_getentdxf
        )
      )
      (setq tf t)
      (while tf
        (if (or
              (wcmatch (setq #filter_txth
                              (getstring "\n输入字高或字高范围<用逗号隔开>: ")
                       )
                       "*`,*"
              )                                ;获取字高范围
              (numberp (read #filter_txth)) ;检验是否是数字
            )
          (progn
            (setq #string (ea:string_tok #filter_txth ","));xdrx_string_tok
            (setq #filter (if (numberp (read #filter_txth))
                            (progn
                              (list '(0 . "*text")
                                    (cons 40 (read #filter_txth))
                              )
                            )
                            (progn
                              (list '(-4 . "<and")
                                    '(0 . "*text")
                                    '(-4 . ">=")
                                    (cons 40 (read (car #string)))
                                    '(-4 . "<=")
                                    (cons 40 (read (last #string)))
                                    '(-4 . "and>")
                              )
                            )
                          )
            )                                ;构造过滤表
            (princ "\n选择目标文字<回车全选>....")
            (if        (not (setq ss (ssget #filter)))
              (setq ss (ssget "x" #filter))
            )
            ;;以上部分还可以这样
            ;;(princ "\n选择目标文字[All - 全选]....")
            ;; if (ssget #filter)
            ;; 这样可以省去 ss 变量，当然如果用到删除命令还是保留 ss 好
            ;; 在循环内采用 vla-delete 还不如 earse ss 高效
            (if        ss                        ;还是判断一下保险
              (vlax-for        i (vla-get-activeselectionset thisdrawing);xdrx_setsstodb
                (vla-put-height i #txth) ;xdrx_modent
              )
            )
            (setq tf nil)
          )
          (princ "\n\t输入间隔符错误或非数字，重新输入!!!")
        )
      )
      (vla-endundomark thisdrawing)        ;xdrx_end
    )
    (setq tf nil)
  )
  (princ)
)
(princ "\n\t*欢迎使用 晓东家园 [www .xdcad .net] CAD辅助工具*")
(princ "\n\t命令: Ematch_txth 功能: 匹配字高   作者:  eachy")
(princ)

[/PHP]

陌生人

建议(getreal "\n输入文字高度: ")用 getdist
(numberp (read #filter_txth)) ;检验是否是数字 建议用 (distof (#filter_txth))
(if    (not (setq ss (ssget #filter)))
          (setq ss (ssget "x" #filter))
        )
还可以用(or (setq ss (ssget #filter)(setq ss (ssget "x" #filter))

心梦相随

取数值用这个也行
(initget 6)(setq h(getreal"\n输入文字高度: "))拒绝负值或零