（完成）[编程申请]：给排水管道标注。

six · 发表于 2003-1-13 15:44:26

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

要求给出两点，标注他们之间的距离。管径，坡度（这两个参数值自己输入）要求格式如下：D400-30-4(表示D400的管，30米的长度，0.4%的坡度）。附件是一个类似的程序，修改一下应该可以。谢谢！！！！！

;同时标注管径和管长的程序
;*****************参数初始化**********************
(terpri)
(prompt "程序初始化......")
(terpri)
(setq bl (if(setq bl (getreal "输入出图比例<1:100>1:")) bl 100));出图比例为1/bl
(setq gao (* bl 2.5));根据比例计算字高。
(setq tg (strcat "标注文字高度<" (rtos gao) ">"))
(setq gao (if(setq xxx (getreal tg)) xxx gao));改变字高。
(initget 1 "Y y n N")
(setq xxx (getkword "是否标出管长?<y/n>:"))
;*************初始化完毕********************
(defun c:bz (/ jl pt1 pt2 ts ag wz du dnwz lwz dnin dnout jlout)
(setq pt1 (getpoint "选择管段起点:"))
(terpri);换行
(setq pt2 (getpoint "选择管段末端:"))
(terpri);换行
(setq dn (if(> dn 0) dn 100))
(setq ts (strcat "输入管径<" (itoa dn) ">:"));将"输入管径<默认管径>:"负值给ts
(setq dn (if(setq dnin (getint ts)) dnin dn));输入新的管径,回车取默认值(即上次运行的值)
(setq ag (angle pt1 pt2));计算管线的斜率
(setq jl (distance pt1 pt2));计算管线的长度
(setq wz (- (/ jl 2) (* 2 gao)))
(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 lwz (polar wz (- ag (/ pi 2)) (* 4.0 bl)));lwz为管长标注的位置
(setq dnout (strcat "DN" (itoa dn)));dnout为输出管径的字符串
(setq jlout (strcat "L" (rtos (/ jl ))));jlout为输出管长的字符串
(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);输出管径
(cond
((= xxx "y")(command "text" lwz gao du jlout));输出管长
((= xxx "Y")(command "text" lwz gao du jlout));输出管长
)
(command "zoom" "previous")
(princ);静默退出
)
;启动时在命令行要显示的内容
(terpri)
(prompt "\本程序由城市水手编写，有不足的地方请来信mesgi@163.net")
(terpri)
(prompt "管长管经标注程序加栽完毕，启动命令bz")

;同时标注管径和管长的程序 
;*****************参数初始化********************** 
(terpri) 
(prompt "程序初始化......") 
(terpri) 
(setq bl (if(setq bl (getreal "输入出图比例<1:100>1:")) bl 100));出图比例为1/bl 
(setq gao (* bl 2.5));根据比例计算字高。 
(setq tg (strcat "标注文字高度<" (rtos gao) ">")) 
(setq gao (if(setq xxx (getreal tg)) xxx gao));改变字高。 
(initget 1 "Y y n N") 
(setq xxx (getkword "是否标出管长?<y/n>:")) 
;*************初始化完毕******************** 
(defun c:bz (/ jl pt1 pt2 ts ag wz du dnwz lwz dnin dnout jlout) 
   (setq pt1 (getpoint "选择管段起点:")) 
   (terpri);换行 
   (setq pt2 (getpoint "选择管段末端:")) 
   (terpri);换行 
   (setq dn (if(> dn 0) dn 100)) 
   (setq ts (strcat "输入管径<" (itoa dn) ">:"));将"输入管径<默认管径>:"负值给ts 
   (setq dn (if(setq dnin (getint ts)) dnin dn));输入新的管径,回车取默认值(即上次运行的值) 
   (setq ag (angle pt1 pt2));计算管线的斜率 
   (setq jl (distance pt1 pt2));计算管线的长度 
   (setq wz (- (/ jl 2) (* 2 gao))) 
   (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 lwz (polar wz (- ag (/ pi 2)) (* 4.0 bl)));lwz为管长标注的位置 
   (setq dnout (strcat "DN" (itoa dn)));dnout为输出管径的字符串 
   (setq jlout (strcat "L" (rtos (/ jl ))));jlout为输出管长的字符串   
   (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);输出管径 
   (cond 
     ((= xxx "y")(command "text" lwz gao du jlout));输出管长 
     ((= xxx "Y")(command "text" lwz gao du jlout));输出管长 
   ) 
   (command "zoom" "previous") 
   (princ);静默退出 
) 
;启动时在命令行要显示的内容 
   (terpri) 
   (prompt "\本程序由城市水手编写，有不足的地方请来信mesgi@163.net") 
   (terpri) 
   (prompt "管长管经标注程序加栽完毕，启动命令bz")

XDSoft · 发表于 2003-1-13 15:46:19

画一张示例图截图后，贴到论坛来吧。

说说你附件的LISP哪里不符合你要求？

six · 发表于 2003-1-13 16:06:08

不好意思，我不会贴图及截图。另外也不知道截些什么。附件的没有坡度标注，况且管径与长度是分开上下标注的。我想把D400-30-4的标注放在所取直线两点的中间的上面（对中标注）。你自己试一下附件就知道了。应该能领会我的意思。谢谢！！

XDSoft · 发表于 2003-1-13 17:53:27

最初由 six 发布
[B]不好意思，我不会贴图及截图。另外也不知道截些什么。附件的没有坡度标注，况且管径与长度是分开上下标注的。我想把D400-30-4的标注放在所取直线两点的中间的上面（对中标注）。你自己试一下附件就知道了。应该能领?.. [/B]

用 SNAGIT或者截图做关键字搜索下论坛，论坛介绍过好多，截图就是可以把一个窗口或者屏幕的一部分截取下来，保存成JPG或者GIF

作为附件，就可以把JPG/GIF传到论坛来显示。

如果会做DWF格式文件，可以做个DWF的传论坛来也可以。

如果DWF文件也不会做，你去看看图纸中心的样图和ACAD论坛置顶的帖子里面的DWF制作教学。

我认为这些学会了是主要的，可以更好的和大家在论坛交流。

eachy · 发表于 2003-1-13 22:27:36

拷贝至\XDSoft\Lisp目录下，在Command命令行输入(load "dmp"),命令为：XDTB_DMpipeline

;|
默认值 100－4 （管径－坡度）;
仅输入管径时输入 100,
仅输入坡度时输入 ,5
$XDTB_GLOBAL_SCALE 出图比例默认100
|;

复制代码

下载地址：http://www.xdcad.net/modrator/fi ... 122825_flashcam.swf

<embed src=http://www.xdcad.net/modrator/file_upload/14/20030116122825_flashcam.swf quality=high width=800 height=600 loop=true type="application/x-shockwave-flash">
</embed>

six · 发表于 2003-1-14 10:31:30

出错了：“错误: misplaced dot on input”。请指教。不过还是谢谢斑竹！

yangzj · 发表于 2003-1-18 12:24:50

根据选择的“LINE”型管道，输入出图比例、管径、坡度，可以自动将管径、长度标注在管道中上方，将坡度标注在管道中下方。本程序有待修改完善，将控制小数点位数的系统参数设定为符合自己需要的数值。

(defun c:GJBZ (/ cmd blp sca yy ent dia slp pt1 pt2 angl midpt length ang1
upt dpt txt layname y ts
)
(setq cmd (getvar "cmdecho")
blp (getvar "blipmode")
clay (getvar "clayer"))
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setq sca (getreal "\n 请输入出图比例："))
(if (null sca) (setq sca 100.00))
(setq yy t)
(while yy
(while (= (setq ent (entsel "\n 选择要标注的管线:"))
nil
)
)
(if (= (cdr (assoc 0 (entget (car ent)))) "LINE")
(progn
(setq dia (getstring "\n 输入管径值<d200>:"))
(if (= dia "")
(setq dia "d200")
)
(setq slp (getstring "\n 键入管道坡度<0.006>:"))
(if (= slp "")
(setq slp "0.006")
)
(setq ent (car ent))
(setq pt1 (cdr (assoc 10 (entget ent)))
pt2 (cdr (assoc 11 (entget ent))))
(setq angl (angle pt1 pt2)
x (- (car pt1) (car pt2))
y (- (cadr pt1) (cadr pt2))
midpt (list (/ (+ (car pt1) (car pt2)) 2) (/ (+ (cadr pt1)
(cadr pt2)
) 2
) 0.000
)
length (+ (/ (distance pt1 pt2) 1000) 1.00)
length (rtos length))
(cond
((and (> x 0)
(> y 0)
)
(setq angl (angle pt2 pt1))
)
((and (> x 0)
(< y 0)
)
(setq angl (angle pt2 pt1))
)
((and (< x 0)
(> y 0)
)
(setq angl (angle pt1 pt2))
)
((and (< x 0)
(< y 0)
)
(setq angl (angle pt1 pt2))
)
((and (= x 0)
(> y 0)
)
(setq angl (angle pt2 pt1))
)
((and (= x 0)
(< y 0)
)
(setq angl (angle pt1 pt2))
)
((and (> x 0)
(= y 0)
)
(setq angl (angle pt2 pt1))
)
((and (< x 0)
(= y 0)
)
(setq angl (angle pt1 pt2))
)
)
(if (> angl (* 1.5 pi))
(setq angl (- angl (* 2 pi)))
)
(if (and (> angl (/ pi -2))
(<= angl (/ pi 2))
)
(setq ang1 (+ angl (/ pi 2)))
(setq ang1 (- angl (/ pi 2)))
)
(setq upt (polar midpt ang1 (* 150 sca)))
(setq dpt (polar midpt (- ang1 pi) (* 400 sca)))
(setq angl (/ (* 180 angl) pi))
(setq txt "txt" layname
(tblsearch "layer" txt))
(if (not layname)
(command "_.layer" "m" txt "c" "2" txt "s" txt "")
(command "_.layer" "s" txt "")
)
(command "text" "J" "C" upt (* 300 sca) angl (strcat dia " L=" length))
(command "text" "J" "C" dpt (* 300 sca) angl (strcat "i=" slp))
)
(prompt "\n 没有选中管线")
)
(setq y t)
(while y
(setq ts (getstring "\n 是否继续标注N/Y<Y>:"))
(if (or (= ts "y") (= ts "Y") (= ts "n") (= ts "N") (= ts ""))
(setq y nil)
)
)
(if (or (= ts "n") (= ts "N"))
(setq yy nil)
)
)
(setvar "cmdecho" cmd)
(setvar "blipmode" blp)
(command "_.layer" "s" clay "")
(princ)
)

