连续明细标注（新手报到帖）欢迎拍砖
本帖最后由 Rimford 于 2014-4-17 22:11 编辑刚到明经社区，有一种相见恨晚的感觉。坛子里的精华太多，看不完啊！
光看贴不发贴，不能称之为交流啊！
这是我自己做的一个可以进行连续明细标注的小程序，还有待进一步完善和扩展，欢迎高手拍砖！
以后我想把明细标注和明细栏关联，请高手指点。之前在清华天河和机械工程师见过类似功能。
(defun c:label_num()
;本程序用于零件序号标注，代替多重引线功能
(commonsets);检查图层设置
(setvar "clayer" "DIM")
(setvar "textstyle" "5.0")
(setq dd 8)(setq dc 1)
(setq num (getint "\n起始编号 <1>: "))
(if (null num) (setq num 1))
(setq dd2(/ dd 5))
(setq pt1 (getpoint "\n第一点: "))
(while (/= pt1 nil)
(command "donut" 0 dd2 pt1 "")
(setvar "osmode" 16383);打开所有对象捕捉
(setq pt2 (getpoint "\n第二点: "))
(setvar "osmode" 0);关闭所有对象捕捉
(command "line" pt1 pt2 "")
;通过pt1-pt2的角度，判断pt3的位置
(setq ang (angle pt1 pt2))
(cond((and (> ang (* pi 0.5)) (< ang (* pi 1.5)))(setq pt3 (polar pt2 pi dd)))
(t (setq pt3 (polar pt2 0 dd)))
)
(command "line" pt2 pt3 "")
(setq en1 (entlast))
(command "text" "m" (polar (get_midpt pt2 pt3) (/ pi 2) (/ dd 2))0(itoa num))
(setq en2 (entlast))
;判断是否增加连续序号
(setq what null)
(setq num (+ num 1))
(setq what(getstring "\n[增加连续竖向序号(H)][增加连续横向序号(V)]"))
(if(or (= what "h" ) (= what "H" ))(label_num_H))
(if(or (= what "v" ) (= what "V" ))(label_num_V))
;如果不增加连续序号，则重新开始标注
(setq pt1 (getpoint "\n第一点: "))
)
(prin1)
)
(defun label_num_V()
;本程序用于增加连续横向序号
(cond((and (> ang (* pi 0.0)) (< ang (* pi 0.5)))(label_num_V1))
((and (> ang (* pi 1.0)) (< ang (* pi 1.5)))(label_num_V1))
(t (label_num_V2))
)
)
(defun label_num_V1()
;本程序用于增加连续横向序号
(setq ss1(ssadd))
(setq en3 nil)
(setq pan3 "Y")
(while(= pan3 "Y")
(cond((and (> ang (* pi 0.0)) (< ang (* pi 0.5)))
(progn
(setq pt4(polar pt3 (* pi 1.75) dc))
(setq pt5(polar pt4 (* pi 0.25) dc))
(setq pt6(polar pt5 (* pi 0.0) dd))
)
)
(t
(progn
(setq pt4(polar pt3 (* pi 1.25) dc))
(setq pt5(polar pt4 (* pi 0.75) dc))
(setq pt6(polar pt5 (* pi 1.0) dd))
)
)
)
(command "line" pt3 pt4 "")
(command "line" pt4 pt5 "")
(command "line" pt5 pt6 "")
(command "text" "m" (polar (get_midpt pt5 pt6) (/ pi 2) (/ dd 2)) 0 (itoa num))
(setq pt3 pt6)
(setq num (+ num 1))
(setq pan3(getstring "\n是否继续横向添加连续序号？[终止添加(N)]"))
(if (and (/= pan3 "N") (/= pan3 "n"))(setq pan3 "Y"))
)
)
(defun label_num_V2()
;本程序用于增加连续横向序号
(setq ss1(ssadd));建立或清空选择集
(setq en3 nil);付值
(setq en4 nil);付值
(setq pan4 "Y");付初始值，判断是否继续
(while(= pan4 "Y")
(setq ent1 en1)
(setq ent2 en2)
(ssadd ent1 ss1)
(ssadd ent2 ss1)
(if(/= en3 nil)
(progn
(setq ent3 en3)
(ssadd ent3 ss1)
)
)
(if(/= en4 nil)
(progn
(setq ent4 en4)
(ssadd ent4 ss1)
)
)
(cond((and (> ang (* pi 0.5)) (< ang (* pi 1.0)))
(progn
(setq pt3(polar pt2 (* pi 1.0) dd))
(setq pt4(polar pt3 (* pi 1.25) dc))
(setq pt5(polar pt4 (* pi 0.75) dc))
)
)
((and (> ang (* pi 1.5)) (< ang (* pi 2.0)))
(progn
(setq pt3(polar pt2 (* pi 0.0) dd))
(setq pt4(polar pt3 (* pi 1.75) dc))
(setq pt5(polar pt4 (* pi 0.25) dc))
)
)
)
(command "move" ss1 "" pt2 pt5)
(command "line" pt2 pt3 "")
(setq en1 (entlast))
(command "text" "m" (polar (get_midpt pt2 pt3) (/ pi 2) (/ dd 2)) 0 (itoa num))
(setq en2 (entlast))
(command "line" pt3 pt4 "")
(setq en3(entlast))
(command "line" pt4 pt5 "")
(setq en4(entlast))
(setq num (+ num 1))
(setq pan4(getstring "\n是否继续横向添加连续序号？[终止添加(N)]"))
(if (and (/= pan4 "N") (/= pan4 "n"))(setq pan4 "Y"))
)
)
(defun label_num_H()
;本程序用于增加连续纵向序号
(cond((and (> ang (* pi 0.0)) (< ang (* pi 0.5)))(label_num_H1))
((and (> ang (* pi 1.0)) (< ang (* pi 1.5)))(label_num_H1))
(t (label_num_H2))
)
(prin1)
)
(defun label_num_H2()
;本程序用于增加连续纵向序号
(setq pan2 "Y")
(while(= pan2 "Y")
(cond((and (> ang (* pi 0.5)) (< ang (* pi 1.5)))
(progn
(setq pt4(polar pt2 (* pi 0.5) dd))
(setq pt5 (polar pt4 pi dd))
)
)
(t
(progn
(setq pt4(polar pt2 (* pi 1.5) dd))
(setq pt5 (polar pt4 (* pi 0.0) dd))
)
)
)
(command "line" pt4 pt5 "")
(command "line" pt2 pt4 "")
(command "text" "m" (polar (get_midpt pt4 pt5) (/ pi 2) (/ dd 2)) 0 (itoa num))
(setq pt2 pt4)
(setq num (+ num 1))
(setq pan2(getstring "\n是否继续竖向添加连续序号？[终止添加(N)]"))
(if (and (/= pan2 "N") (/= pan2 "n"))(setq pan2 "Y"))
)
(prin1)
)
(defun label_num_H1()
;本程序用于增加连续纵向序号
(setq ss1(ssadd))
(setq en3 nil)
(setq pan1 "Y")
(while(= pan1 "Y")
(setq ent1 en1)
(setq ent2 en2)
(ssadd ent1 ss1)
(ssadd ent2 ss1)
(if(/= en3 nil)
(progn
(setq ent3 en3)
(ssadd ent3 ss1)
)
)
(cond((and (> ang (* pi 0.0)) (< ang (* pi 0.5)))(setq pt4(polar pt2 (* pi 0.5) dd)))
((and (> ang (* pi 1.0)) (< ang (* pi 1.5)))(setq pt4(polar pt2 (* pi 1.5) dd)))
)
(command "move" ss1 "" pt2 pt4)
(command "line" pt2 pt3 "")
(setq en1 (entlast))
(command "text" "m" (polar (get_midpt pt2 pt3) (/ pi 2) (/ dd 2)) 0 (itoa num))
(setq en2 (entlast))
(command "line" pt2 pt4 "")
(setq en3(entlast))
(setq num (+ num 1))
(setq pan1(getstring "\n是否继续竖向添加连续序号？[终止添加(N)]"))
(if (and (/= pan1 "N") (/= pan1 "n"))(setq pan1 "Y"))
)
)
(defun get_midpt(pt1 pt2);求两点中点坐标
(setq mx(/ (+ (car pt1) (car pt2)) 2))
(setq my(/ (+ (cadr pt1) (cadr pt2)) 2))
(list mx my)
)
<div class="blockcode"><blockquote>;**********************本程序为公用程序，用于加载加载项，设置图层等*******************************
(defuncommonsets()
;--------------变量设置-------------------------------------------------
(setq textfont "SIMFANG.TTF");字体设置为仿宋
(setq textfont (strcat (strcat (getenv "windir") "\\fonts\\") textfont));Windows字体设置
;;;(setq bigtextgont "hztxt.shx");大字体设置
(setq textwidth 0.7);字体比例
;------------------ActiveX准备工作-----------------------------------------------------------
(vl-load-com);加载Visual Lisp扩展功能函数，同时可以控制ActiveX对象
(setq acadobj(vlax-get-acad-object));取得当前AutoCAD应用程序母体对象
(setq dwgobj(vla-get-ActiveDocument acadobj));取得作用中的图形文件
(setq mspace(vla-get-ModelSpace dwgobj));取得模型空间集合对象
(setq layersobj(vla-get-layers dwgobj));取得图层集合对象
(setq stylesobj(vla-get-textstyles dwgobj));取得字体集合对象
(setq linetypesobj(vla-get-linetypes dwgobj));取得字体集合对象
(setq blocksobj(vla-get-blocks dwgobj));取得图形中的块集合对象
(setq layoutsobj(vla-get-layouts dwgobj));取得图形中的所有布局设置集合对象
;------------------设置图层------------------------------------------------------------------
;------------------加载中心线、双点画线和虚线----------
(vl-catch-all-apply 'vla-load (list linetypesobj "divide" (findfile "acadiso.lin")) );加载双点划线
(vl-catch-all-apply 'vla-load (list linetypesobj "center" (findfile "acadiso.lin")) );加载中心线
(vl-catch-all-apply 'vla-load (list linetypesobj "dashed" (findfile "acadiso.lin")) );加载虚线
;-------------------取得图层集合列表-------------------
(setq laylist nil)
(vlax-for sobj layersobj
(setq layname(vla-get-name sobj))
(setq laylist(cons layname laylist))
)
;---------判断图层是否存在，如果不存在，增设该图层-----
;---------------设置0图层------------------------------
(setq lay1(vla-add layersobj "0"))
(vla-put-color lay1 7)
(vla-put-linetype lay1 "continuous")
(vla-put-lineweight lay1 50)
;---------------设置CEN图层----------------------------
(setq lay1(vla-add layersobj "CEN"))
(vla-put-color lay1 3)
(vla-put-linetype lay1 "Center")
(vla-put-lineweight lay1 25)
;---------------设置DASH图层---------------------------
(setq lay1(vla-add layersobj "DASH"))
(vla-put-color lay1 2)
(vla-put-linetype lay1 "DASHED")
(vla-put-lineweight lay1 25)
;---------------设置DIM图层----------------------------
(setq lay1(vla-add layersobj "DIM"))
(vla-put-color lay1 4)
(vla-put-linetype lay1 "continuous")
(vla-put-lineweight lay1 25)
;---------------设置DIV图层----------------------------
(setq lay1(vla-add layersobj "DIV"))
(vla-put-color lay1 5)
(vla-put-linetype lay1 "Divide")
(vla-put-lineweight lay1 25)
;---------------设置HAT图层----------------------------
(setq lay1(vla-add layersobj "HAT"))
(vla-put-color lay1 6)
(vla-put-linetype lay1 "continuous")
(vla-put-lineweight lay1 25)
;---------------设置THIN图层---------------------------
(setq lay1(vla-add layersobj "THIN"))
(vla-put-color lay1 1)
(vla-put-linetype lay1 "continuous")
(vla-put-lineweight lay1 25)
;---------------设置TXT图层----------------------------
(setq lay1(vla-add layersobj "TXT"))
(vla-put-color lay1 2)
(vla-put-linetype lay1 "continuous")
(vla-put-lineweight lay1 25)
;---------------设置STR图层----------------------------
(setq lay1(vla-add layersobj "STR"))
(vla-put-color lay1 7)
(vla-put-linetype lay1 "continuous")
(vla-put-lineweight lay1 50)
;-------------------设置文字样式--------------------------------------------------------
;-------------------取得文字样式集合列表---------------
(setq stylist nil)
(vlax-for tobj stylesobj
(setq styname(vla-get-name tobj))
(setq stylist(cons styname laylist))
)
;------------------设置文字样式1.8---------------------
(setq sty1(vla-add stylesobj "1.8"))
(vla-put-fontfile sty1 textfont)
;;; (vla-put-bigfontfile sty1 bigtextfont)
(vla-put-height sty1 1.8)
(vla-put-width sty1 textwidth)
;------------------设置文字样式2.5---------------------
(setq sty1(vla-add stylesobj "2.5"))
(vla-put-fontfile sty1 textfont)
;;; (vla-put-bigfontfile sty1 bigtextfont)
(vla-put-height sty1 2.5)
(vla-put-width sty1 textwidth)
;------------------设置文字样式3.5---------------------
(setq sty1(vla-add stylesobj "3.5"))
(vla-put-fontfile sty1 textfont)
;;; (vla-put-bigfontfile sty1 bigtextfont)
(vla-put-height sty1 3.5)
(vla-put-width sty1 textwidth)
;------------------设置文字样式5.0---------------------
(setq sty1(vla-add stylesobj "5.0"))
(vla-put-fontfile sty1 textfont)
;;; (vla-put-bigfontfile sty1 bigtextfont)
(vla-put-height sty1 5.0)
(vla-put-width sty1 textwidth)
;------------------设置文字样式7.0---------------------
(setq sty1(vla-add stylesobj "7.0"))
(vla-put-fontfile sty1 textfont)
;;; (vla-put-bigfontfile sty1 bigtextfont)
(vla-put-height sty1 7.0)
(vla-put-width sty1 textwidth)
;------------------设置文字样式10---------------------
(setq sty1(vla-add stylesobj "10"))
(vla-put-fontfile sty1 textfont)
;;; (vla-put-bigfontfile sty1 bigtextfont)
(vla-put-height sty1 10)
(vla-put-width sty1 textwidth)
;------------------设置文字样式14---------------------
(setq sty1(vla-add stylesobj "14"))
(vla-put-fontfile sty1 textfont)
;;; (vla-put-bigfontfile sty1 bigtextfont)
(vla-put-height sty1 14)
(vla-put-width sty1 textwidth)
;------------------设置文字样式20---------------------
(setq sty1(vla-add stylesobj "20"))
(vla-put-fontfile sty1 textfont)
;;; (vla-put-bigfontfile sty1 bigtextfont)
(vla-put-height sty1 20)
(vla-put-width sty1 textwidth)
;-----------------避免不必要的输出--------------------
(prin1)
) ;_ 结束defun
很不错啊，下载下来用了几天，有几个问题想请教一下：
1、能不能把件号跟全局标注比例连接起来，因为标注完后拉件号有时件号太小，不成比例；getvar(dimscale类似这样子的
2、件号对齐不方便，见过langjs弄过一个自动对齐件号的，很不错；《动态引线标注 v2.0》
3、拉出件号的时候能不能是动态可见的，方便调整件号的角度。。。 梦里水香 发表于 2014-4-23 15:17 static/image/common/back.gif
很不错啊，下载下来用了几天，有几个问题想请教一下：
1、能不能把件号跟全局标注比例连接起来，因为标注完 ...
这也是我想做的
研究研究先 楼主请问这个现在优化了吗
ansyss 发表于 2017-12-18 20:56
楼主请问这个现在优化了吗
你看我另一篇帖子吧，里面有这个优化 非常感谢楼主，在这里看到很多VLA函数的用法，谢谢！ 感谢楼主分享
页:
[1]