序号标注-----------------源码

自贡黄明儒 · 发表于 2014-3-12 15:00

本帖最后由自贡黄明儒于 2014-3-12 15:44 编辑

序号标注简单繁琐，差不多绘图员都用得着。象PCCAD的序号标注就不错，但如果你没有装PCCAD,打开就看不到了，不通用。
[先吹一下]
本程序用我在明经混了几十年的功力写成，给大家瞬间打通任督促二脉

本程序界面简洁，如图。
采用了(grread T 8)生成序号个数，但基本上看不到闪烁现象，这是我采用了一门独门秘籍。
这项技术,你在《明经》和《晓东》两大论坛上“几乎”看不到，因为它穿着黄帝的新衣。
靠着敏锐的嗅觉，我掀开了这新衣。同时，靠着这嗅觉,打算今年申报10个结构新型专利，力争成功5个，
完成技术部专利申报总量的1/2以上。这意味着接下来的时间里，要少发贴，多写材料。
当猪肉价格5元一斤的时候，我们公司规定，一个专利成果，奖励3K。看看,是不是我快发财了，先祝贺我吧。
因感动于highflybird代码开源，现将《序号标注》源码公之于众，算是为明经做点贡献吧。
高手就别看了

;;主程序
;;*DOC* *HHBH* *HHHZ* *HHQZ* 全局变量
(defun C:HHXH (/ CMD1 PLI1 RETURN#)
;; 错误处理
(defun *error* (msg)
(vl-bt)
(if *DOC*
(_EndUndo *DOC*)
)
(while (not (equal (getvar "cmdnames") "")) (command nil))
(if pli1 (setvar "plinewid" pli1))
(if cmd1 (setvar "cmdecho" cmd1))
(princ "\n 出错啦!")
(princ)
)
;; 设置对话框
(defun setdata ()
(if *HHqz*
(Set_tile "HHqz" *HHqz*)
)
(if *HHbh*
(Set_tile "HHbh" *HHbh*)
)
(if *HHhz*
(Set_tile "HHhz" *HHhz*)
)
)
;; 取得对话框数据
(defun getdata ()
(setq *HHqz* (get_tile "HHqz"))
(setq *HHbh* (get_tile "HHbh"))
(setq *HHhz* (get_tile "HHhz"))
)
;; 对话框
(defun Dialog (/ DCLID FN FNAME LIN)
(setq fname (vl-filename-mktemp nil nil ".dcl"))
(setq fn (open fname "w"))
(write-line
"HHXHSC : dialog {label = "自贡运机集团序号(黄明儒HHXH)";"
fn
)
(write-line " : boxed_column { " fn)
(write-line
" : edit_box {label = "前缀(&Q)"; key = "HHqz"; mnemonic = "Q";edit_width=9;}"
fn
)
(write-line
" : edit_box {label = "起始编号(&B)"; key = "HHbh"; mnemonic = "B"; edit_width=9;value="01";} "
fn
)
(write-line
" : edit_box {label = "后缀(&H)"; key = "HHhz"; mnemonic = "H";edit_width=9;}"
fn
)
(write-line " }" fn)
(write-line " : row{" fn)
(write-line
" : button {label = "取----消(&C)";key = "but_Cancel";is_cancel=true;}"
fn
)
(write-line
" : button {label = "球形序号(&E)";mnemonic = "E";key = "but_o";}"
fn
)
(write-line
" : button {label = "常规序号(&O)";key = "but_OK";is_default=true;}"
fn
)
(write-line " }" fn)
(write-line " }" fn)
(close fn)
(setq fn (open fname "r"))
(setq dclid (load_dialog fname))
(while (or (eq (substr (setq lin (vl-string-right-trim
"" fn)"
(vl-string-left-trim
"(write-line ""
(read-line fn)
)
)
)
1
2
)
"//"
)
(eq (substr lin 1 (vl-string-search " " lin)) "")
(not (eq (substr lin (+ (vl-string-search " " lin) 1) 9)
" : dialog"
)
)
)
)
(new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
(setdata)
(action_tile "but_o" "(getdata)(done_dialog 1)")
(action_tile "but_OK" "(getdata)(done_dialog 2)")
(setq return# (start_dialog))
(unload_dialog dclid)
(close fn)
(vl-file-delete fname)
)
;;主程序
(Dialog)
(or *DOC*
(setq *DOC* (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(_StartUndo *DOC*) ;编组开始
;; (HH:ayOSMode nil) ;关闭捕捉
;;(setq cmd1 (getvar "cmdecho"))
(setq pli1 (getvar "plinewid"))
(setvar "plinewid" 0)
(setvar "cmdecho" 0)
(cond ((= return# 1)
(VL-CATCH-ALL-APPLY 'HH::XHSCe nil)
)
((= return# 2)
(VL-CATCH-ALL-APPLY 'HH::XHSCo nil)
)
)
(setvar "plinewid" pli1)
;;(setvar "cmdecho" cmd1)
;; (HH:ayOSMode T) ;开户捕捉
(_EndUndo *DOC*) ;编组结束
(gc)
(princ "\n 自贡运机集团黄明儒温馨提示序号生成:HHXH")
(princ)
)

;;主程序 
;;*DOC* *HHBH* *HHHZ* *HHQZ* 全局变量 
(defun C:HHXH (/ CMD1 PLI1 RETURN#) 
  ;; 错误处理 
  (defun *error* (msg) 
    (vl-bt) 
    (if        *DOC* 
      (_EndUndo *DOC*) 
    ) 
    (while (not (equal (getvar "cmdnames") "")) (command nil)) 
    (if pli1 (setvar "plinewid" pli1)) 
    (if cmd1 (setvar "cmdecho" cmd1)) 
    (princ "\n 出错啦!") 
    (princ) 
  ) 
  ;; 设置对话框 
  (defun setdata () 
    (if        *HHqz* 
      (Set_tile "HHqz" *HHqz*) 
    ) 
    (if        *HHbh* 
      (Set_tile "HHbh" *HHbh*) 
    ) 
    (if        *HHhz* 
      (Set_tile "HHhz" *HHhz*) 
    ) 
  ) 
  ;; 取得对话框数据 
  (defun getdata () 
    (setq *HHqz* (get_tile "HHqz")) 
    (setq *HHbh* (get_tile "HHbh")) 
    (setq *HHhz* (get_tile "HHhz")) 
  ) 
  ;; 对话框 
  (defun Dialog        (/ DCLID FN FNAME LIN) 
    (setq fname (vl-filename-mktemp nil nil ".dcl")) 
    (setq fn (open fname "w")) 
    (write-line 
      "HHXHSC : dialog {label = "自贡运机集团 序号(黄明儒HHXH)";" 
      fn 
    ) 
    (write-line "        : boxed_column {           " fn) 
    (write-line 
      "          : edit_box {label = "前    缀(&Q)"; key = "HHqz"; mnemonic = "Q";edit_width=9;}" 
      fn 
    ) 
    (write-line 
      "          : edit_box {label = "起始编号(&B)"; key = "HHbh"; mnemonic = "B"; edit_width=9;value="01";} " 
      fn 
    ) 
    (write-line 
      "          : edit_box {label = "后    缀(&H)"; key = "HHhz"; mnemonic = "H";edit_width=9;}" 
      fn 
    ) 
    (write-line "        }" fn) 
    (write-line "        : row{" fn) 
    (write-line 
      "          : button {label = "取----消(&C)";key = "but_Cancel";is_cancel=true;}" 
      fn 
    ) 
    (write-line 
      "          : button {label = "球形序号(&E)";mnemonic = "E";key = "but_o";}" 
      fn 
    ) 
    (write-line 
      "          : button {label = "常规序号(&O)";key = "but_OK";is_default=true;}" 
      fn 
    ) 
    (write-line "       }" fn) 
    (write-line "    }" fn) 
    (close fn) 
    (setq fn (open fname "r")) 
    (setq dclid (load_dialog fname)) 
    (while (or (eq (substr (setq lin (vl-string-right-trim 
                                       "" fn)" 
                                       (vl-string-left-trim 
                                         "(write-line "" 
                                         (read-line fn) 
                                       ) 
                                     ) 
                           ) 
                           1 
                           2 
                   ) 
                   "//" 
               ) 
               (eq (substr lin 1 (vl-string-search " " lin)) "") 
               (not (eq        (substr lin (+ (vl-string-search " " lin) 1) 9) 
                        " : dialog" 
                    ) 
               ) 
           ) 
    ) 
    (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid) 
    (setdata) 
    (action_tile "but_o" "(getdata)(done_dialog 1)") 
    (action_tile "but_OK" "(getdata)(done_dialog 2)") 
    (setq return# (start_dialog)) 
    (unload_dialog dclid) 
    (close fn) 
    (vl-file-delete fname) 
  ) 
 
  ;;主程序 
  (Dialog) 
  (or *DOC* 
      (setq *DOC* (vla-get-ActiveDocument (vlax-get-acad-object))) 
  ) 
  (_StartUndo *DOC*)                                  ;编组开始 
 ;; (HH:ayOSMode nil)                                  ;关闭捕捉 
  ;;(setq cmd1 (getvar "cmdecho")) 
  (setq pli1 (getvar "plinewid")) 
  (setvar "plinewid" 0) 
  (setvar "cmdecho" 0) 
  (cond        ((= return# 1) 
         (VL-CATCH-ALL-APPLY 'HH::XHSCe nil) 
        ) 
        ((= return# 2) 
         (VL-CATCH-ALL-APPLY 'HH::XHSCo nil) 
        ) 
  ) 
  (setvar "plinewid" pli1) 
  ;;(setvar "cmdecho" cmd1) 
 ;; (HH:ayOSMode T)                                  ;开户捕捉 
  (_EndUndo *DOC*)                                  ;编组结束 
  (gc) 
  (princ "\n 自贡运机集团黄明儒温馨提示 序号生成:HHXH") 
  (princ) 
)

wamwl · 发表于 2019-3-23 16:32

这个人真是人才，沾沾自喜写了一堆bug

zag0666 · 发表于 2020-8-17 09:47

ccc230 发表于 2020-8-14 21:22
序号标注源码，加5楼和8楼加进去才能用，我不知道代码加在哪个位置，指点下，代码不在行啊

谁让你在我楼下呢，这是我用的，拿去用吧
;标注序号程序
(defun c:bh (/ p1 p2 p3 ang1 bx bxh circ_1 txt_h juge)
(Command "osmode" "20" )
(setq circ_r 1.55)       ;圆圈半径
(setq txt_h 2)          ;字高
(while (/= juge "Exit")
(if (not bx) (setq bx 1 ))
(setq bxh (getint " \ n请输入序号 " ))       ;输入序号
(initget 1 "getpoint")                ;限制输入,使第一点不容为空
(setq p1 (getpoint " \ n请选择起点:"))          ;选择第一点
(setq p2 (getpoint p1 " \ n请选择第二点(回车表示无):")) ;直线的另一点
(if bxh (setq bx bxh))
(cond (p2
   (setq ang1 (angle p1 p2))             ;为直线时的情形
   (setq p3 (polar p1 ang1 ( - (distance p1 p2) circ_r)))       ;画圆,线
   (command "pline" (polar p1 ang1 0.2)
         "W" 0.8 0.8 "A" "CE" p1 "A" 359.9 "L" "W" 0 0 p3"")
         (command "circle" p2 circ_r )
         (command "text" "J" "M" p2 txt_h 0 bx)  ;写序号
         )
         ((not p2)       ;仅为一个点时的情形
            (command "circle" p1 circ_r)    ;画圆
         (command"text" "J" "M" p1 txt_h 0 bx)  ;写序号
      )
      )
      (setq bx ( + bx 1))
      (initget "Continue Exit")    ;定义类型关键字
      (setq juge (getkword" \ n 退出(Exit)/继续 (Continue):"))
   )
      (princ)
)

得瑟的猫 · 发表于 2018-8-1 16:33

大师帮忙看下啊，点击标注后出错了！

命令:
命令:
命令: HHXH
反向跟踪:
[0.51] (VL-BT)
[1.47] (*ERROR* "no function definition: _STARTUNDO")
[2.42] (_call-err-hook #<SUBR @000000003f85f110 *ERROR*> "no function
definition: _STARTUNDO")
[3.36] (sys-error "no function definition: _STARTUNDO")
:ERROR-BREAK.31 nil
[4.28] (#<SUBR @0000000038c38bb0 null-fun-hk> #<VLA-OBJECT IAcadDocument
00000000258cd5f0>)
[5.24] (_STARTUNDO #<VLA-OBJECT IAcadDocument 00000000258cd5f0>)
[6.19] (C:HHXH)
[7.15] (#<SUBR @000000003f85f480 -rts_top->)
[8.12] (#<SUBR @0000000038c38700 veval-str-body> "(C:HHXH)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)
; 错误: *error* 函数中出错无函数定义: _ENDUNDO

自贡黄明儒 · 发表于 2014-3-12 15:01

本帖最后由自贡黄明儒于 2014-9-5 11:07 编辑

怎么附件加不上去了，暂留着，等能放上去

自贡黄明儒 · 发表于 2014-3-12 15:02

本帖最后由自贡黄明儒于 2014-3-12 15:29 编辑

奇怪呀，进入高级模式，不能放附件了。

自贡黄明儒 · 发表于 2014-3-12 15:26

请先欣赏105水平大转弯管状带式输送机。虽然我不能确定是否世界第一，至少国内是第一条这么大的水平转弯角度，而且一次试车成功。
前年设计完成，去年开始运行。

自贡黄明儒 · 发表于 2014-3-12 15:34

本帖最后由自贡黄明儒于 2014-3-12 15:48 编辑

本来想放在二楼的，现在只能放在这儿了！！

;;编组开始;(command "_.undo" "be")
(defun _StartUndo (*DOC*)
(_EndUndo *DOC*)
(vla-StartUndoMark *DOC*)
)
;;结束编组;(if (= 8 (logand (getvar "undoctl") 8)) (command "_.undo" "_e"))
(defun _EndUndo (*DOC*)
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark *DOC*)
)
)

lostbalance · 发表于 2014-3-12 16:38

请问下，*DOC*这个是什么东西，有什么用

emk · 发表于 2014-3-12 16:56

lostbalance 发表于 2014-3-12 16:38
请问下，*DOC*这个是什么东西，有什么用

(setq *doc* (vla-get-activedocument (vlax-get-acad-object)))

flyfox1047 · 发表于 2014-3-12 20:30

试用了一下，效果不错！赞一个！

补一个函数

(defun HH:ayOSMode (isOpenSnap)
(if isOpenSnap
(setvar "osmode" (rem (getvar "osmode") 703))
(setvar "osmode" (+ (rem (getvar "osmode") 703) 703))
);end_if
);end_defun

lostbalance · 发表于 2014-3-12 21:07

emk 发表于 2014-3-12 16:56
(setq *doc* (vla-get-activedocument (vlax-get-acad-object)))

这条我看到了，就是不知道后面两个函数什么用的，得到的*doc*有什么作用

偏爱云~小吴 · 发表于 2014-3-13 11:53

牛逼，一定要顶一下

账号		自动登录	找回密码
密码			注册

[源码] 序号标注-----------------源码

本帖被以下淘专辑推荐:

相关帖子

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

点评

评分

评分

点评