(defun c:GJBZ (/ cmd blp sca yy ent dia slp pt1 pt2 angl midpt length ang1 
                 upt dpt txt layname y ts 
              ) 
  (setq cmd (getvar "cmdecho") 
        blp (getvar "blipmode") 
        clay (getvar "clayer")) 
  (setvar "cmdecho" 0) 
  (setvar "blipmode" 0) 
  (setq sca (getreal "\n 请输入出图比例：")) 
  (if (null sca) (setq sca 100.00)) 
  (setq yy t) 
  (while yy 
    (while (= (setq ent (entsel "\n 选择要标注的管线:")) 
              nil 
           ) 
    ) 
    (if (= (cdr (assoc 0 (entget (car ent)))) "LINE") 
      (progn 
        (setq dia (getstring "\n 输入管径值<d200>:")) 
        (if (= dia "") 
          (setq dia "d200") 
        ) 
        (setq slp (getstring "\n 键入管道坡度<0.006>:")) 
        (if (= slp "") 
          (setq slp "0.006") 
        ) 
        (setq ent (car ent)) 
        (setq pt1 (cdr (assoc 10 (entget ent))) 
              pt2 (cdr (assoc 11 (entget ent)))) 
        (setq angl (angle pt1 pt2) 
              x (- (car pt1) (car pt2)) 
              y (- (cadr pt1) (cadr pt2)) 
              midpt (list (/ (+ (car pt1) (car pt2)) 2) (/ (+ (cadr pt1) 
                                                              (cadr pt2) 
                                                           ) 2 
                                                        ) 0.000 
                    ) 
              length (+ (/ (distance pt1 pt2) 1000) 1.00) 
              length (rtos length)) 
        (cond 
          ((and (> x 0) 
             (> y 0) 
           ) 
           (setq angl (angle pt2 pt1)) 
          ) 
          ((and (> x 0) 
             (< y 0) 
           ) 
           (setq angl (angle pt2 pt1)) 
          ) 
          ((and (< x 0) 
             (> y 0) 
           ) 
           (setq angl (angle pt1 pt2)) 
          ) 
          ((and (< x 0) 
             (< y 0) 
           ) 
           (setq angl (angle pt1 pt2)) 
          ) 
          ((and (= x 0) 
             (> y 0) 
           ) 
           (setq angl (angle pt2 pt1)) 
          ) 
          ((and (= x 0) 
             (< y 0) 
           ) 
           (setq angl (angle pt1 pt2)) 
          ) 
          ((and (> x 0) 
             (= y 0) 
           ) 
           (setq angl (angle pt2 pt1)) 
          ) 
          ((and (< x 0) 
             (= y 0) 
           ) 
           (setq angl (angle pt1 pt2)) 
          ) 
        ) 
        (if (> angl (* 1.5 pi)) 
          (setq angl (- angl (* 2 pi))) 
        ) 
        (if (and (> angl (/ pi -2)) 
              (<= angl (/ pi 2)) 
            ) 
          (setq ang1 (+ angl (/ pi 2))) 
          (setq ang1 (- angl (/ pi 2))) 
        ) 
        (setq upt (polar midpt ang1 (* 150 sca))) 
        (setq dpt (polar midpt (- ang1 pi) (* 400 sca))) 
        (setq angl (/ (* 180 angl) pi)) 
        (setq txt "txt" layname 
              (tblsearch "layer" txt)) 
        (if (not layname) 
          (command "_.layer" "m" txt "c" "2" txt "s" txt "") 
          (command "_.layer" "s" txt "") 
        ) 
        (command "text" "J" "C" upt (* 300 sca) angl (strcat dia "  L=" length)) 
        (command "text" "J" "C" dpt (* 300 sca) angl (strcat "i=" slp)) 
      ) 
      (prompt "\n 没有选中管线") 
    ) 
    (setq y t) 
    (while y 
      (setq ts (getstring "\n 是否继续标注N/Y<Y>:")) 
      (if (or (= ts "y") (= ts "Y") (= ts "n") (= ts "N") (= ts "")) 
        (setq y nil) 
      ) 
    ) 
    (if (or (= ts "n") (= ts "N")) 
      (setq yy nil) 
    ) 
  ) 
  (setvar "cmdecho" cmd) 
  (setvar "blipmode" blp) 
  (command "_.layer" "s" clay "") 
  (princ) 
)

