自动精确横断面绘制

yxh1202 · 发表于 2013-5-24 11:58:50

本帖最后由 yxh1202 于 2013-5-24 17:01 编辑

如图所示，因为工作中经常计算工程量，就是原始测量回来，展测量点，要精确计算断面面积，采取将测量点投影到横断面线上，求得各点的修正平距，然后根据平距和高差绘制一个精确的横断面。
现在想进行自动化，思路如下：
1、选择第N个横断面的测量点（已经展到图上）。
2、根据所选定的点，求出各点在垂线上的垂足点。
3、利用垂足点求得相邻两点的投影距离
4、利用投影距离，高差绘制一条多线段。
目前的难点是：
一、选定多个点后，能不能按照点得生成顺序来产生循环，因为野外测量各点都有编号，但展点后看属性没有顺序。
请高人指点迷津

Gu_xl · 发表于 2013-5-24 13:47:32

请在论坛搜索点沿曲线排序的相关代码

yxh1202 · 发表于 2013-5-24 14:23:57

Gu_xl 发表于 2013-5-24 13:47
请在论坛搜索点沿曲线排序的相关代码

按道理说每个断面上的地面点是按照测量的顺序展绘的，应当有顺序啊。谢谢

soly2006 · 发表于 2013-5-25 15:11:50

本帖最后由 soly2006 于 2013-5-25 16:21 编辑

