TEXT的DCL版 (明镜亦非台）

yanshengjiang

                             为庆祝论坛发言不乱码，特贴上我这个dcl处女作
；网上收集大部分素材，整理所得。感谢各位前辈

；通过读写txt文件的方式记录上次注记的字高和角度
；其中或许图上所有图层和文字样式的程序是网上收集的，感觉很爽感。。。
；整理 by  明镜亦非台（yanshengjiang）
; ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^  
;文字注记对话框版，替换南方cass的T命令效果还行
;智能记住上次注记的字高和旋转角度
;文字注记  2011年9月6日 21:00:20  by yanshengjiang
; ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^  
(defun c:t(/ te h x pt sty lay style layer dcl_id dcl_file lujin file d dd len pop layer2 layername)
  (setvar "cmdecho" 0)
  (setq te nil pt nil sty nil lay nil h nil)
  (vl-catch-all-apply
    '(lambda();出错回显
(text2-dcl_te)
(if (= te "")
   (exit)
  (progn
   (if (= sty nil) (setq sty (nth 0 style)))  
   (if (= lay nil) (setq lay (nth 0 layer)))
   (if (= x nil)(setq x "0"))
  (if (/= nil te)
;(entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") '(62 . 256)
;(CONS 1 te) (CONS 10 pt)(cons 40 (read h)) '(41 . 0.8) '(50 . 0.0)(cons 8 lay)(cons 7 sty)  ))
    (progn
    (setq pt (getpoint"\n指定点"))
    (command "_.text" "s" sty "j" "m" pt h x te "_.change" (entlast) "" "p" "la" lay "")
    )
);if
  (xie-text2-txt)
  (unload_dialog dcl_id)
  (vl-file-delete Dcl_File)

));if progn
       ));出错回显
(princ)
);defun
(defun text2-dcl_te();驱动
  (setq dcl_id (load_dialog (setq Dcl_File (text2-dclfottext))))
  (new_dialog "text2" dcl_id)
  (set_tile "te" "")
  (du-text2-txt)
  (if (= nil h)(setq h "1.5"))
  (if (= nil x)(setq x "0"))
  (set_tile "h" h)
  (set_tile "x" x)
      (setq style (cyanqq))
      (setq layer (get_all_layer))
      (show_list_yan "sty" style)
      (show_list_yan "lay" layer)
    (action_tile "sty" "(setq pop 1)(sub_pop $value)")
    (action_tile "lay" "(setq pop 2)(sub_pop $value)")
  (action_tile "accept" "(text2-ok_te)(done_dialog 1)")
  (start_dialog)
)
(defun text2-ok_te();驱动
  (setq te (vl-princ-to-string (get_tile "te")))
  (setq h (vl-princ-to-string (get_tile "h")))
  (setq x (vl-princ-to-string (get_tile "x")))
  ;(setq sty(get_tile "sty"))
; (setq lay(get_tile "lay"))
)
;写dcl
(defun text2-dclfottext()
  (setq Dcl_File (vl-filename-mktemp nil nil))
  (setq lujin(vl-filename-directory Dcl_File))
  (setq Dcl_File (strcat lujin "\\文字注记.dcl"))
  (setq file (open Dcl_File "w"))
  (write-line "text2:dialog{" file)
  (write-line " label= \"文字注记                    \";" file)
  (write-line " :edit_box{label=\"文字内容\";key=\"te\";edit_width=70;fixed_width = true;}" file)
  (write-line " :boxed_row{" file)
  (write-line " :edit_box{label= \"文字高度\"; key= \"h\";edit_width=3;fixed_width = true;}"  file)
  (write-line " :edit_box{label= \"旋转角度\"; key=\"x\";edit_width=3;fixed_width = true;}"  file)
        (write-line ": popup_list {label=\"样式\";key = \"sty\";edit_width = 10;fixed_width = true;fixed_width = true;}" file)
        (write-line ": popup_list {label=\"图层\";key = \"lay\";edit_width = 10;fixed_width = true;fixed_width = true;}" file)
        (write-line "spacer_1;" file)
  (write-line "              }" file)      
  (write-line "                ok_cancel;" file)
  (write-line "              }" file)
   (close file)
  Dcl_File
  )