ydf7332462 · 发表于 2003-1-30 20:55:57

曙光不明!
1> 2point succesed?
2> 不如用DIM +前后缀;还可直接选(管)线,而少点一次
3> Question:How to dim 所有选到的未锁定的可见(管)线Line+Pline
如Qdim+ali

six · 发表于 2004-4-15 10:20:38

我修改了一下，原程序如下：

;|
默认值 400－3 （管径－坡度）;
仅输入管径时输入 100,
仅输入坡度时输入 ,5
$XDTB_GLOBAL_SCALE 出图比例默认1
|;
($xdrx_load "xdlsp.lsp")
(if (not $XDTB_GLOBAL_SCALE)
(setq $XDTB_GLOBAL_SCALE 1)
)
(if (not $XDTB_DMSTRING)
(setq $XDTB_DMSTRING "400-3")
)
(defun c:XDTB_DMpipeline (/ oldos tf pt1 pt2 dis str string pmid pt ang1)
(setq tf t)
(setq oldos (getvar "osmode"))
(xdrx_begin)
(xdrx_ucson)
(xdrx_sysvar_push "osmode")
(setvar "osmode" oldos)
(while tf
(if (setq pt1 (getpoint "\n起点: "))
(progn
(setq pt2 (getpoint pt1 "\n终点: "))
(setq dis (rtos (distance pt1 pt2) 2 1);; 长度 0 小数点后位数
pmid (xdrx_midp pt1 pt2)
ang1 (angle pt1 pt2)
)
(if (> ang1 pi)
(setq ang1 (- ang1 pi))
)
(setq pt (polar pmid
(if (> ang1 _pi2)
(- ang1 _pi2)
(+ ang1 _pi2)
)
0
)
)
(prompt (strcat "\n管长 = " dis))
(setq str
(getstring (strcat "\n[管径-坡度]<D" $XDTB_DMSTRING ">: ")
)
)
(cond
((= (xdrx_string_findoneof str ",") 0)
(setq $XDTB_DMSTRING
(strcat
(car (xdrx_string_tok $XDTB_DMSTRING "-"))
"-"
(xdrx_string_trimleft str ",")
)
)
(setq
string (strcat
"D"
(car (xdrx_string_tok $XDTB_DMSTRING "-"))
"-"
dis
"-"
(xdrx_string_trimleft str ",")
)
)
)
((> (xdrx_string_find str ",") 0)
(setq $XDTB_DMSTRING
(strcat
(xdrx_string_trimright str ",")
"-"
(last (xdrx_string_tok $XDTB_DMSTRING "-"))
)
)
(setq
string
(strcat
"D"
(xdrx_string_trimright str ",")
"-"
dis
"-"
(last (xdrx_string_tok $XDTB_DMSTRING "-"))
)
)
)
((= str "")
(setq
string (strcat "D"
(xdrx_string_replace
$XDTB_DMSTRING
"-"
(strcat "-" dis "-")
)
)
)
)
(T
(setq $XDTB_DMSTRING str)
(setq
string (strcat "D"
(xdrx_string_join
(xdrx_string_tok $XDTB_DMSTRING "-")
(strcat "-" dis "-")
)
)
)
)
)
;(setvar "osmode" 0)
(command ".text"
"j"
"bc"
"_non"
pt
(* 1 $XDTB_GLOBAL_SCALE)
($xdlsp_rtd ($xdlsp_angle_format ang1))
string
)
)
(setq tf nil)
)
)
(xdrx_sysvar_pop)
(xdrx_ucsoff)
(xdrx_end)
(princ)
)

