自己写的“市政排水设计工具”程序及源代码

guangdonglbq 发表于 2009-4-17 13:22:00

本帖最后由作者于 2009-4-17 13:42:38 编辑 声明：     1.本程序以市政排水平面图绘图功能为主，包含一些其它的小功能，但不能进行纵断面绘图，需要更强大功能者，请使用商业软件。     2.本程序比较适合道路设计采用纬地软件，再进行排水设计的情况。     3.使用说明是比较早前写的，没有更新。     4.字体建议使用：hztxt_e.shx及hztxt.shx，运行速度比较快，也好看。     5.此工具陆续写了两年左右，一些早期写的代码变量名没有按规范命名，可读性差一些。      6.如用来进行排水设计，建议结合“shlisp给排水工具箱”工具箱一起使用，其下载地址：<a href="http://shlisp.ys168.com/">http://shlisp.ys168.com</a>     开源说明：   我一直是按某个带我做排水的同事的习惯，手工进行排水设计及制图，从来不使用商业软件，本程序就是根据我自已的需要所写。目前已经完成的功能有:布井->布置雨水口->绘沉砂井->井标注（不含井底高程标注）->管道标注->管长统计->井底高程标注->删除井(圆)内多余的线->检查井数量统计，计划中还会增加管底高程自动计算，但偶然看了一下“鸿业市政管线7”的说明，此程序中已有的及计划中的功能，都已在“鸿业市政管线7”中实现，而且更强大、更完善，故不准备再升级、完善，并决定把源码及程序公开，以便喜欢的人可以自行升级、完善，或直接用来进行一些不需要太规范出图的项目的设计，或利用本程序的源代码进行其它程序的开发。  喜欢就下载，不喜欢就算了。水平有限，漫骂请免。本想一起传个使用的实例，但论坛附件限制文件大小仅为200kb，文件压缩后还越过200kb，就不上传了，需要下载的，可以到<a href="http://www.jpszx.com/readWTtidMB55164.html">http://www.jpszx.com/readWTtidMB55164.html</a>去下载<img src="http://www.jpszx.com/attachment/Mon_0904/22_52384_a2361306e7ffc7d.jpg" border="0" alt=""/>

技术工作室 发表于 2022-9-30 20:38:53

支持一下顶一个

SYTDD 发表于 2018-2-14 22:22:21

谢谢楼主分享！

weijunqi757 发表于 2009-4-19 22:19:00

支持一下，辛苦了~！

hstea 发表于 2009-4-20 11:33:00

下了！支持你！！

aaa19842002 发表于 2009-4-20 20:49:00

顶！！！！！！！！！！

leishusheng 发表于 2009-4-21 19:03:00

下了！支持你！！

sliwalydh 发表于 2009-6-24 13:22:00

支持一下

wowan1314 发表于 2009-8-18 15:52:00

兄弟我不会编程，但习惯用纯CAD画图，所以需要些LSP来帮忙。
你设计的标注井底高程LSP很好用。谢谢你的程序先。
只有“标注井底高程.lsp”只识别D200-3.0-5这样的标注形式。
请帮忙修改成可以识别D200-L=3.0-i=5‰ 或者D200-L=3.0-i=0.005这样的形式.