;写txt
(defun xie-text2-txt()
  (setq text2-txt_File (vl-filename-mktemp nil nil))
  (setq lujin(vl-filename-directory text2-txt_File))
  (setq text2-txt_File (strcat lujin "\\文字注记.txt"))
  (setq file (open text2-txt_File "w"))
  (write-line (strcat "字高:" h) file)
  (write-line (strcat "旋转:" x) file)
  (close file)
  )
;读txt
(defun du-text2-txt()
  (setq text2-txt_File (vl-filename-mktemp nil nil))
  (setq lujin(vl-filename-directory text2-txt_File))
  (setq text2-txt_File (strcat lujin "\\文字注记.txt"))
(if (setq file (open text2-txt_File "r"))
  (while
    (setq d (read-line file))
    (setq len (strlen d))
    (if (/= 0 len)
(setq dd(substr d 1 4))
)
  (if (= dd "字高")(setq h (substr d 6 (- len 5))))
  (if (= dd "旋转")(setq x (substr d 6 (- len 5))))
    )
   )
  )
;==========================================================================
  (defun get_all_style (/ sty style sty_list);得到图内所有字体样式
    ;;;示例  ("FS" "HT" "HZ" "KHZ" "STANDARD" "等线体" "仿宋体" "楷体" "宋体")
    (setq sty_list nil
   sty (tblnext "style" t)
    )
    (setq style (cdr (assoc 2 sty)))
    (while style
      (if (/= "" style)
(setq sty_list (append
    sty_list
    (list style)
         )
)
      )
      (setq sty (tblnext "style"))
      (setq style (cdr (assoc 2 sty)))
    )           ; end while]
    (setq sty_list (ACAD_Strlsort sty_list))
    sty_list
  ); end defun
(defun cyanqq(/ style n x nt xh st)
  (setq style (get_all_style));得到字体列表
;;;  (mapcar  '(lambda (x) (= x "HZ")) style)
  (setq n (vl-list-length style));表内元素个数
  (setq x 0)
(while (< x n);
    (setq nt (nth x style))
    (if (= nt "HZ");
      (progn;
(setq xh x)
(setq x n)
      );progn
    );if
(setq x (1+ x))
    );while
  (if (and(<= xh n)(= nt "HZ"))
    (Setq st (cons "HZ" (vl-remove "HZ" style)))
    (setq st style)
    );if
);defun


;==========================================================================
  (defun get_all_layer (/ lay layer2 layname);;;;;得到图层列表。。。
    (setq layer2 nil         
   lay (tblnext "LAYER" T)
    )
    (while (/= lay nil)
      (setq layname (cdr (assoc 2 lay))
     layer2 (cons layname layer2)
      )
      (setq lay (tblnext "LAYER"))
    )
    (setq layer2 (ACAD_Strlsort layer2))
    layer2         
   )  
;=======================显示下拉列表=============================
(defun show_list_yan(key newlist)
   (start_list key)
   (mapcar 'add_list newlist)
   (end_list)
)

;=======================设置下拉内容=============================
(defun sub_pop(vvs)
   (if (= pop 1)(setq sty (nth (atoi vvs) style)))
   (if (= pop 2)(setq lay (nth (atoi vvs) layer)))
)

烟盒迷唇

非常不错，谢谢分享啊

qq1254582201

留名收藏了

tianbob

真的不錯用!!

yanshengjiang

卖沙发了。吼吼

myjping

学习，不错

yanshengjiang

(defun cyanqq(/ style n x nt xh st)
  (setq style (get_all_style));得到字体列表
  (setq No (vl-position "HZ" style))
  (if (/= No nil)
    (Setq st (cons "HZ" (vl-remove "HZ" style)))
    (setq st style)
    );if
  );defun

Michael527

两个cyanqq函数有什么区别？

xhq1954425

先支持后学习！

lincctw_ccl

試了一下
真的不錯用!!

yanshengjiang

Michael527 发表于 2011-9-19 06:38
两个cyanqq函数有什么区别？

功能一样的前提下，精简了很多撒。。。

zctao1966

支持原创！

彻夜，买醉

支持，喜欢