序号标注-----------------源码
本帖最后由 自贡黄明儒 于 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)
)
这个人真是人才，沾沾自喜写了一堆bug 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)
) 大师帮忙看下啊，点击标注后出错了！:'(
命令:
命令:
命令: HHXH
反向跟踪:
(VL-BT)
(*ERROR* "no function definition: _STARTUNDO")
(_call-err-hook #<SUBR @000000003f85f110 *ERROR*> "no function
definition: _STARTUNDO")
(sys-error "no function definition: _STARTUNDO")
:ERROR-BREAK.31 nil
(#<SUBR @0000000038c38bb0 null-fun-hk> #<VLA-OBJECT IAcadDocument
00000000258cd5f0>)
(_STARTUNDO #<VLA-OBJECT IAcadDocument 00000000258cd5f0>)
(C:HHXH)
(#<SUBR @000000003f85f480 -rts_top->)
(#<SUBR @0000000038c38700 veval-str-body> "(C:HHXH)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)
; 错误: *error* 函数中出错无函数定义: _ENDUNDO
本帖最后由 自贡黄明儒 于 2014-9-5 11:07 编辑
怎么附件加不上去了，暂留着，等能放上去 本帖最后由 自贡黄明儒 于 2014-3-12 15:29 编辑
奇怪呀，进入高级模式，不能放附件了。 请先欣赏105水平大转弯管状带式输送机。虽然我不能确定是否世界第一，至少国内是第一条这么大的水平转弯角度，而且一次试车成功。
前年设计完成，去年开始运行。 本帖最后由 自贡黄明儒 于 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*)
)
)
请问下，*DOC*这个是什么东西，有什么用 lostbalance 发表于 2014-3-12 16:38 static/image/common/back.gif
请问下，*DOC*这个是什么东西，有什么用
(setq *doc* (vla-get-activedocument(vlax-get-acad-object))) 试用了一下，效果不错！赞一个！
补一个函数
(defun HH:ayOSMode (isOpenSnap)
(if isOpenSnap
(setvar "osmode" (rem (getvar "osmode") 703))
(setvar "osmode" (+ (rem (getvar "osmode") 703) 703))
);end_if
);end_defun emk 发表于 2014-3-12 16:56 static/image/common/back.gif
(setq *doc* (vla-get-activedocument(vlax-get-acad-object)))
这条我看到了，就是不知道后面两个函数什么用的，得到的*doc*有什么作用 牛逼，一定要顶一下