自动编号

gduthy

(defun c:bh (/ oce1 qz n1 zn h1 sxh1 p1) ;自动编号

  (setq oce1 (getvar "cmdecho"))
  (setvar "cmdecho" 0)
                                        ;(command "-style" "BG_ST" "宋体" 0 0.8 0 "n" "n")
  (c:zt)
  (c:zg)
                                        ;(setq qz (getstring "\n请输入前缀相同的部分: "))
                                        ;(if (not (setq n1 (getint "\n请输入起始顺序号 <1>: ")))
  (setq n1 1)
  (setq qz "")
                                        ;)
                                        ;(if (not (setq zn (getint "\n请输入增加或减少的序数 <+1>: ")))
  (setq zn 1)
                                        ;)
                                        ;(if (not (setq h1 (getreal "\n请指定文字高度 <2.5>: ")))
                                        ;(setq h1 2.5)
                                        ;)
  (setq h1 zigao)
  (setq
    sxh1 (strcat qz (itoa n1))
    p1         (getpoint "\n请指定点: ")
  )
  (while (/= p1 nil)
    (command "text" "m" p1 h1 0 sxh1)
    (setq
      n1   (+ n1 zn)
      sxh1 (strcat qz (itoa n1))
      p1   (getpoint "\n请指定下一点: ")
    )
  )
  (setvar "cmdecho" oce1)
  (princ)
)

gduthy

(defun c:zt ()                                ;创建字体
  (setvar "cmdecho" 0)
  (setq dqzt (getvar "textstyle"))
  (princ "\n请选择需要创建的字体：")
  (setq
    zti        (getstring
          (strcat "\n请选择需要创建的字体[(1)HZ/(2)左倾宋体/(3)黑体]<"
                  dqzt
                  ">："
          )
        )
  )
  (cond
    ((= zti "") (setvar "textstyle" dqzt))
    ((= zti "1") (C:HanZi))
    ((= zti "2") (C:SONGTI))
    ((= zti "3") (C:HEITI))
    (T (progn (PRINC "\n输入无效！") (setq zti nil)))
  )
  (princ)
)

(defun c:songti        ()                        ;创建左倾宋体样式
  (setvar "cmdecho" 0)
  (if (= (Tblsearch "style" "左倾宋体") nil)
    (progn
                                        ;  (vl-load-com)
                                        ;  (setq ThisDrawing (vla-get-activedocument (vlax-get-acad-object)))
                                        ;  (Setq TextStyles (vla-get-TextStyles ThisDrawing))
                                        ; (Setq TextStyle (vla-add TextStyles "宋体"))
                                        ;  (vla-SetFont TextStyle "宋体" :vlax-false :vlax-false 1 0)

      (command "-style" "左倾宋体" "simsunb.ttf" 0 0.8 0 "n" "n")
      (princ "\n左倾宋体样式创建完成！") ;创建左倾宋体样式

    )
    (progn (command "-style" "左倾宋体" "simsunb.ttf" 0 0.8 0 "n" "n")
           (princ "\n左倾宋体样式已存在！")
    )
  )
  (setvar "textstyle" "左倾宋体")
  (setvar "dimtxsty" "左倾宋体")        ;置前

  (princ)
)

(defun C:ZG ()                                ;字高
  (if (= ZIGAO nil)
    (progn
      (initget 6 "Z")
      (setq ZIGAO (GETREAL "\n 输入字高[(Z)选择指定文字字高]："))
      (if (= ZIGAO "Z")
        (wzh)
      )
      (if (/= ZIGAO nil)
        (progn
          (setq ZIGAOys ZIGAO)
          (setq ZIGAOyss (rtos ZIGAOys 2 2))
        )
        (setq ZIGAO    1
              ZIGAOys  ZIGAO
              ZIGAOyss (rtos ZIGAOys 2 2)
        )
      )
    )
    (progn
      (initget 6 "Z")
      (setq ZIGAO
             (GETREAL (strcat "\n输入字高[(Z)选择指定文字字高]：<"
                              (rtos ZIGAO 2 2)
                              ">："
                      )
             )
      )
      (if (= ZIGAO "Z")
        (wzh)
      )
      (if (/= ZIGAO nil)
        (progn
          (setq ZIGAOys ZIGAO)
          (setq ZIGAOyss (rtos ZIGAOys 2 2))
        )
        (if zigaoys
          (setq ZIGAO ZIGAOys)
          (setq ZIGAO 1)
        )
      )
    )

  )
  (if (and (/= zigao 0) (/= zigao nil))
    (progn
      (setvar "dimtxt" ZIGAO)
      (setvar "DIMASZ" ZIGAO)
    )
  )
  (princ)
)


加上这两个函数

yanshengjiang

; ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^  
;数字递增编号对话框版  2011年9月6日 21:00:20  by yanshengjiang
;对于打印A4图纸时候进行编号，效果还行
; ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^  
(defun c:bh()
     (vl-catch-all-apply
    '(lambda();出错处理
         (setvar "cmdecho" 0)
       (command "undo" "be")
  (bh-dcl_te_bh)
(setq qd(read qd)
       zl(read zl)
       )
(setq sxh1 (strcat (vl-princ-to-string qz) (vl-princ-to-string qd)) p1 (getpoint "\n请指定插入点: "))
  (while (/= p1 nil)
    (command "text" "m" p1 h 0 sxh1)
    (setq qd (+ qd zl)
          sxh1 (strcat  (vl-princ-to-string qz)  (vl-princ-to-string qd))
          p1 (getpoint "\n请指定下一插入点: "))
     )
       (command "undo" "e")
(vl-file-delete Dcl_File)
(unload_dialog dcl_id)
  ));出错处理
  (princ)
)

(defun bh-dcl_te_bh()
  (setq dcl_id (load_dialog (setq Dcl_File (bh-dclfottext_bh))))
  (new_dialog "text2" dcl_id)
  (set_tile "qz" "")
  (set_tile "qd" "1")
  (mode_tile "qd" 2)
  (set_tile "zl" "1")
  (set_tile "h" "10")
  (action_tile "accept" "(bh-ok_te_bh)(done_dialog 1)")
  (start_dialog)
)

(defun bh-ok_te_bh()
  (setq qz  (get_tile "qz"))
  (setq qd (get_tile "qd"))
  (setq zl (get_tile "zl"))
  (setq h (get_tile "h"))
)
;写dcl
(defun bh-dclfottext_bh()
(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=\"qz\";edit_width=10;" file)
  (write-line "              }" file)
  (write-line "              :edit_box{label=\"起始点号\";key=\"qd\";edit_width=10;" file)
  (write-line "              }" file)
  (write-line "              :edit_box{label= \"增    量\"; key= \"zl\";edit_width=10;}"  file)
  (write-line "              :edit_box{label= \"字    高\"; key=\"h\";edit_width=10;"  file)
  (write-line "              }" file)
  (write-line "                ok_cancel;" file)
  (write-line "              }" file)
   (close file)
  Dcl_File
  )

gduthy

1694628497 发表于 2020-4-15 15:14
用不了，垃圾啊

  (c:zt)
  (c:zg)
还有两个设置字体和字高的函数没放上来

1694628497

用不了，垃圾啊

rocking2008

确实用不了。

gduthy

rocking2008 发表于 2020-4-15 16:00
确实用不了。

  (c:zt)
  (c:zg)
还有两个设置字体和字高的函数没放上来

gduthy

所缺函数在6楼

paulpipi

cghdy

什么功能不搞个图片或gif