求：修改“同时标注管径和管长的程序网上组合版(命令GDBZ)”程序
本帖最后由 l18c19 于 2014-2-19 09:12 编辑本人一点就不会编程，纯属网上各们前辈的程序组合，有2点寻求高手帮助(目的是想用于平面管道图的管径、长度标注)：
1、希望标注的管长格式为“L=X.XXX m”(X为数据，以米为单位保留三位小数 )。
2、希望管长可以自己选择保留一位小数点、两位小数点、三位小数点。目前只能到一位小数点，想能精确到3位小数点(mm级)，并始终显示3位小数(X.XXX ，包括小数点后面的0)）。）
感谢啦
;同时标注管径和管长的程序
;*****************参数初始化**********************
(vl-load-com)
(terpri)
(prompt "程序初始化......")
(terpri)
(setq bl (if(setq bl (getreal "输入出图比例1:<1>:")) bl 1.0));出图比例为1/bl
(setq gao (* bl 3.0));根据比例计算字高。
(setq tg (strcat "标注文字高度<" (rtos gao) ">:"))
(setq gao (if(setq xxx (getreal tg)) xxx gao));改变字高。
(setqxiaoshu (getint"请输入精度位数[整数(0)/1位(1)/2位(2)3位(3)]<1>: "))
(if (= xiaoshu nil) (setq xiaoshu 1))
;;;启动时在命令行要显示的内容
(terpri)
(prompt "管长管经标注程序加栽完毕，启动命令GDBZ")
;*************初始化完毕********************
(defun c:GDBZ (/ jl pt1 pt2x1 y1 z1 x2 y2 z2ts ag wz du dnwz lwz dnin dnout jlout ob e ee)
(setq ob (ssget '((0 . "line"))))
;;;(setq ob (ssget ))
(setq dn (if(> dn 0) dn 800))
(setq ts (strcat "输入管径<" (itoa dn) ">:"));将"输入管径<默认管径>:"负值给ts
(setq dn (if(setq dnin (getint ts)) dnin dn));输入新的管径,回车取默认值(即上次运行的值)
(repeat (setq ee(sslength ob))
(setq e(ssname ob(1- ee)))
(setq pt1 (vlax-curve-getstartpoint e)
pt2 (vlax-curve-getendpoint e)
)
(setq x1 (car pt1))
(setq y1 (cadr pt1))
(setq z1 (caddr pt1))
(setq x2 (car pt2))
(setq y2 (cadr pt2))
(setq z2 (caddr pt2))
(if
(< x2 x1)
(setq pt1 (list x2 y2 z2)
pt2 (list x1 y1 z1))
)
(setq ag (angle pt1 pt2));计算管线的斜率
(setq jl (distance pt1 pt2));计算管线的长度
(setq jl (atof (rtos jl 2 xiaoshu)));管线的长度的小数位数
(setq dnout (strcat "DN" (itoa dn) " L=" (rtos (/jl 1000.0)) "m"));dnout为输出管径,管道长度的字符串
(setq wz (- (/ jl 2)(/ (+ (strlen dnout) (* 2 gao)) 2) ))
(setq wz (polar pt1 ag wz));wz为管线的中点
(setq ag (if(and (> ag (/ pi 2)) (< a
g (* pi 1.5))) (- ag pi) ag));将ag调整到0~pi
(setq dnwz (polar wz (+ ag (/ pi 2)) (* 1.5 bl)));dnwz为管径标注的位置
(setq du (/ (* ag 180) pi));将管线斜率ag转换为度,负给du
(setq wdpt1 (polar wz 2.356 100))
(setq wdpt2 (polar wz -0.785 100));wdpt1,wdpt2为放大标注位置矩形对角两点
(command "zoom" wdpt1 wdpt2)
(command "text" dnwz gao du dnout);输出管径
(setq ee(1- ee))
)
(command "zoom" "previous")
(princ);静默退出
)
;同时标注管径和管长的程序
;*****************参数初始化**********************
(vl-load-com)
(terpri)
(prompt "程序初始化......")
(terpri)
(setq bl (if(setq bl (getreal "输入出图比例1:<1>:")) bl 1.0));出图比例为1/bl
(setq gao (* bl 3.0));根据比例计算字高。
(setq tg (strcat "标注文字高度<" (rtos gao) ">:"))
(setq gao (if(setq xxx (getreal tg)) xxx gao));改变字高。
(setqxiaoshu (getint"请输入精度位数[整数(0)/1位(1)/2位(2)]<1>: "))
(if (= xiaoshu nil) (setq xiaoshu 1))
;;;启动时在命令行要显示的内容
(terpri)
(prompt "管长管经标注程序加栽完毕，启动命令GDBZ")
;*************初始化完毕********************
(defun c:GDBZ (/ jl pt1 pt2x1 y1 z1 x2 y2 z2ts ag wz du dnwz lwz dnin dnout jlout ob e ee)
(setq ob (ssget '((0 . "line"))))
;;;(setq ob (ssget ))
(setq dn (if(> dn 0) dn 800))
(setq ts (strcat "输入管径<" (itoa dn) ">:"));将"输入管径<默认管径>:"负值给ts
(setq dn (if(setq dnin (getint ts)) dnin dn));输入新的管径,回车取默认值(即上次运行的值)
(repeat (setq ee(sslength ob))
(setq e(ssname ob(1- ee)))
(setq pt1 (vlax-curve-getstartpoint e)
pt2 (vlax-curve-getendpoint e)
)
(setq x1 (car pt1))
(setq y1 (cadr pt1))
(setq z1 (caddr pt1))
(setq x2 (car pt2))
(setq y2 (cadr pt2))
(setq z2 (caddr pt2))
(if
(< x2 x1)
(setq pt1 (list x2 y2 z2)
pt2 (list x1 y1 z1))
)
(setq ag (angle pt1 pt2));计算管线的斜率
(setq jl (distance pt1 pt2));计算管线的长度
;(setq jl (atof (rtos jl 2 xiaoshu)));管线的长度的小数位数
(setq dimzv(getvar 'dimzin))
(setvar 'dimzin 0)
(setq dnout (strcat "DN" (itoa dn ) " L(m)=" (rtos (/jl 1000.0) 2 xiaoshu)));dnout为输出管径,管道长度的字符串
(setvar 'dimzin dimzv)
(setq wz (- (/ jl 2)(/ (+ (strlen dnout) (* 2 gao)) 2) ))
(setq wz (polar pt1 ag wz));wz为管线的中点
(setq ag (if(and (> ag (/ pi 2)) (< ag (* pi 1.5))) (- ag pi) ag));将ag调整到0~pi
(setq dnwz (polar wz (+ ag (/ pi 2)) (* 1.5 bl)));dnwz为管径标注的位置
(setq du (/ (* ag 180.0) pi));将管线斜率ag转换为度,负给du
(setq wdpt1 (polar wz 2.356 100))
(setq wdpt2 (polar wz -0.785 100));wdpt1,wdpt2为放大标注位置矩形对角两点
(command "zoom" wdpt1 wdpt2)
;(command "text" dnwz du gaodnout);输出管径
(command "_.text" dnwz gaodnout);输出管径
(setq ee(1- ee))
)
(command "zoom" "previous")
(princ);静默退出
) 本帖最后由 l18c19 于 2014-2-20 09:58 编辑
非常感谢77077（沙发）和edata（板凳）两位老师的热情相助。
1、77077 老师的管长设置成3位小数点不好使（仍只能保留1位小数）。若管线长2989.4mm，标注时应显示2.989m。而实际显示成3m。
2、edata老师的：
74 ;(command "text" dnwz dugaodnout);输出管径 75 (command "_.text" dnwz gaodnout);输出管径
增改后，无法自动标注了。
小数位显示仍未得到解决 我就是来看看！ 试一试
;同时标注管径和管长的程序
;*****************参数初始化**********************
(vl-load-com)
(terpri)
(prompt "程序初始化......")
(terpri)
(setq bl (if(setq bl (getreal "输入出图比例1:<1>:")) bl 1.0));出图比例为1/bl
(setq gao (* bl 3.0));根据比例计算字高。
(setq tg (strcat "标注文字高度<" (rtos gao) ">:"))
(setq gao (if(setq xxx (getreal tg)) xxx gao));改变字高。
(setqxiaoshu (getint"请输入精度位数[整数(0)/1位(1)/2位(2)/3位(3)]<1>: "))
(if (= xiaoshu nil) (setq xiaoshu 1))
;;;启动时在命令行要显示的内容
(terpri)
(prompt "管长管经标注程序加栽完毕，启动命令GDBZ")
;*************初始化完毕********************
(defun c:GDBZ (/ jl pt1 pt2x1 y1 z1 x2 y2 z2ts ag wz du dnwz lwz dnin dnout jlout ob e ee)
(setvar "dimzin" 0)
(setq ob (ssget '((0 . "line"))))
;;;(setq ob (ssget ))
(setq dn (if(> dn 0) dn 800))
(setq ts (strcat "输入管径<" (itoa dn) ">:"));将"输入管径<默认管径>:"负值给ts
(setq dn (if(setq dnin (getint ts)) dnin dn));输入新的管径,回车取默认值(即上次运行的值)
(repeat (setq ee(sslength ob))
(setq e(ssname ob(1- ee)))
(setq pt1 (vlax-curve-getstartpoint e)
pt2 (vlax-curve-getendpoint e)
)
(setq x1 (car pt1))
(setq y1 (cadr pt1))
(setq z1 (caddr pt1))
(setq x2 (car pt2))
(setq y2 (cadr pt2))
(setq z2 (caddr pt2))
(if
(< x2 x1)
(setq pt1 (list x2 y2 z2)
pt2 (list x1 y1 z1))
)
(setq ag (angle pt1 pt2));计算管线的斜率
(setq jl (distance pt1 pt2));计算管线的长度
;(setq jl (atof (rtos jl 2 xiaoshu)));管线的长度的小数位数
(setq dnout (strcat "DN" (itoa dn) " L=" (rtos (/jl 1000.0) 2 xiaoshu) "m"));dnout为输出管径,管道长度的字符串
(setq wz (- (/ jl 2)(/ (+ (strlen dnout) (* 2 gao)) 2) ))
(setq wz (polar pt1 ag wz));wz为管线的中点
(setq ag (if(and (> ag (/ pi 2)) (< a
g (* pi 1.5))) (- ag pi) ag));将ag调整到0~pi
(setq dnwz (polar wz (+ ag (/ pi 2)) (* 31.5 bl)));dnwz为管径标注的位置
(setq du (/ (* ag 180) pi));将管线斜率ag转换为度,负给du
(setq wdpt1 (polar wz 2.356 100))
(setq wdpt2 (polar wz -0.785 100));wdpt1,wdpt2为放大标注位置矩形对角两点
(command "zoom" wdpt1 wdpt2)
(command "text" dnwz gao du dnout);输出管径
(setq ee(1- ee))
)
(command "zoom" "previous")
(setvar "dimzin" 8)
(princ);静默退出
) 感谢楼上朋友的热情相助，确实很好用了。若能增加标注文字离管道的距离调整（上和下选择）就完美了！ 非常感谢……………… 不错，很好的学习资料
页:
[1]