;| 
默认值 400－3 （管径 － 坡度）; 
仅输入管径时输入 100, 
仅输入坡度时输入 ,5 
$XDTB_GLOBAL_SCALE  出图比例默认1 
|; 
 
($xdrx_load "xdlsp.lsp") 
(if (not $XDTB_GLOBAL_SCALE) 
  (setq $XDTB_GLOBAL_SCALE 1) 
) 
(if (not $XDTB_DMSTRING) 
  (setq $XDTB_DMSTRING "400-3") 
) 
(defun c:XDTB_DMpipeline (/ oldos tf pt1 pt2 dis str string pmid pt ang1) 
  (setq tf t) 
  (setq oldos (getvar "osmode")) 
  (xdrx_begin) 
  (xdrx_ucson) 
  (xdrx_sysvar_push "osmode") 
  (setvar "osmode" oldos) 
  (while tf 
    (if        (setq pt1 (getpoint "\n起  点: ")) 
      (progn 
        (setq pt2 (getpoint pt1 "\n终  点: ")) 
        (setq dis  (rtos (distance pt1 pt2) 2 1);; 长度 0 小数点后位数 
              pmid (xdrx_midp pt1 pt2) 
              ang1 (angle pt1 pt2) 
        ) 
        (if (> ang1 pi) 
          (setq ang1 (- ang1 pi)) 
        ) 
        (setq pt (polar        pmid 
                        (if (> ang1 _pi2) 
                          (- ang1 _pi2) 
                          (+ ang1 _pi2) 
                        ) 
                        0 
                 ) 
        ) 
        (prompt (strcat "\n管长 = " dis)) 
        (setq str 
               (getstring (strcat "\n[管径-坡度]<D" $XDTB_DMSTRING ">: ") 
               ) 
        ) 
        (cond 
          ((= (xdrx_string_findoneof str ",") 0) 
           (setq $XDTB_DMSTRING 
                  (strcat 
                    (car (xdrx_string_tok $XDTB_DMSTRING "-")) 
                    "-" 
                    (xdrx_string_trimleft str ",") 
                  ) 
           ) 
           (setq 
             string (strcat 
                      "D" 
                      (car (xdrx_string_tok $XDTB_DMSTRING "-")) 
                      "-" 
                      dis 
                      "-" 
                      (xdrx_string_trimleft str ",") 
                    ) 
           )   
          ) 
          ((> (xdrx_string_find str ",") 0) 
           (setq $XDTB_DMSTRING 
                  (strcat 
                    (xdrx_string_trimright str ",") 
                    "-" 
                    (last (xdrx_string_tok $XDTB_DMSTRING "-")) 
                  ) 
           ) 
           (setq 
             string 
              (strcat 
                "D" 
                (xdrx_string_trimright str ",") 
                "-" 
                dis 
                "-" 
                (last (xdrx_string_tok $XDTB_DMSTRING "-")) 
              ) 
           ) 
          ) 
          ((= str "") 
           (setq 
             string (strcat "D" 
                            (xdrx_string_replace 
                              $XDTB_DMSTRING 
                              "-" 
                              (strcat "-" dis "-") 
                            ) 
                    ) 
           ) 
          ) 
          (T 
            (setq $XDTB_DMSTRING str) 
            (setq 
              string (strcat "D" 
                             (xdrx_string_join 
                               (xdrx_string_tok $XDTB_DMSTRING "-")                           
                               (strcat "-" dis "-") 
                             ) 
                     ) 
            ) 
          ) 
        ) 
        ;(setvar "osmode" 0) 
        (command ".text" 
                 "j" 
                 "bc" 
                 "_non" 
                 pt 
                 (* 1 $XDTB_GLOBAL_SCALE) 
                 ($xdlsp_rtd ($xdlsp_angle_format ang1)) 
                 string 
        ) 
      ) 
      (setq tf nil) 
    ) 
  ) 
  (xdrx_sysvar_pop) 
  (xdrx_ucsoff) 
  (xdrx_end) 
  (princ) 
)

但是运行时经常有BUG，比如下面附件的图就不能用。而且在UCS里面用不了，只能在世界坐标系里面用。麻烦斑竹修改一下。另外有什么方便的方法修改$XDTB_GLOBAL_SCALE 变量？运行环境：cad2002 ,工具箱0.29

li809 · 发表于 2005-2-20 00:23:25

希望楼主能尽快完善程序，再上传

dabingrain · 发表于 2005-6-28 11:41:55

;同时标注管径和管长的程序
;*****************参数初始化**********************
(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)]<1>: "))
(if (= xiaoshu nil) (setq xiaoshu 1))

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

;*************初始化完毕********************
(defun c:bz (/ 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 "d" (itoa dn) " L=" (rtos (/ jl ))));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);静默退出
)

李军 · 发表于 2005-6-30 10:27:54

本人不会编程，向高手致敬！盼多出精品！

sahara124 · 发表于 2009-3-31 16:40:01

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

（完成）[编程申请]：给排水管道标注。

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子