;;;------------------------------------------------------------------------
;;;计算、标注井底高程--默认格式DN-L-D例：DN200-3.0-5 小数点后三位
(vl-load-com)
(defun c:BB (/       StrFenGe ListPI    OriginalGaoCheng    strGPI
               ResultGaoCheng       ob       obn       obname    obstr
               strText keyW    GoOn
               )
;;;------------------------------------------------------------------------
;;;返回表 (　(管长,坡度) ), 若原字串格式有误,则返回nil
(defun DLIStrToList (OriginalStr / NewStr ListReturn ch PoDu GuanChang)
(if (not (vl-string-search StrFenGe OriginalStr))
(setq ListReturn nil)
;;;如果字串中一个分隔符也没有,说明字串格式不对,返回值设置为nil
(progn
(if (/= StrFenGe "")
(setq NewStr (vl-string-subst "" StrFenGe OriginalStr))
)
;;把分隔符替换为两个空格:一个空格会出错；换为空格后,lisp容易处理
(while (/= (setq ch (substr NewStr 1 1)) " ")
(setq NewStr (substr NewStr 2))
)
;;消去管径字符
(while (= (setq ch (substr NewStr 1 1)) " ")
(setq NewStr (substr NewStr 2))
)
;;消去第一个分隔符
(if (not (vl-string-search StrFenGe NewStr))
(setq ListReturn nil)
;;;如果字串中没有第二个分隔符,说明字串格式不对,返回值设置为nil
(progn
   (if (/= StrFenGe "")
   (setq NewStr (vl-string-subst "" StrFenGe NewStr))
   )
   ;;把分隔符替换为两个空格:一个空格会出错；换为空格后,lisp容易处理
   (setq GuanChang (read NewStr))
   ;;取得管长数值
   (while (/= (setq ch (substr NewStr 1 1)) " ")
   (setq NewStr (substr NewStr 2))
   )
   ;;消去管长字符
   (while (= (setq ch (substr NewStr 1 1)) " ")
   (setq NewStr (substr NewStr 2))
   )
   ;;消去第二个分隔符
   (setq PoDu (read NewStr))
   ;;取得坡度数值
   (if (and (numberp GuanChang) (numberp PoDu))
   (setq ListReturn (list GuanChang PoDu))
   (setq ListReturn nil)
   )
)
)
)
)
ListReturn
)
;;;------------------------------------------------------------------------
(setvar "dimzin" 0) ; 使输出结果不消除后续0
(princ "\n选择起点的管道标高文本:")
(setq GoOn "Continue") ;GoOn用于控制是否继续运行
(setq obn 2)
(while (> obn 1)
(setq ob (ssget '((0 . "text")))) ; 创建选择集 ob
(if (not ob)
(setq obn 0)
(setq obn (sslength ob))
)
(cond
((= obn 0) (setq GoOn "Stop"))
((= obn 1)
(setq obname (ssname ob 0)) ; obname,取得第1个对象名
(setq obstr (entget obname))
(setq strText (cdr (assoc 1 obstr))) ; 取得第1个对象的文字内容
(setq OriginalGaoCheng (read strText))
(if (not (numberp OriginalGaoCheng))
(progn
   (princ "\n所择的文本不是数字,请重新选择!\n")
   (setq obnil
         obn 2
   )
)
)
)
(T nil)
)
)
;;限制只允许选择一个有效高程文本
;;确定起点井底高程
(setq StrFenGe "-")
(princ "\n后续井底高程相对于起点井底高程:")
(setq keyW s)
;;;------------------------------------------------------------------------
(while (= GoOn "Continue")
;;;------------------------------------------------------------------------
;;;以下控制选择正确的"管径-管道-标高"文本
(setq obn 2
      obnil
)
(while (> obn 1)
(princ "\n选择一个\"管径-管道-标高\"文本:")
(setq ob (ssget '((0 . "text")))) ; 创建选择集 ob
(if (not ob)
   (setq obn 0)
   (setq obn (sslength ob))
)
(cond
   ((= obn 0) (setq GoOn "Stop"))
   ((= obn 1)
   (setq obname (ssname ob 0)) ; obname,取得第1个对象名
   (setq obstr (entget obname))
   (setq strGPI (cdr (assoc 1 obstr))) ; 取得第1个对象的文字内容
   (setq ListPI (DLIStrToList strGPI))
   (if (not ListPI)
   (progn
      (princ "\n所择的文本格式有误,请重新选择!")
      (setq obnil
            obn 2
      )
   )
   )
   )
   (T (princ "\n所择了多个单行文本,请重新选择!"))
)
)
;;;------------------------------------------------------------------------
;;;输出计算结果
(if (= GoOn "Continue")
(progn
;;;以下选择需要输入计算结果的本
   (setq obn 2
         obnil
   )
   (while (> obn 1)
   (princ "\n选择输出计算结果的文本:")
   (setq ob (ssget '((0 . "text")))) ; 创建选择集 ob
   (if (not ob)
   (setq obn 0)
   (setq obn (sslength ob))
   )
   (cond
   ((= obn 0) (setq GoOn "Stop"))
   ((= obn 1)
      (setq obname (ssname ob 0)) ; obname,取得第1个对象名
      (setq obstr (entget obname))
      (setq ResultGaoCheng (/ (* (car ListPI) (cadr ListPI)) 1000))
      (if (= keyW "A")
      (setq ResultGaoCheng (+ OriginalGaoCheng ResultGaoCheng))
      (setq ResultGaoCheng (- OriginalGaoCheng ResultGaoCheng))
      )
      (setq OriginalGaoCheng ResultGaoCheng)
      (entmod (subst (cons 1 (rtos ResultGaoCheng 2 3))
                     (assoc 1 obstr)
                     obstr
            )
      )
      (entupd obname)
   )
   (T (princ "\n所择了多个单行文本,请重新选择!"))
   )
   )
   ;;限制只允许选择一个有效高程文本
)
;;确定起点井底高程
;;;------------------------------------------------------------------------
)
)
)
)
(princ)
)
;;;------------------------------------------------------------------------

5061220 发表于 2009-8-28 20:03:00

下了，支持！

yxhhu911 发表于 2010-6-28 19:31:00

楼主辛苦，好人有好报！

alvintqs 发表于 2010-12-7 14:03:04

呵呵，一直在用楼主的这个工具，今天才看到楼主开的帖子，谢谢了

页: [1] 2

明经CAD社区's Archiver

自己写的“市政排水设计工具”程序及源代码