求：修改“同时标注管径和管长的程序网上组合版(命令GDBZ)”程序

l18c19

本人一点就不会编程，纯属网上各们前辈的程序组合，有2点寻求高手帮助(目的是想用于平面管道图的管径、长度标注)：
1、希望标注的管长格式为“L=X.XXX m”(X为数据，以米为单位保留三位小数 )。
2、希望管长可以自己选择保留一位小数点、两位小数点、三位小数点。目前只能到一位小数点，想能精确到3位小数点(mm级)，并始终显示3位小数(X.XXX ，包括小数点后面的0)）。）

感谢啦

77077

;同时标注管径和管长的程序
;*****************参数初始化**********************
(vl-load-com)

(terpri)

(prompt "程序初始化......")

(terpri)



(setq bl (if(setq bl (getreal "输入出图比例1:[1/2/5/10/20/50/100/1000]<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));改变字高。



(setq  xiaoshu (getint  "请输入精度位数[整数(0)/1位(1)/2位(2)3位(3)]<1>: "))

(if (= xiaoshu nil) (setq xiaoshu 1))



;;;启动时在命令行要显示的内容

   (terpri)

   (prompt "管长管经标注程序加栽完毕，启动命令GDBZ")



;*************初始化完毕********************

(defun c:GDBZ (/ jl pt1 pt2  x1 y1 z1 x2 y2 z2  ts 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);静默退出

)

edata

1. ;同时标注管径和管长的程序
   
2. ;*****************参数初始化**********************
   
3. (vl-load-com)
   
4. (terpri)
   
5. (prompt "程序初始化......")
   
6. (terpri)
   
7. 
   
8. (setq bl (if(setq bl (getreal "输入出图比例1:[1/2/5/10/20/50/100/1000]<1>:")) bl 1.0));出图比例为1/bl
   
9. (setq gao (* bl 3.0));根据比例计算字高。
   
10. (setq tg (strcat "标注文字高度<" (rtos gao) ">:"))
    
11. (setq gao (if(setq xxx (getreal tg)) xxx gao));改变字高。
    
12. 
    
13. (setq  xiaoshu (getint  "请输入精度位数[整数(0)/1位(1)/2位(2)]<1>: "))
    
14. (if (= xiaoshu nil) (setq xiaoshu 1))
    
15. 
    
16. ;;;启动时在命令行要显示的内容
    
17.    (terpri)
    
18.    (prompt "管长管经标注程序加栽完毕，启动命令GDBZ")
    
19. 
    
20. ;*************初始化完毕********************
    
21. (defun c:GDBZ (/ jl pt1 pt2  x1 y1 z1 x2 y2 z2  ts ag wz du dnwz lwz dnin dnout jlout ob e ee)
    
22. (setq ob (ssget '((0 . "line"))))
    
23. ;;;(setq ob (ssget ))
    
24.   (setq dn (if(> dn 0) dn 800))
    
25.    (setq ts (strcat "输入管径<" (itoa dn) ">:"));将"输入管径<默认管径>:"负值给ts
    
26.    (setq dn (if(setq dnin (getint ts)) dnin dn));输入新的管径,回车取默认值(即上次运行的值)
    
27. 
    
28.   
    
29. (repeat (setq ee(sslength ob))
    
30. 
    
31.   (setq e(ssname ob  (1- ee)))
    
32. 
    
33.   (setq pt1 (vlax-curve-getstartpoint e)
    
34.               pt2 (vlax-curve-getendpoint e)
    
35.         )
    
36. 
    
37.      (setq x1 (car pt1))
    
38.      (setq y1 (cadr pt1))
    
39.      (setq z1 (caddr pt1))
    
40.      (setq x2 (car pt2))
    
41.      (setq y2 (cadr pt2))
    
42.      (setq z2 (caddr pt2))
    
43. 
    
44.   (if
    
45.      (< x2 x1)
    
46.       (setq pt1 (list x2 y2 z2)
    
47.             pt2 (list x1 y1 z1))
    
48.      
    
49.    )
    
50. 
    
51. 
    
52.   
    
53.    (setq ag (angle pt1 pt2));计算管线的斜率
    
54. 
    
55.    (setq jl (distance pt1 pt2));计算管线的长度
    
56.    ;(setq jl (atof (rtos jl 2 xiaoshu)));管线的长度的小数位数
    
57.   (setq dimzv(getvar 'dimzin))
    
58.   (setvar 'dimzin 0)
    
59.   (setq dnout (strcat "DN" (itoa dn ) " L(m)=" (rtos (/  jl 1000.0) 2 xiaoshu)));dnout为输出管径,管道长度的字符串
    
60.   (setvar 'dimzin dimzv)
    
61.   (setq wz (- (/ jl 2)  (/ (+ (strlen dnout) (* 2 gao)) 2) ))
    
62.    (setq wz (polar pt1 ag wz));wz为管线的中点
    
63.    
    
64.    (setq ag (if(and (> ag (/ pi 2)) (< ag (* pi 1.5))) (- ag pi) ag));将ag调整到0~pi
    
65.   
    
66.    (setq dnwz (polar wz (+ ag (/ pi 2)) (* 1.5 bl)));dnwz为管径标注的位置
    
67.   
    
68.    
    
69. 
    
70.    (setq du (/ (* ag 180.0) pi));将管线斜率ag转换为度,负给du
    
71.    (setq wdpt1 (polar wz 2.356 100))
    
72.    (setq wdpt2 (polar wz -0.785 100));wdpt1,wdpt2为放大标注位置矩形对角两点
    
73.    (command "zoom" wdpt1 wdpt2)
    
74.    ;(command "text" dnwz du gao  dnout);输出管径
    
75.   (command "_.text" dnwz gao  dnout);输出管径
    
76.   (setq ee(1- ee))
    
77.   )
    
78.    (command "zoom" "previous")
    
79.    (princ);静默退出
    
80. )

;同时标注管径和管长的程序<br /> ;*****************参数初始化**********************<br /> (vl-load-com)<br /> (terpri)<br /> (prompt "程序初始化......")<br /> (terpri)<br /> <br /> (setq bl (if(setq bl (getreal "输入出图比例1:[1/2/5/10/20/50/100/1000]<1>:")) bl 1.0));出图比例为1/bl<br /> (setq gao (* bl 3.0));根据比例计算字高。<br /> (setq tg (strcat "标注文字高度<" (rtos gao) ">:"))<br /> (setq gao (if(setq xxx (getreal tg)) xxx gao));改变字高。<br /> <br /> (setq  xiaoshu (getint  "请输入精度位数[整数(0)/1位(1)/2位(2)]<1>: "))<br /> (if (= xiaoshu nil) (setq xiaoshu 1))<br /> <br /> ;;;启动时在命令行要显示的内容<br />    (terpri)<br />    (prompt "管长管经标注程序加栽完毕，启动命令GDBZ")<br /> <br /> ;*************初始化完毕********************<br /> (defun c:GDBZ (/ jl pt1 pt2  x1 y1 z1 x2 y2 z2  ts ag wz du dnwz lwz dnin dnout jlout ob e ee)<br /> (setq ob (ssget '((0 . "line"))))<br /> ;;;(setq ob (ssget ))<br />   (setq dn (if(> dn 0) dn 800))<br />    (setq ts (strcat "输入管径<" (itoa dn) ">:"));将"输入管径<默认管径>:"负值给ts<br />    (setq dn (if(setq dnin (getint ts)) dnin dn));输入新的管径,回车取默认值(即上次运行的值)<br /> <br />   <br /> (repeat (setq ee(sslength ob))<br /> <br />   (setq e(ssname ob  (1- ee)))<br /> <br />   (setq pt1 (vlax-curve-getstartpoint e)<br />               pt2 (vlax-curve-getendpoint e)<br />         )<br /> <br />      (setq x1 (car pt1))<br />      (setq y1 (cadr pt1))<br />      (setq z1 (caddr pt1))<br />      (setq x2 (car pt2))<br />      (setq y2 (cadr pt2))<br />      (setq z2 (caddr pt2))<br /> <br />   (if<br />      (< x2 x1)<br />       (setq pt1 (list x2 y2 z2)<br />             pt2 (list x1 y1 z1))<br />      <br />    )<br /> <br /> <br />   <br />    (setq ag (angle pt1 pt2));计算管线的斜率<br /> <br />    (setq jl (distance pt1 pt2));计算管线的长度<br />    ;(setq jl (atof (rtos jl 2 xiaoshu)));管线的长度的小数位数<br />   (setq dimzv(getvar 'dimzin))<br />   (setvar 'dimzin 0)<br />   (setq dnout (strcat "DN" (itoa dn ) " L(m)=" (rtos (/  jl 1000.0) 2 xiaoshu)));dnout为输出管径,管道长度的字符串<br />   (setvar 'dimzin dimzv)<br />   (setq wz (- (/ jl 2)  (/ (+ (strlen dnout) (* 2 gao)) 2) ))<br />    (setq wz (polar pt1 ag wz));wz为管线的中点<br />    <br />    (setq ag (if(and (> ag (/ pi 2)) (< ag (* pi 1.5))) (- ag pi) ag));将ag调整到0~pi<br />   <br />    (setq dnwz (polar wz (+ ag (/ pi 2)) (* 1.5 bl)));dnwz为管径标注的位置<br />   <br />    <br /> <br />    (setq du (/ (* ag 180.0) pi));将管线斜率ag转换为度,负给du<br />    (setq wdpt1 (polar wz 2.356 100))<br />    (setq wdpt2 (polar wz -0.785 100));wdpt1,wdpt2为放大标注位置矩形对角两点<br />    (command "zoom" wdpt1 wdpt2)<br />    ;(command "text" dnwz du gao  dnout);输出管径<br />   (command "_.text" dnwz gao  dnout);输出管径 <br />   (setq ee(1- ee))<br />   )<br />    (command "zoom" "previous")<br />    (princ);静默退出<br /> )

l18c19

非常感谢77077（沙发）和edata（板凳）两位老师的热情相助。
1、77077 老师的管长设置成3位小数点不好使（仍只能保留1位小数）。若管线长2989.4mm，标注时应显示2.989m。而实际显示成3m。
2、  edata  老师的：
74   ;(command "text" dnwz dugao  dnout);输出管径

75   (command "_.text" dnwz gao  dnout);输出管径

增改后，无法自动标注了。
小数位显示仍未得到解决

Q1241274614

我就是来看看！

xiang19751218

试一试
;同时标注管径和管长的程序
;*****************参数初始化**********************
(vl-load-com)
(terpri)
(prompt "程序初始化......")
(terpri)

(setq bl (if(setq bl (getreal "输入出图比例1:[1/2/5/10/20/50/100/1000]<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));改变字高。

(setq  xiaoshu (getint  "请输入精度位数[整数(0)/1位(1)/2位(2)/3位(3)]<1>: "))
(if (= xiaoshu nil) (setq xiaoshu 1))

;;;启动时在命令行要显示的内容
   (terpri)
   (prompt "管长管经标注程序加栽完毕，启动命令GDBZ")

;*************初始化完毕********************
(defun c:GDBZ (/ jl pt1 pt2  x1 y1 z1 x2 y2 z2  ts 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);静默退出
)

l18c19

感谢楼上朋友的热情相助，确实很好用了。若能增加标注文字离管道的距离调整（上和下选择）就完美了！

知行ooo李肖坪

非常感谢………………

lxy_2080

不错，很好的学习资料