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

guangdonglbq

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

  喜欢就下载，不喜欢就算了。水平有限，漫骂请免。

本想一起传个使用的实例，但论坛附件限制文件大小仅为200kb，文件压缩后还越过200kb，就不上传了，需要下载的，可以到http://www.jpszx.com/readWTtidMB55164.html去下载

技术工作室

支持一下顶一个

SYTDD

谢谢楼主分享！

weijunqi757

支持一下，辛苦了~！

hstea

下了！支持你！！

aaa19842002

顶

！！！！！！！！！！

leishusheng

下了！支持你！！

sliwalydh

支持一下

wowan1314

兄弟我不会编程，但习惯用纯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 ob  nil
            obn 2
      )
     )
    )
   )
   (T nil)
  )
)
;;限制只允许选择一个有效高程文本
;;确定起点井底高程
    (setq StrFenGe "-")
   (princ "\n后续井底高程相对于起点井底高程:")
   (setq keyW s)
;;;------------------------------------------------------------------------
   (while (= GoOn "Continue")
;;;------------------------------------------------------------------------
;;;以下控制选择正确的"管径-管道-标高"文本
    (setq obn 2
          ob  nil
    )
    (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 ob  nil
               obn 2
         )
        )
       )
      )
      (T (princ "\n所择了多个单行文本,请重新选择!"))
     )
    )
;;;------------------------------------------------------------------------
;;;输出计算结果
    (if (= GoOn "Continue")
     (progn
;;;以下选择需要输入计算结果的本
      (setq obn 2
            ob  nil
      )
      (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

下了，支持！

yxhhu911

楼主辛苦，好人有好报！

alvintqs

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