根据三角网等高线切横断面

树櫴希德 · 发表于 2015-7-31 21:50

论坛上的切断面程序要么是只能处理直线段要么处理的数据不能最详细反映地形特征（按距离等分了），有没有根据等高线或者三角网（处理等高线与横断面线交点或者三角网跟横断面线交叉点提取值转换为横断面数据的）同时纵断面线支持多段线（多段线含圆弧的）LSP。下面这个是根据三角网或者等高线与横断面线交点生成点位的

;|;;===========================================================================
通用函数 ;
功能：求两个线条对象的交点 ;
适用对象: Line、Circle、Arc、Ellipse、Polyline、 ;
LWPolyline、3dPolyline、Spline ;
参数：OBJ1 ----对象1 ;
OBJ2 ----对象2 ;
Extend ----延伸选项 ;
0 acExtendNone ;
1 acExtendThisEntity ;
2 acExtendOtherEntity ;
3 acExtendBoth ;
ZZZ ----输出选项 ;
"=0" Z值取0 ;
"F1" 取第一个对象上的点 ;
"F2" 取第二个对象上的点 ;
"MAX" 取Z值大者 ;
"MIN" 取Z值小者 ;
Fuzz ----允许偏差值 ;
返回：若成功，返回点位表；否则返回nil
日期：zml84 于2007-11-05
;;|;
(vl-load-com)
(defun ZL-GETINTERS1 (OBJ1 OBJ2 EXTEND ZZZ FUZZ / ENT1
ENT2 PT10 PT11 PT20 PT21 OBJ11 OBJ22
ARRAY LST LST_PT I PT PT1 PT2
Z1 Z2
)
;;0、对参数的格式化处理
(if (and (= (type EXTEND) 'INT)
(<= 0 EXTEND 3)
)
()
(setq EXTEND 0)
)
(setq ZZZ (strcase ZZZ))
;;======================
;;1、获取交点集合>>>>>>>
(if (and (= (vla-get-objectname OBJ1) "AcDbLine")
(= (vla-get-objectname OBJ2) "AcDbLine")
)
;;对直线对象(line) 特别处理
(progn
(setq ENT1 (entget (vlax-vla-object->ename OBJ1))
ENT2 (entget (vlax-vla-object->ename OBJ2))
)
(setq PT10 (assoc 10 ENT1)
PT11 (assoc 11 ENT1)
PT20 (assoc 10 ENT2)
PT21 (assoc 11 ENT2)
)
;;去除Z坐标
(setq PT10 (list (cadr PT10) (caddr PT10))
PT11 (list (cadr PT11) (caddr PT11))
PT20 (list (cadr PT20) (caddr PT20))
PT21 (list (cadr PT21) (caddr PT21))
)
(setq LST (inters PT10 PT11 PT20 PT21 t))
(if LST
(setq LST (append LST '(0)))
)
)
(progn
;;=====================
;;复制实体
(setq OBJ11 (vla-copy OBJ1)
OBJ22 (vla-copy OBJ2)
)
;;向xy平面投影，将Z坐标改为0
(TOXY OBJ11)
(TOXY OBJ22)
;;获取交点集合
(setq ARRAY (vla-intersectwith OBJ11 OBJ22 EXTEND))
;;删除复制后的对象
(vla-delete OBJ11)
(vla-delete OBJ22)
;;由数组转换为表
(if (and ARRAY
(> (vlax-safearray-get-u-bound
(vlax-variant-value ARRAY)
1
)
1
)
)
(progn
(setq LST (vlax-safearray->list
(vlax-variant-value ARRAY)
)
)
)
)
)
)
;;======================
;;2、分析整理>>>>>>>
(setq LST_PT '())
(if LST
(progn
(setq I 0)
(repeat (/ (length LST) 3)
;;2.1 获取当前点位
(setq PT (list (nth I LST)
(nth (+ 1 I) LST)
(nth (+ 2 I) LST)
)
)
;;2.2 获取对象上对应点位
(setq PT1 (vlax-curve-getclosestpointtoprojection
OBJ1
PT
'(0 0 1)
)
PT2 (vlax-curve-getclosestpointtoprojection
OBJ2
PT
'(0 0 1)
)
)
(setq Z1 (caddr PT1)
Z2 (caddr PT2)
)
;;2.3 效验偏差值
;;就是说：过滤:参数中有偏差值选项，却不满足要求的点位
(if (and FUZZ
(or (= (type FUZZ) 'REAL)
(= (type FUZZ) 'INT)
)
(not (equal Z1 Z2 FUZZ))
)
;; 空处理
()
;;2.4 对输出选项的处理
(progn
(cond
((= ZZZ "F1")
(setq PT PT1)
)
((= ZZZ "F2")
(setq PT PT2)
)
((= ZZZ "MAX")
(if (> Z1 Z2)
(setq PT PT1)
(setq PT PT2)
)
)
((= ZZZ "MIN")
(if (< Z1 Z2)
(setq PT PT1)
(setq PT PT2)
)
)
(t
(setq PT PT)
)
) ;_结束cond
(if (member PT LST_PT)
()
(setq LST_PT (cons PT LST_PT))
)
) ;_结束progn
) ;_结束if
(setq I (+ I 3))
) ;_结束repeat
) ;_结束progn
) ;_结束if
;;3、返回结果>>>>>
LST_PT
) ;_结束defun
;;;============================================================
;;;功能：曲线实体上每个控制点的z坐标值置为0.0
(defun TOXY (OBJ / NAME PT1 TP2)
;;取得实体的类型名称
(setq NAME (vla-get-objectname OBJ))
(cond
;;类型1
;;直线(line)
((= NAME "AcDbLine")
;;取得直线的起终点坐标
(setq PT1 (vlax-variant-value (vla-get-startpoint OBJ))
PT2 (vlax-variant-value (vla-get-endpoint OBJ))
)
;;改变z值为0.0
(vlax-safearray-put-element PT1 2 0.0)
(vlax-safearray-put-element PT2 2 0.0)
(vla-put-startpoint OBJ PT1)
(vla-put-endpoint OBJ PT2)
)
;;类型2
;;圆(circle)
;;圆弧(arc)
;;椭圆及椭圆弧(ellipse)
((or (= NAME "AcDbCircle")
(= NAME "AcDbArc")
(= NAME "AcDbEllipse")
)
;;取得中心点座标
(setq PT1 (vlax-variant-value (vla-get-center OBJ)))
;;改变中心点座标z值为0.0
(vlax-safearray-put-element PT1 2 0.0)
(vla-put-center OBJ PT1)
)
;;类型3
;;多段线(polyline、lwpolyline)
;;拟合的2维多段线(polyline、lwpolyline)
((or (= NAME "AcDbPolyline")
(= NAME "AcDb2dPolyline")
)
;;改变标高值为0.0
(vla-put-elevation OBJ 0.0)
)
;;类型4
;;三维多段线(3dpolyline)
((= NAME "AcDb3dPolyline")
;;取得3维多段线的控制点
(setq PT1 (vlax-variant-value (vla-get-coordinates OBJ))
I 0
)
(repeat (/ (length (vlax-safearray->list PT1)) 3)
(vlax-safearray-put-element PT1 (+ I 2) 0.0)
(setq I (+ I 3))
)
(vla-put-coordinates OBJ PT1)
)
;;类型5
;;样条曲线(Spline)
((= NAME "AcDbSpline")
;;取得样条曲线的拟合点
;;改变每个拟合点的z值为0.0
(setq PT1 (vlax-variant-value (vla-get-fitpoints OBJ))
I 0
)
(repeat (vla-get-numberoffitpoints OBJ)
(vlax-safearray-put-element PT1 (+ I 2) 0.0)
(setq I (+ I 3))
)
(vla-put-fitpoints OBJ PT1)
;;取得样条曲线的控制点
;;改变每个控制点的z值为0.0
(setq
PT2 (vlax-variant-value (vla-get-controlpoints OBJ))
I 0
)
(repeat (vla-get-numberofcontrolpoints OBJ)
(vlax-safearray-put-element PT2 (+ I 2) 0.0)
(setq I (+ I 3))
)
(vla-put-controlpoints OBJ PT2)
)
(t NIL)
)
) ;_结束defun
;(setq ppzzxx (ZL-GETINTERS (vlax-ename->vla-object(car (entsel) ) ) (vlax-ename->vla-object(car (entsel) ) ) 0 "f2" nil) )
(DEFUN C:TT()
(vl-load-com)
(setq m_ent1 (car (entsel "\n请选择剖切线: ")))
(setq m_ent2 (car (entsel "\n请选择一条等高线: ")))
(setq data(entget m_ent2 ))
(setq layer(assoc 8 data))
(setq 层名(CDR layer))
(SETQ SS (SSGET "X" ( list (cons 8 层名) (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE"))))
(SSSETFIRST SS)
(setq ii 0)
(repeat (sslength ss);循环选择集长度
(setq 单个图元 (ssname ss ii))
(setq ZL-GETINTERS (ZL-GETINTERS1 (vlax-ename->vla-object m_ent1) (vlax-ename->vla-object 单个图元) 0 "f2" nil))
;(setq 高程 (CADDR (vlax-curve-getStartPoint 单个图元))
;;; ps2(vlax-curve-getEndPoint m_ent2)
;)
(foreach n ZL-GETINTERS
;;; (print n)
(setq xzb (car n))
(setq yzb (cadr n))
(setq 高程 (CADDR n))
(entmake (list (cons 0 "TEXT") (cons 1 (vl-princ-to-string 高程)) (cons 10 (list XZB YZB 高程))
(cons 40 0.5)
(cons 8 "0000用于图元属性快速输出利用（简称“属性”图层）")
))
; 在下面画圆，这样就可以直接用“”读出里程及偏移，而孔号就是该点高程
(entmake (list '(0 . "POINT") (cons 10 (list XZB YZB 高程)) (cons 8 "0000用于图元属性快速输出利用（简称“属性”图层）")))
;(command "break" 单个图元 (list XZB YZB 高程) "@")
;(command "break" 单个图元 "f" (list XZB YZB 高程) (list XZB YZB 高程))
; (command "LINE" (LIST XZB YZB) '(0 0))
)
(setq ii (1+ ii))
)
;;; (sssetfirst nil ss)
)
(defun m_IntersectWith(m_ent1 单个图元 / m_obj1 m_obj2 m_objcopy1 m_objcopy2 m_jdtab m_jdtab1 i)
; 来源：3楼 [求助]任意两条线的交点坐标-AutoLISP/Visual LISP 编程技术-CAD论坛-明经CAD社区 - Powered by Discuz!
; http://bbs.mjtd.com/forum.php?mod=viewthread&tid=79868
;;适用对象: Line、Polyline、LWPolyline、Circle、Arc、Ellipse、3dPolyline、Spline
;;支持求空间虚交点，但Z坐标始终为0.0，要求Z坐标，请用(vlax-curve-getClosestPointToProjection)函数
(setq m_obj1 (vlax-ename->vla-object m_ent1))
(setq m_obj2 (vlax-ename->vla-object 单个图元))
(setq m_objcopy1 (vla-copy m_obj1));;复制第一条曲线实体
(setq m_objcopy2 (vla-copy m_obj2));;复制第二条曲线实体
(setq m_objcopy1 (m_ShadowToXY m_objcopy1));;得到投影实体
(setq m_objcopy2 (m_ShadowToXY m_objcopy2));;得到投影实体
(setq m_jdtab1 (vla-intersectwith m_objcopy1 m_objcopy2 acExtendnone));;得到交点集
(if (> (vlax-safearray-get-u-bound (vlax-variant-value m_jdtab1) 1) 1);;判断有无交点
(progn
(setq m_jdtab1 (vlax-safearray->list (vlax-variant-value m_jdtab1)));;safearray数组转换为list表
(setq i 0)
(repeat (/ (length m_jdtab1) 3)
(setq m_jd (list (nth i m_jdtab1) (nth (+ 1 i) m_jdtab1) (nth (+ 2 i) m_jdtab1)));;取得一个交点
(setq m_jdtab (cons m_jd m_jdtab));;构造交点表（(第一个交点) (第二个交点)。。。）
(setq i (+ 3 i))
)
)
(princ"\n两曲线无交点!")
)
(vla-delete m_objcopy1);;删除复制的第一条曲线实体
(vla-delete m_objcopy2);;删除复制的第二条曲线实体
(setq m_jdtab m_jdtab);;返回交点表，无交点返回nil
)
(defun m_ShadowToXY(m_obj / m_objname m_pts m_pts1 i)
;;对曲线实体m_obj创建一个投影至xy平面的曲线实体，即对曲线实体上每个控制点的z坐标值置为0.0
;;输入曲线实体(vla对象)
;;返回投影实体(vla对象)
(setq m_objname (vla-get-objectname m_obj));;取得实体的类型名称
;;; (m_princ "\nObjectName：" m_objname)
(cond
((= "AcDbSpline" m_objname);;样条曲线(Spline)
(setq i 0)
(setq m_pts (vlax-variant-value (vla-get-fitpoints m_obj)));;取得样条曲线的拟合点
(setq m_pts1 (vlax-variant-value (vla-get-controlpoints m_obj)));;取得样条曲线的控制点
(repeat (vla-get-numberoffitpoints m_obj);;循环
(vlax-safearray-put-element m_pts (+ i 2) 0.0);;改变每个拟合点的z值为0.0
(setq i (+ i 3))
)
(vla-put-fitpoints m_obj m_pts);;更改曲线拟合点属性
(setq i 0)
(repeat (vla-get-numberofcontrolpoints m_obj);;循环
(vlax-safearray-put-element m_pts1 (+ i 2) 0.0);;改变每个控制点的z值为0.0
(setq i (+ i 3))
)
(vla-put-controlpoints m_obj m_pts1);;更改曲线控制点属性
)
((= "AcDb3dPolyline" m_objname);;三维多段线(3dpolyline)
(setq i 0)
(setq m_pts (vlax-variant-value (vla-get-coordinates m_obj)));;取得3维多段线的控制点
(repeat (/ (length (vlax-safearray->list m_pts)) 3)
(vlax-safearray-put-element m_pts (+ i 2) 0.0)
(setq i (+ i 3))
)
(vla-put-coordinates m_obj m_pts)
)
((= "AcDbLine" m_objname);;直线(line)
(setq i 0)
(setq m_pts (vlax-variant-value (vla-get-startpoint m_obj)));;取得直线的起点座标
(setq m_pts1 (vlax-variant-value (vla-get-endpoint m_obj)));;取得直线的端点座标
(vlax-safearray-put-element m_pts 2 0.0);;改变起点座标z值为0.0
(vlax-safearray-put-element m_pts1 2 0.0)
(vla-put-startpoint m_obj m_pts)
(vla-put-endpoint m_obj m_pts1)
)
((or (= "AcDbCircle" m_objname);;园(circle)
(= "AcDbArc" m_objname);;圆弧(arc)
(= "AcDbEllipse" m_objname);;椭圆及椭圆弧(ellipse)
)
(setq m_pts (vlax-variant-value (vla-get-center m_obj)));;取得中心点座标
(vlax-safearray-put-element m_pts 2 0.0);;改变中心点座标z值为0.0
(vla-put-center m_obj m_pts)
)
((or (= "AcDbPolyline" m_objname);;多段线(polyline、lwpolyline)
(= "AcDb2dPolyline" m_objname);;拟合的2维多段线(polyline、lwpolyline)
)
(vla-put-elevation m_obj 0.0);;改变标高值为0.0
)
)
(setq m_obj m_obj)
)

;|;;=========================================================================== 
      通用函数                                                                ; 
功能：求两个线条对象的交点                                                    ; 
      适用对象: Line、Circle、Arc、Ellipse、Polyline、                        ; 
      LWPolyline、3dPolyline、Spline                                          ; 
参数：OBJ1   ----对象1                                                        ; 
      OBJ2   ----对象2                                                        ; 
      Extend ----延伸选项                                                     ; 
                 0  acExtendNone                                              ; 
                 1  acExtendThisEntity                                        ; 
                 2  acExtendOtherEntity                                       ; 
                 3  acExtendBoth                                              ; 
      ZZZ    ----输出选项                                                     ; 
                 "=0"  Z值取0                                                 ; 
                 "F1"  取第一个对象上的点                                     ; 
                 "F2"  取第二个对象上的点                                     ; 
                 "MAX" 取Z值大者                                              ; 
                 "MIN" 取Z值小者                                              ; 
      Fuzz   ----允许偏差值                                                   ; 
返回：若成功，返回点位表；否则返回nil 
日期：zml84 于2007-11-05 
;;|; 
(vl-load-com) 
(defun ZL-GETINTERS1 (OBJ1   OBJ2   EXTEND ZZZ  FUZZ /      ENT1 
       ENT2   PT10   PT11   PT20  PT21 OBJ11  OBJ22 
       ARRAY  LST    LST_PT I  PT PT1    PT2 
       Z1     Z2 
      ) 
    ;;0、对参数的格式化处理 
    (if (and (= (type EXTEND) 'INT) 
      (<= 0 EXTEND 3) 
 ) 
 () 
 (setq EXTEND 0) 
    ) 
    (setq ZZZ (strcase ZZZ)) 
    ;;====================== 
    ;;1、获取交点集合>>>>>>> 
    (if (and (= (vla-get-objectname OBJ1) "AcDbLine") 
      (= (vla-get-objectname OBJ2) "AcDbLine") 
 ) 
 ;;对直线对象(line) 特别处理 
 (progn 
     (setq ENT1 (entget (vlax-vla-object->ename OBJ1)) 
    ENT2 (entget (vlax-vla-object->ename OBJ2)) 
     ) 
     (setq PT10 (assoc 10 ENT1) 
    PT11 (assoc 11 ENT1) 
    PT20 (assoc 10 ENT2) 
    PT21 (assoc 11 ENT2) 
     ) 
     ;;去除Z坐标 
     (setq PT10 (list (cadr PT10) (caddr PT10)) 
    PT11 (list (cadr PT11) (caddr PT11)) 
    PT20 (list (cadr PT20) (caddr PT20)) 
    PT21 (list (cadr PT21) (caddr PT21)) 
     ) 
     (setq LST (inters PT10 PT11 PT20 PT21 t)) 
     (if LST 
  (setq LST (append LST '(0))) 
     ) 
 ) 
 (progn 
     ;;===================== 
     ;;复制实体 
     (setq OBJ11 (vla-copy OBJ1) 
    OBJ22 (vla-copy OBJ2) 
     ) 
     ;;向xy平面投影，将Z坐标改为0 
     (TOXY OBJ11) 
     (TOXY OBJ22) 
     ;;获取交点集合 
     (setq ARRAY (vla-intersectwith OBJ11 OBJ22 EXTEND)) 
     ;;删除复制后的对象 
     (vla-delete OBJ11) 
     (vla-delete OBJ22) 
     ;;由数组转换为表 
     (if (and ARRAY 
       (> (vlax-safearray-get-u-bound 
       (vlax-variant-value ARRAY) 
       1 
   ) 
   1 
       ) 
  ) 
  (progn 
      (setq LST (vlax-safearray->list 
      (vlax-variant-value ARRAY) 
         ) 
      ) 
  ) 
     ) 
 ) 
    ) 
    ;;====================== 
    ;;2、分析整理>>>>>>> 
    (setq LST_PT '()) 
    (if LST 
 (progn 
     (setq I 0) 
     (repeat (/ (length LST) 3) 
  ;;2.1 获取当前点位 
  (setq PT (list (nth I LST) 
          (nth (+ 1 I) LST) 
          (nth (+ 2 I) LST) 
    ) 
  ) 
  ;;2.2 获取对象上对应点位 
  (setq PT1 (vlax-curve-getclosestpointtoprojection 
         OBJ1 
         PT 
         '(0 0 1) 
     ) 
        PT2 (vlax-curve-getclosestpointtoprojection 
         OBJ2 
         PT 
         '(0 0 1) 
     ) 
  ) 
  (setq Z1 (caddr PT1) 
        Z2 (caddr PT2) 
  ) 
 
  ;;2.3 效验偏差值 
  ;;就是说：过滤:参数中有偏差值选项，却不满足要求的点位 
  (if (and FUZZ 
    (or (= (type FUZZ) 'REAL) 
        (= (type FUZZ) 'INT) 
    ) 
    (not (equal Z1 Z2 FUZZ)) 
      ) 
      ;; 空处理 
      () 
      ;;2.4 对输出选项的处理 
      (progn 
   (cond 
       ((= ZZZ "F1") 
        (setq PT PT1) 
       ) 
       ((= ZZZ "F2") 
        (setq PT PT2) 
       ) 
       ((= ZZZ "MAX") 
        (if (> Z1 Z2) 
     (setq PT PT1) 
     (setq PT PT2) 
        ) 
       ) 
       ((= ZZZ "MIN") 
        (if (< Z1 Z2) 
     (setq PT PT1) 
     (setq PT PT2) 
        ) 
       ) 
       (t 
        (setq PT PT) 
       ) 
   ) ;_结束cond 
   (if (member PT LST_PT) 
       () 
       (setq LST_PT (cons PT LST_PT)) 
   ) 
      ) ;_结束progn 
  ) ;_结束if 
  (setq I (+ I 3)) 
     ) ;_结束repeat 
 ) ;_结束progn 
    ) ;_结束if 
    ;;3、返回结果>>>>> 
    LST_PT 
) ;_结束defun 
;;;============================================================ 
;;;功能：曲线实体上每个控制点的z坐标值置为0.0                   
(defun TOXY (OBJ / NAME PT1 TP2) 
    ;;取得实体的类型名称 
    (setq NAME (vla-get-objectname OBJ)) 
    (cond 
 ;;类型1 
 ;;直线(line) 
 ((= NAME "AcDbLine") 
  ;;取得直线的起终点坐标 
  (setq PT1 (vlax-variant-value (vla-get-startpoint OBJ)) 
        PT2 (vlax-variant-value (vla-get-endpoint OBJ)) 
  ) 
  ;;改变z值为0.0 
  (vlax-safearray-put-element PT1 2 0.0) 
  (vlax-safearray-put-element PT2 2 0.0) 
  (vla-put-startpoint OBJ PT1) 
  (vla-put-endpoint OBJ PT2) 
 ) 
 ;;类型2 
 ;;圆(circle) 
 ;;圆弧(arc) 
 ;;椭圆及椭圆弧(ellipse) 
 ((or (= NAME "AcDbCircle") 
      (= NAME "AcDbArc") 
      (= NAME "AcDbEllipse") 
  ) 
  ;;取得中心点座标 
  (setq PT1 (vlax-variant-value (vla-get-center OBJ))) 
  ;;改变中心点座标z值为0.0 
  (vlax-safearray-put-element PT1 2 0.0) 
  (vla-put-center OBJ PT1) 
 ) 
 ;;类型3 
 ;;多段线(polyline、lwpolyline) 
 ;;拟合的2维多段线(polyline、lwpolyline) 
 ((or (= NAME "AcDbPolyline") 
      (= NAME "AcDb2dPolyline") 
  ) 
  ;;改变标高值为0.0 
  (vla-put-elevation OBJ 0.0) 
 ) 
 ;;类型4 
 ;;三维多段线(3dpolyline)   
 ((= NAME "AcDb3dPolyline") 
  ;;取得3维多段线的控制点 
  (setq PT1 (vlax-variant-value (vla-get-coordinates OBJ)) 
        I   0 
  ) 
  (repeat (/ (length (vlax-safearray->list PT1)) 3) 
      (vlax-safearray-put-element PT1 (+ I 2) 0.0) 
      (setq I (+ I 3)) 
  ) 
  (vla-put-coordinates OBJ PT1) 
 ) 
 ;;类型5 
 ;;样条曲线(Spline) 
 ((= NAME "AcDbSpline") 
  ;;取得样条曲线的拟合点 
  ;;改变每个拟合点的z值为0.0 
  (setq PT1 (vlax-variant-value (vla-get-fitpoints OBJ)) 
        I   0 
  ) 
  (repeat (vla-get-numberoffitpoints OBJ) 
      (vlax-safearray-put-element PT1 (+ I 2) 0.0) 
      (setq I (+ I 3)) 
  ) 
  (vla-put-fitpoints OBJ PT1) 
  ;;取得样条曲线的控制点 
  ;;改变每个控制点的z值为0.0   
  (setq 
      PT2 (vlax-variant-value (vla-get-controlpoints OBJ)) 
      I  0 
  ) 
  (repeat (vla-get-numberofcontrolpoints OBJ) 
      (vlax-safearray-put-element PT2 (+ I 2) 0.0) 
      (setq I (+ I 3)) 
  ) 
  (vla-put-controlpoints OBJ PT2) 
 ) 
 (t NIL) 
    ) 
) ;_结束defun 
;(setq ppzzxx (ZL-GETINTERS (vlax-ename->vla-object(car (entsel) ) ) (vlax-ename->vla-object(car (entsel) ) ) 0 "f2" nil)   ) 
 
 
 
 
(DEFUN C:TT() 
(vl-load-com) 
(setq m_ent1 (car (entsel "\n请选择剖切线: "))) 
  (setq m_ent2 (car (entsel "\n请选择一条等高线: "))) 
(setq data(entget    m_ent2 )) 
(setq layer(assoc 8 data)) 
  (setq 层名(CDR layer)) 
 
  (SETQ SS (SSGET "X" ( list (cons 8  层名)  (cons 0  "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE")))) 
(SSSETFIRST SS) 
(setq ii 0) 
(repeat (sslength ss);循环选择集长度 
   (setq 单个图元   (ssname ss ii)) 
   
(setq ZL-GETINTERS  (ZL-GETINTERS1 (vlax-ename->vla-object m_ent1) (vlax-ename->vla-object 单个图元) 0 "f2" nil)) 
;(setq 高程 (CADDR (vlax-curve-getStartPoint 单个图元)) 
;;;      ps2(vlax-curve-getEndPoint m_ent2) 
      ;) 
   (foreach n ZL-GETINTERS 
;;;     (print n) 
(setq xzb (car n)) 
(setq yzb (cadr n)) 
(setq 高程 (CADDR n)) 
 
  (entmake (list (cons 0  "TEXT") (cons 1 (vl-princ-to-string 高程)) (cons 10 (list  XZB YZB 高程)) 
               (cons 40 0.5) 
               (cons 8 "0000用于图元属性快速输出利用（简称“属性”图层）") 
               )) 
                   ; 在下面画圆，这样就可以直接用“”读出里程及偏移，而孔号就是该点高程 
                   (entmake (list '(0 . "POINT") (cons 10 (list  XZB YZB 高程)) (cons 8 "0000用于图元属性快速输出利用（简称“属性”图层）"))) 
;(command "break" 单个图元  (list  XZB YZB 高程) "@") 
     ;(command "break" 单个图元 "f" (list  XZB YZB 高程) (list  XZB YZB 高程)) 
                    ; (command "LINE"  (LIST XZB YZB) '(0 0)) 
 
                   
 
    ) 
 
    
  (setq ii (1+ ii)) 
) 
 
   
   
;;;  (sssetfirst nil ss) 
  ) 
 
 
(defun m_IntersectWith(m_ent1 单个图元 / m_obj1 m_obj2 m_objcopy1 m_objcopy2 m_jdtab m_jdtab1 i) 
; 来源：3楼 [求助]任意两条线的交点坐标-AutoLISP/Visual LISP 编程技术-CAD论坛-明经CAD社区 - Powered by Discuz! 
; http://bbs.mjtd.com/forum.php?mod=viewthread&tid=79868 
;;适用对象: Line、Polyline、LWPolyline、Circle、Arc、Ellipse、3dPolyline、Spline 
  ;;支持求空间虚交点，但Z坐标始终为0.0，要求Z坐标，请用(vlax-curve-getClosestPointToProjection)函数 
  (setq m_obj1 (vlax-ename->vla-object m_ent1)) 
  (setq m_obj2 (vlax-ename->vla-object 单个图元)) 
   
  (setq m_objcopy1 (vla-copy m_obj1));;复制第一条曲线实体 
  (setq m_objcopy2 (vla-copy m_obj2));;复制第二条曲线实体 
   
  (setq m_objcopy1 (m_ShadowToXY m_objcopy1));;得到投影实体 
  (setq m_objcopy2 (m_ShadowToXY m_objcopy2));;得到投影实体 
   
  (setq m_jdtab1 (vla-intersectwith m_objcopy1 m_objcopy2 acExtendnone));;得到交点集 
   
  (if (> (vlax-safearray-get-u-bound (vlax-variant-value m_jdtab1) 1) 1);;判断有无交点 
      (progn 
(setq m_jdtab1 (vlax-safearray->list (vlax-variant-value m_jdtab1)));;safearray数组转换为list表 
(setq i 0) 
(repeat (/ (length m_jdtab1) 3) 
   (setq m_jd (list (nth i m_jdtab1) (nth (+ 1 i) m_jdtab1) (nth (+ 2 i) m_jdtab1)));;取得一个交点 
   (setq m_jdtab (cons m_jd m_jdtab));;构造交点表（(第一个交点) (第二个交点)。。。） 
   (setq i (+ 3 i)) 
) 
      ) 
      (princ"\n两曲线无交点!") 
  ) 
   
  (vla-delete m_objcopy1);;删除复制的第一条曲线实体 
  (vla-delete m_objcopy2);;删除复制的第二条曲线实体 
   
  (setq m_jdtab m_jdtab);;返回交点表，无交点返回nil 
) 
(defun m_ShadowToXY(m_obj / m_objname m_pts m_pts1 i) 
  ;;对曲线实体m_obj创建一个投影至xy平面的曲线实体，即对曲线实体上每个控制点的z坐标值置为0.0 
  ;;输入曲线实体(vla对象) 
  ;;返回投影实体(vla对象) 
  (setq m_objname (vla-get-objectname m_obj));;取得实体的类型名称 
;;;  (m_princ "\nObjectName：" m_objname) 
  (cond 
    ((= "AcDbSpline" m_objname);;样条曲线(Spline) 
     (setq i 0) 
     (setq m_pts (vlax-variant-value (vla-get-fitpoints m_obj)));;取得样条曲线的拟合点 
     (setq m_pts1 (vlax-variant-value (vla-get-controlpoints m_obj)));;取得样条曲线的控制点 
     (repeat (vla-get-numberoffitpoints m_obj);;循环 
       (vlax-safearray-put-element m_pts (+ i 2) 0.0);;改变每个拟合点的z值为0.0 
       (setq i (+ i 3)) 
     ) 
     (vla-put-fitpoints m_obj m_pts);;更改曲线拟合点属性 
     (setq i 0) 
      
     (repeat (vla-get-numberofcontrolpoints m_obj);;循环 
       (vlax-safearray-put-element m_pts1 (+ i 2) 0.0);;改变每个控制点的z值为0.0 
       (setq i (+ i 3)) 
     ) 
     (vla-put-controlpoints m_obj m_pts1);;更改曲线控制点属性 
    ) 
    
    ((= "AcDb3dPolyline" m_objname);;三维多段线(3dpolyline) 
     (setq i 0) 
     (setq m_pts (vlax-variant-value (vla-get-coordinates m_obj)));;取得3维多段线的控制点 
     (repeat (/ (length (vlax-safearray->list m_pts)) 3) 
       (vlax-safearray-put-element m_pts (+ i 2) 0.0) 
       (setq i (+ i 3)) 
     ) 
     (vla-put-coordinates m_obj m_pts) 
    ) 
    
    ((= "AcDbLine" m_objname);;直线(line) 
     (setq i 0) 
     (setq m_pts (vlax-variant-value (vla-get-startpoint m_obj)));;取得直线的起点座标 
     (setq m_pts1 (vlax-variant-value (vla-get-endpoint m_obj)));;取得直线的端点座标 
     (vlax-safearray-put-element m_pts 2 0.0);;改变起点座标z值为0.0 
     (vlax-safearray-put-element m_pts1 2 0.0) 
     (vla-put-startpoint m_obj m_pts) 
     (vla-put-endpoint m_obj m_pts1) 
    ) 
    ((or (= "AcDbCircle" m_objname);;园(circle) 
  (= "AcDbArc" m_objname);;圆弧(arc) 
  (= "AcDbEllipse" m_objname);;椭圆及椭圆弧(ellipse) 
     ) 
     (setq m_pts (vlax-variant-value (vla-get-center m_obj)));;取得中心点座标 
     (vlax-safearray-put-element m_pts 2 0.0);;改变中心点座标z值为0.0 
     (vla-put-center m_obj m_pts) 
    ) 
    
    ((or (= "AcDbPolyline" m_objname);;多段线(polyline、lwpolyline) 
  (= "AcDb2dPolyline" m_objname);;拟合的2维多段线(polyline、lwpolyline) 
     ) 
     (vla-put-elevation m_obj 0.0);;改变标高值为0.0 
    ) 
  ) 
  (setq m_obj m_obj) 
)

压缩文件那个EXE能处理纵断面圆弧和直线但要分开输入

czb203 · 发表于 2015-7-31 22:17

支持测绘界人才·～～

haige405 · 发表于 2015-7-31 23:23

依据等高线，交点，
或者依据（平面图中的高程点→三角网)，交点，
或者是，等高线+三角网

这里面会有矛盾的地方，（同一个点，针对等高线和三角网的数据应该不一样，有时候或者偏差很大。）
这种情况怎么解决呢？

77077 · 发表于 2015-8-2 12:13

给你个思路，选择等高线ss，选择剖面线ent，求出ss与ent的交点集pts，将pts按照ent方向排序，随后输出~~~

skg123 · 发表于 2015-8-8 20:23

我根据 ZmL84的思路做了一个用于公路上剖断面的，http://bbs.mjtd.com/thread-110548-1-1.html

gzbccy · 发表于 2015-8-9 11:59

，测绘届的人才啊

无厘崖 · 发表于 2016-2-18 16:30

感谢楼主，看下好用不！！

知行ooo李肖坪 · 发表于 2016-2-19 08:46

谢谢分享………………

mycad · 发表于 2016-2-20 19:54

ding!!!!!!!!!!!!!!!!!!1

技术工作室 · 发表于 2022-9-28 13:19

支持一下顶一个

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

根据三角网等高线切横断面

本帖子中包含更多资源

相关帖子

根据三角网 等高线切横断面

本帖子中包含更多资源

相关帖子

根据三角网等高线切横断面