（完成）[编程申请]：建议增加滑坡计算前期数据处理功能

hooyd · 发表于 2003-7-29 13:05:37

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

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

×

附图所示是一个滑坡剖面，已进行条分，能否通过点选将滑坡各条块的面积、平均高度、滑面长度、滑面倾角等数据读出，最好能转到excel，便于后面的稳定性和推力计算。

通过读交点的坐标计算应该很容易得到，请斑竹帮忙看看。

eachy · 发表于 2003-7-30 20:08:09

DWF文件不正常。

hooyd · 发表于 2003-7-30 22:11:28

eachy 兄，我这里是正常，不知是为什么？

hooyd · 发表于 2003-7-30 22:14:08

eachy 我的机器可以看到，但之前有错误提示，请帮忙看看是怎么回事？

eachy · 发表于 2003-7-31 00:29:10

你说说各个要求的公式，输出excel的格式。

求选择上下两条线求与竖线的交点，这个步骤用API写很简单，然后就可以用对应的点表进行运算求各个参数，如果写txt文件最简单，写入excel就需要好多代码，VLisp论坛对CAD－》Excel的讨论已经有很多帖子了。

hooyd · 发表于 2003-7-31 14:52:01

结果可以用文本文件格式输出，附图种红色的单元即是需要的内容，分成几列并加上“条块高度”列即可

hooyd · 发表于 2003-7-31 14:58:59

关于自动条分，我是这样想的：以滑面（即下面那条线）为准，遇到滑面角度发生变化时，自该点垂直向上作一条分线至坡面，即完成一个条分，以此类推直至条分完整个剖面。

eachy · 发表于 2003-7-31 18:55:08

划面长度指哪个？
更新：自动根据滑面折点划分条块并输出数据

;|
输出式 txt 格式
条块号面积长度平均高度倾角
|;
(defun c:XDTB_PreH (/ $get_polyVerts $curve_direct
$curve_intpoint e1 e2
pl1 pl2 p11 p12
p21 p22 arealst jlst
hlst $end_j num dlst
fi
)
(setvar "dimzin" 0)
(defun $get_polyVerts (poly / n plst)
(setq n 0)
(repeat (xdrx_polyline_numVerts poly)
(setq plst (cons (xdrx_polyline_getPointAt poly n) plst)
n (1+ n)
)
)
(reverse plst)
)
(defun $curve_direct (cu / sp ep)
(setq sp (car (xdrx_curve_getpoint cu))
ep (last (xdrx_curve_getpoint cu))
)
(< (cadr sp) (cadr ep))
)
(if (and (setq e1 (xdrx_entsel "\n选择地面线: " '((0 . "*line"))))
(setq e2 (xdrx_entsel "\n选择滑面线: " '((0 . "*line"))))
(not (xdrx_polyline_hasBulges (car e2)))
)
(progn
(if ($curve_direct (car e1))
(xdrx_curve_reverse (car e1))
)
(if ($curve_direct (car e2))
(xdrx_curve_reverse (car e2))
)
(setq pl1 ($get_polyVerts (car e2)))
(setq dlst (mapcar '(lambda (x y)
(distance x y)
)
(reverse (cdr (reverse pl1)))
(cdr pl1)
)
jlst (mapcar '(lambda (x y)
(- pi (angle x y))
)
(cdr pl1)
(reverse (cdr (reverse pl1)))
)
)
(mapcar '(lambda (x / pt e p)
(setq pt (polar x _pi2 1))
(xdrx_line1 x pt)
(setq e (entlast))
(xdrx_setenttodb e)
(setq p (car (xdrx_getinters e (car e1) 1)))
(xdrx_modent 11 p)
(setq pl2 (cons p pl2))
(setq hlst (cons (distance x p) hlst))
)
(reverse (cdr (reverse (cdr pl1))))
)
(setq pl2 (reverse (append (list (last pl1))
pl2
(list (car pl1))
)
)
hlst (cons 0.00 hlst)
)
(while (> (length pl1) 1)
(setq arealst
(cons
(abs
(apply
'xdrx_parea
(list (car pl1) (cadr pl1) (cadr pl2) (car pl2))
)
)
arealst
)
)
(setq pl1 (cdr pl1)
pl2 (cdr pl2)
)
)
(setq num 1)
(setq fi (open "c:/$ea_temp.txt"
(if (findfile "c:/$ea_temp.txt")
"w"
"a"
)
)
)
(write-line "条块号\t\t面积\t\t滑面长度\t高度\t\t倾角" fi)
(mapcar '(lambda (a b c d /)
(write-line
(strcat (itoa num)
"\t\t"
(rtos a 2 2)
"\t\t"
(rtos b 2 2)
"\t\t"
(rtos c 2 2)
"\t\t"
(rtos d 2 2)
)
fi
)
(setq num (1+ num))
;(close fi)
)
(reverse arealst)
dlst
(reverse hlst)
(reverse jlst)
)
(close fi)
(if (setq fi (findfile "c:/$ea_temp.txt"))
(startapp "notepad.exe" fi)
)
)
nil
)
(princ)
)