;本程序为南方cass高程点自动吸附到直接上，作断面时经常用到
;选择直接->输入直线附近点的范围->OK
;季鸟 2012-6-6
(defun c:s3(/ osm_old line1 qq h i pt1 pt2 ranlst ss centn xyh xyh1)
(Setvar "Cmdecho" 0)
(command "undo" "be")
(setq osm_old (getvar "osmode"))
(setvar "osmode" 0)
(setq line1 (car (entsel " 选择直线L: ")))
(setq dis2line (getreal "\n 输入点范围： "))
(if (and line1 dis2line)
(progn
(setq pt1 (cdr (assoc 10 (entget line1))))
(setq pt2 (cdr (assoc 11 (entget line1))))
(princ (angle pt1 pt2))
(setq ranlst (list (polar pt1 (- (angle pt1 pt2) (/ PI 2)) dis2line)
(polar pt1 (+ (angle pt1 pt2) (/ PI 2)) dis2line)
(polar pt2 (- (angle pt2 pt1) (/ PI 2)) dis2line)
(polar pt2 (+ (angle pt2 pt1) (/ PI 2)) dis2line)))
(setq ss (ssget "CP" ranlst '((0 . "INSERT") (8 . "GCD"))))
)
)
(setq i 0)
(while (setq s ( ssname ss i ))
(setq centn (entget s))
(setq xyh (cdr (assoc 10 centn)))
(setq h (caddr xyh))
(setq qq (vlax-curve-getclosestpointto (vlax-ename->vla-object line1) xyh t));垂点
(setq xyh1 (list (car qq) (cadr qq) h))
(command "_move" s "" xyh xyh1)
(command "change" s "" "p" "e" h "");;置对象标高
(setq i (1+ i))
);endwhile
(setvar "osmode" osm_old)
(Setvar "Cmdecho" 1)
(command "undo" "e")
)

;本程序为 南方cass高程点自动吸附到直接上，作断面时经常用到 
;选择直接->输入直线附近点的范围->OK 
;季鸟 2012-6-6 
(defun c:s3(/ osm_old line1 qq h i pt1 pt2 ranlst ss centn xyh xyh1) 
 (Setvar "Cmdecho" 0) 
 (command "undo" "be") 
(setq osm_old (getvar "osmode")) 
(setvar "osmode" 0) 
 (setq line1 (car (entsel "  选择直线L:  "))) 
 (setq dis2line (getreal "\n 输入点范围： ")) 
 (if (and line1 dis2line) 
 (progn 
  (setq pt1 (cdr (assoc 10 (entget line1)))) 
 
  (setq pt2 (cdr (assoc 11 (entget line1))))   
    (princ (angle pt1 pt2)) 
  (setq ranlst (list (polar pt1 (- (angle pt1 pt2) (/ PI 2)) dis2line) 
                     (polar pt1 (+ (angle pt1 pt2) (/ PI 2)) dis2line) 
                   (polar pt2 (- (angle pt2 pt1) (/ PI 2)) dis2line) 
                   (polar pt2 (+ (angle pt2 pt1) (/ PI 2)) dis2line))) 
  (setq ss (ssget "CP" ranlst '((0 . "INSERT") (8 . "GCD")))) 
  ) 
 ) 
 (setq i 0) 
 (while (setq s ( ssname ss i )) 
  (setq centn (entget s)) 
  (setq xyh (cdr (assoc 10 centn))) 
  (setq h (caddr xyh)) 
  (setq qq (vlax-curve-getclosestpointto (vlax-ename->vla-object line1) xyh t));垂点 
  (setq xyh1  (list (car qq) (cadr qq) h)) 
  (command "_move" s "" xyh xyh1) 
  (command "change" s "" "p" "e" h "");;置对象标高 
  (setq i (1+ i)) 
   
  );endwhile 
  (setvar "osmode" osm_old) 
   (Setvar "Cmdecho" 1) 
   (command "undo" "e") 
)

yxh1202 · 发表于 2013-5-26 12:52:13

本帖最后由 yxh1202 于 2013-5-26 12:54 编辑

排序问题已经解决了
(vl-load-com)
(defun SORT-SE (SE DXF INT FUZZ K / ENT INDEX LST NEWLST NEWSE TMP)
 ;;建立排序列表
 (setq LST '()
 INDEX 0
 )
 (repeat (sslength SE)
(setq ENT (entget (ssname SE INDEX))
 TMP (cdr (assoc DXF ENT))
)
(if (and INT
 (= (type INT) 'INT)
 (= (type TMP) 'list)
 (< INT (length TMP))
 )
 (setq TMP (nth INT TMP))
)
(setq LST (cons
 (list TMP (cdr (assoc 5 ENT)))
 LST
 )
)
(setq INDEX (1+ INDEX))
 )
 ;;排序操作
 (if (and FUZZ
 (or
 (= (type FUZZ) 'INT)
 (= (type FUZZ) 'REAL)
 )
 (or
 (= (type TMP) 'INT)
 (= (type TMP) 'REAL)
 )
 )
(setq NEWLST
 (vl-sort LST
 (function (lambda (E1 E2)
 (< (+ (car E1) FUZZ) (car E2))
 )
 )
 )
)
(setq NEWLST
 (vl-sort LST
 (function (lambda (E1 E2)
 (< (car E1) (car E2))
 )
 )
 )
)
 )
 ;;如果K为T，则倒置
 (if K
(setq NEWLST (reverse NEWLST))
 )
 ;;组织排序后的选择集
 (setq NEWSE (ssadd))
 (foreach TMP NEWLST
(setq NEWSE (ssadd (handent (cadr TMP)) NEWSE))
 )
 ;;返回值
 NEWSE
) ;_结束defun
;;;=============================================================
;;;测试
(defun C:TT (/ S1 S2 I SIZE)
 (IF (SETQ S1 (SSGET))
 ;(if (setq S1 (ssget '((0 . "TEXT"))))
(progn
 ;;
 ;(setq SIZE (cdr (assoc 40 (entget (ssname S1 0)))))
 (setq size 0.1)
 ;;排序
;;; ;;x坐标排序：
 ;(setq S2 (SORT-SE S1 10 0 (* 0.6 SIZE) nil))
;;; ;;y坐标排序：
 (setq S2 (SORT-SE S1 10 1 (* 0.6 SIZE) t))
 ;;先y后x排序：
 ;(setq S2 (SORT-SE (SORT-SE S1 10 1 (* 0.4 SIZE) nil) 10 0 (* 0.8 SIZE) nil ) )
;;; ;;按照颜色排序：
;;; (setq S2 (SORT-SE S1 62 nil nil nil))
;;; ;;按照内容排序：
;;; (setq S2 (SORT-SE S1 1 nil nil nil))
 ;;
 (setq I 0)
 (repeat (sslength S2)
 (princ "\n")
 (princ (cdr (assoc 10 (entget (ssname S2 I))))) ;显示排序结果。
 (setq I (1+ I))
 )
)
 )
 (princ)
)
问题提出：选定这些块后，应当尽快求出点位的最大和最小X,Y值，然后根据 maxX-minX 与 maxY-minY 的大小来确定按照X还是Y排序。那么求最大和最小X,Y值怎么办呢，求指导

yxh1202 · 发表于 2013-5-27 11:27:13

本帖最后由 yxh1202 于 2013-5-27 11:28 编辑

请高人指点：
(vl-load-com)
 ;---------排序操作-------------------------------------------------
(defun SORT-SE (SE DXF INT FUZZ K / ENT INDEX LST NEWLST NEWSE TMP)
 ;;建立排序列表
 (setq LST '()
 INDEX 0
 )
 (repeat (sslength SE)
(setq ENT (entget (ssname SE INDEX))
 TMP (cdr (assoc DXF ENT))
)
(if (and INT
 (= (type INT) 'INT)
 (= (type TMP) 'list)
 (< INT (length TMP))
 )
 (setq TMP (nth INT TMP))
)
(setq LST (cons
 (list TMP (cdr (assoc 5 ENT)))
 LST
 )
)
(setq INDEX (1+ INDEX))
 )
 ;;排序操作
 (if (and FUZZ
 (or
 (= (type FUZZ) 'INT)
 (= (type FUZZ) 'REAL)
 )
 (or
 (= (type TMP) 'INT)
 (= (type TMP) 'REAL)
 )
 )
(setq NEWLST
 (vl-sort LST
 (function (lambda (E1 E2)
 (< (+ (car E1) FUZZ) (car E2))
 )
 )
 )
)
(setq NEWLST
 (vl-sort LST
 (function (lambda (E1 E2)
 (< (car E1) (car E2))
 )
 )
 )
)
 )
 ;;如果K为T，则倒置
 (if K
(setq NEWLST (reverse NEWLST))
 )
 ;;组织排序后的选择集
 (setq NEWSE (ssadd))
 (foreach TMP NEWLST
(setq NEWSE (ssadd (handent (cadr TMP)) NEWSE))
 )
 ;;返回值
 NEWSE
) ;_结束defun
;;;=============================================================
;;;测试
(defun C:HDM (/ S1 S2 I SIZE)
 (setvar "cmdecho" 0)
 (setq en (entsel "选择一条直线:"))
(IF (SETQ S1 (SSGET))
(setq xmin 0 ymin 0 xmax 0 ymax 0)
(setq I 0)
 (repeat (sslength S1)
 (setq x (cadr (assoc 10 (entget (ssname S1 I)))))
 (setq y (caddr (assoc 10 (entget (ssname s1 I)))))
 (cond
 ((> xmin x) (setq xmin x))
 ((> ymin y) (setq ymin y))
 ((< xmax x) (setq xmax x))
 ((< ymax y) (setq ymax y))
 )
 (setq I (1+ I))
 )
(if (> (- xmax xmin) (- ymax ymin))
 ;;x坐标排序：
 (setq S2 (SORT-SE S1 10 0 (* 0.6 SIZE) nil))
;;y坐标排序：
 ;(setq S2 (SORT-SE S1 10 1 (* 0.6 SIZE) t))
)
 (progn
 (setq size 0.1)
 (setq I 0)
 (repeat (sslength S2)
 (setq pen_data (entget (SSNAME S2 I)))
 (setq ppt (assoc 10 pen_data))
 (setq pp (cdr ppt))
 (setq en_data (entget (car en)))
 (setq Perpt (vlax-curve-getClosestPointTo (car en) pp T))
 (entmake (APPEND '((0 . "LINE")
 (100 . "AcDbEntity")
 (100 . "AcDbLine")
 (8 . "0")
 )
 (LIST (CONS 10 pp) (CONS 11 perpt)) ;产生线的起点10，端点11列表

 )
 )
 (princ "\n")
 (princ (cdddr (assoc 10 (entget (ssname S2 I))))) ;显示排序结果。
 (setq I (1+ I))
 )
) ;end progn
 )
 (princ)
)

问题是不知道排序成功了没有，显示排序结果老是X值，想看看Z坐标值排序结果。
(princ (cdddr (assoc 10 (entget (ssname S2 I))))) ;显示排序结果。这句是不是有问题

cuyongping · 发表于 2013-5-27 15:40:12

学习学习！呵呵

VBALISPER · 发表于 2013-6-13 15:43:37

说似精确,实则一点也不精确啊.测剖面里,直接要求测量人员沿着你的线的方位进行测量.无需投影到剖面线上这一步.

yshf · 发表于 2013-6-13 18:35:39

本帖最后由 yshf 于 2013-6-13 18:40 编辑

应将那些散点组成Delaunay三角网，再根据横断面上点位于哪个三角形内来内插出其高程值，再依据该点距路线的距离及内插出的高程画横断面线，这样做似乎准确一点点。

xiabin68 · 发表于 2013-6-14 00:28:34

yshf 发表于 2013-6-13 18:35
应将那些散点组成Delaunay三角网，再根据横断面上点位于哪个三角形内来内插出其高程值，再依据该点距路线的 ...

赞同你的观点

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

[讨论] 自动精确横断面绘制

本帖子中包含更多资源

本帖子中包含更多资源

点评

本帖子中包含更多资源