根据图面三角网计算喷锚边坡表面积并统计
根据图面三角网计算喷锚边坡表面积并统计，解决工程中基坑边坡喷锚面积统计问题，前提是测量数据准确、三角网符合实际地形。(defun vxs (e / i v lst)(setq i 0)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(reverse lst))
;;;;;;;;;;;;;;;
(defun c:tt11 ( / lst ent pts pt demj zmj ) ;标记三角网表面积
(setq lst (ssget '( (0 . "polyline") (8 . "sjw")) ) )
(setq i 0)
(setq zmj 0.000)
(while(< i (sslength lst))
(setq ent (ssname lst i))
(setq pts (vxs ent))
(setq len (length pts))
(setq pt (mapcar
'(lambda(x)
(/ x len)
)
(apply
'mapcar
(cons '+ pts)
)
)
)
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument Acadobject)
mSpace (vla-get-ModelSpace Acaddocument)) ;初始化系统
(setq demj (vlax-curve-getArea(vlax-ename->vla-object ent)))
(entmake (list (cons 0"TEXT") (cons 1 (rtos demj 2 3)) (cons 10 pt)
(cons 40 0.5)
(cons 8 "三角网表面积")
))
(setq zmj(+ zmj demj))
(setq i (+ i 1))
)
(entmake (list (cons 0"TEXT") (cons 1 (rtos zmj 2 3)) (cons 10 (getpoint "\请输入总表面积插入点"))
(cons 40 3)
(cons 8 "三角网表面积")
))
(print zmj)
(princ)
) 选择节点少于3个的三维多段线
(defun vxs (e / i v lst)
(setq i 0)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(reverse lst))
;;;;;;;;;;;;;;;
(defun c:xz11 (/ kk lst i ent pts len)
(setq lst (ssget '( (0 . "polyline") (8 . "0,sjw")) ) )
(setq i 0)
(setq kk (ssadd))
(while(< i (sslength lst))
(setq ent (ssname lst i))
(setq pts (vxs ent))
(setq len (length pts))
(if (< len 3) (ssadd ent kk)) ;;;选择节点少于3个的三维多段线
(setq i (+ i 1))
)
(sssetfirst nil kk)
)
那个大神能 把下图中，选中的多段线范围内边面积求出，那就厉害了。
CASS自带有表面积计算功能，处理的方法是下图多段线内在生成很多小三角，再计算面积。
我们编程可以用海伦公式计算单个三角的面积，累计也行。
编程用comand 命令调用CASS的表面功能，只能循环4次，批量处理超过4次就现在了使用。 有更新吗?楼主？
GreenWood(181976640) 2015-8-4 16:18:15
@树櫴希德
;;查找并删除角度较小的三角网
(defun c:tt(/ ss i en lens)
(if (and (setq ss(ssget '((0 . "POLYLINE")(8 . "TIN"))))
(> (sslength ss) 0)
(setq i 0)
)
(while (setq en(ssname ss i))
(setq lens (vlens en)
lens (vl-sort lens '<)
)
(if (< (/ (car lens) (last lens)) 0.01);修改这里0.001~~~
(entdel en)
)
(setq i (1+ i))
)
)
)
；；；；；；；；；；；；；；；；；；
GreenWood(181976640) 2015-8-4 16:08:21
那特么更简单了
(defun c:tt(/)
(prompt "三角形中心(我不知道是什么心，反正在里面就是了)")
(setq ent(car (entsel)))
(if (= (vlax-curve-getEndParam ent) 3.0)
(progn
(setq pt1 (vlax-curve-getPointAtParam ent 1.0)
pt2 (vlax-curve-getPointAtParam ent 2.0)
pt3 (vlax-curve-getPointAtParam ent 3.0)
)
(setq pt (mapcar '(lambda (x y z) (/ (+ x y z) 3.0)) pt1 pt2 pt3))
(entmake (list '(0 . "CIRCLE") (cons 10 pt) (cons 40 5)))
)
)
(princ)
);end defun
作者真乃测绘接的创新研究型人才啊，占个沙发先。只要你一出作品，我肯定光顾。不错，很实用的东西。 厉害！！！！ (defun tt (lst / a l1)
(setq l1 nil
l1 (list (list (car lst)))
lst (cdr lst)
)
(while lst
(setq a (car lst)
lst (cdr lst)
)
(if (= 1 (- a (caar l1)))
(setq l1 (cons (cons a (car l1)) (cdr l1)))
(setq l1 (cons (list a) l1))
)
)
(reverse (mapcar 'reverse l1))
)
(setq lis'(1 2 3 4 5 1120 21 22 23 24))
命令: (tt lis)
((1 2 3 4 5) (11) (20 21 22 23 24)) 太牛逼了你
(defun c:tt11 ( / lst ent pts pt demj zmj i) ;求平均数
(setq lst (ssget '((0 . "text,mtext") (1 . "**") ) ))
(setq i 0)
(setq zmj 0.000)
(while(< i (sslength lst))
(setq ent (ssname lst i))
(setq demj (atof(cdr (assoc 1 (entget ent)))))
(setq zmj(+ zmj demj))
(setq i (+ i 1))
)
(entmake (list (cons 0"TEXT") (cons 1 (strcat "总和"(rtos zmj 2 3) "平均数" (rtos (/ zmj i) 2 3) )) (cons 10 (getpoint "\请输入总和插入点"))
(cons 40 3)
(cons 8 "总和")
))
(print zmj)
(print (/ zmj i))
(princ)
) 本帖最后由 llsheng_73 于 2015-8-9 09:05 编辑
树櫴希德 发表于 2015-8-7 23:50 http://bbs.mjtd.com/static/image/common/back.gif
(defun c:tt11 ( / p zmj i) ;求平均数
(if(setq i -1 zmj 0
lst(ssget '((0 . "text,mtext") (1 . "**")))
p(getpoint "\n请指定总和插入点"))
(entmake(list'(0 . "TEXT")
(cons 1(strcat"总和"
(rtos(repeat(sslength lst)
(setq i(1+ i)
zmj(+(atof(cdr (assoc 1 (entget (ssname lst i)))))zmj)))2 3)
"平均数"(rtos(/ zmj(1+ i))2 3)))
(cons 10 p)
'(40 . 3)
'(8 . "总和"))))
)
另外，事实上"A123.4Bc"也符合过滤条件(1 . "**")，也就是说想选中全数值文本得用别的过滤条件或者采用别的手段
为了保证rtos最后一个参数起作用，需要设置系统变量DIMZIN 不知道后面的明码是干什么用的
页:
[1]
2