;| 
输出式 txt 格式 
条块号 面积  长度 平均高度 倾角 
|; 
(defun c:XDTB_PreH (/               $get_polyVerts             $curve_direct 
                    $curve_intpoint          e1             e2 
                    pl1               pl2          p11             p12 
                    p21               p22          arealst    jlst 
                    hlst       $end_j          num             dlst 
                    fi 
                   ) 
  (setvar "dimzin" 0) 
  (defun $get_polyVerts        (poly / n plst) 
    (setq n 0) 
    (repeat (xdrx_polyline_numVerts poly) 
      (setq plst (cons (xdrx_polyline_getPointAt poly n) plst) 
            n         (1+ n) 
      ) 
    ) 
    (reverse plst) 
  ) 
  (defun $curve_direct (cu / sp ep) 
    (setq sp (car (xdrx_curve_getpoint cu)) 
          ep (last (xdrx_curve_getpoint cu)) 
    ) 
    (< (cadr sp) (cadr ep)) 
  ) 
  (if (and (setq e1 (xdrx_entsel "\n选择地面线: " '((0 . "*line")))) 
           (setq e2 (xdrx_entsel "\n选择滑面线: " '((0 . "*line")))) 
           (not (xdrx_polyline_hasBulges (car e2))) 
      ) 
    (progn 
      (if ($curve_direct (car e1)) 
        (xdrx_curve_reverse (car e1)) 
      ) 
      (if ($curve_direct (car e2)) 
        (xdrx_curve_reverse (car e2)) 
      ) 
      (setq pl1 ($get_polyVerts (car e2))) 
      (setq dlst (mapcar '(lambda (x y) 
                            (distance x y) 
                          ) 
                         (reverse (cdr (reverse pl1))) 
                         (cdr pl1) 
                 ) 
            jlst (mapcar '(lambda (x y) 
                            (- pi (angle x y)) 
                          ) 
                         (cdr pl1) 
                         (reverse (cdr (reverse pl1))) 
                 ) 
      ) 
      (mapcar '(lambda (x / pt e p) 
                 (setq pt (polar x _pi2 1)) 
                 (xdrx_line1 x pt) 
                 (setq e (entlast)) 
                 (xdrx_setenttodb e) 
                 (setq p (car (xdrx_getinters e (car e1) 1))) 
                 (xdrx_modent 11 p) 
                 (setq pl2 (cons p pl2)) 
                 (setq hlst (cons (distance x p) hlst)) 
               ) 
              (reverse (cdr (reverse (cdr pl1)))) 
      ) 
      (setq pl2         (reverse (append (list (last pl1)) 
                                  pl2 
                                  (list (car pl1)) 
                          ) 
                 ) 
            hlst (cons 0.00 hlst) 
      ) 
      (while (> (length pl1) 1) 
        (setq arealst 
               (cons 
                 (abs 
                   (apply 
                     'xdrx_parea 
                     (list (car pl1) (cadr pl1) (cadr pl2) (car pl2)) 
                   ) 
                 ) 
                 arealst 
               ) 
        ) 
        (setq pl1 (cdr pl1) 
              pl2 (cdr pl2) 
        ) 
      ) 
      (setq num 1) 
      (setq fi (open "c:/$ea_temp.txt" 
                     (if (findfile "c:/$ea_temp.txt") 
                       "w" 
                       "a" 
                     ) 
               ) 
      ) 
      (write-line "条块号\t\t面积\t\t滑面长度\t高度\t\t倾角" fi) 
      (mapcar '(lambda (a b c d /) 
                 (write-line 
                   (strcat (itoa num) 
                           "\t\t" 
                           (rtos a 2 2) 
                           "\t\t" 
                           (rtos b 2 2) 
                           "\t\t" 
                           (rtos c 2 2) 
                           "\t\t" 
                           (rtos d 2 2) 
                   ) 
                   fi 
                 ) 
                 (setq num (1+ num)) 
                                        ;(close fi) 
               ) 
              (reverse arealst) 
              dlst 
              (reverse hlst) 
              (reverse jlst) 
      ) 
      (close fi) 
      (if (setq fi (findfile "c:/$ea_temp.txt")) 
        (startapp "notepad.exe" fi) 
      ) 
    ) 
    nil 
  ) 
  (princ) 
)

hooyd · 发表于 2003-7-31 19:24:28

滑面长度指的是每个条块下面那条线的长度.

感谢eachy 这么快给出程序！！我先试一下。

hooyd · 发表于 2003-8-1 00:15:20

请eachy 老兄看看：综合考虑滑面和水位线进行条分的过程。

输出格式：
条块号条块面积条块高度滑面倾角水位以上条块面积水位以上条块高度
水位以下条块面积水位以下条块高度水位线倾角

下载地址：http://www.xdcad.net/techcenter/ ... 803231200_newtf.swf

<embed src=http://www.xdcad.net/techcenter/upload/file/11726_20030803231200_newtf.swf quality=high width=1024 height=768 loop=true type="application/x-shockwave-flash">
</embed>

hooyd · 发表于 2003-8-1 23:44:00

这一次的代码已经很稳定了。

下载地址：http://www.xdcad.net/techcenter/ ... 030803232605_tf.swf

<embed src=http://www.xdcad.net/techcenter/upload/file/11726_20030803232605_tf.swf quality=high width=1024 height=768 loop=true type="application/x-shockwave-flash">
</embed>

eachy · 发表于 2003-8-2 12:19:30

已添加至工具箱即时更新。

;|
输出式 txt 格式
条块号条块面积条块高度滑面长度滑面倾角水位线长水位线倾角水位线上高度水位线上面积水位线下高度水位线下面积"
;
适用于 ACAD2002 + 晓东工具箱环境
[url]http://www.xdcad.net[/url] By eachy 2003.08.05
|;

复制代码

furge · 发表于 2005-3-1 19:52:41

程序已试过，很好用，但有一个问题，程序中条块的划分是依照滑面的拐点，但有时候条块的划分也要考虑到地形线的转折起伏，可否在程序中考虑这一点，或者，可由手工划分而自动生成各条块数据。

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

（完成）[编程申请]：建议增加滑坡计算前期数据处理功能

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

相关帖子

浏览过的版块