求剖切线与等高线的交点写高程

清风明月名字

各位高手，我请求帮我写一个代码，就是一条曲线A为剖切线，再B图层中的所有线均有高程线（线群为C），我要求剖切线A与C群中每一条等高线E的交点D，并在D点插入一个TEXT，这个单行文字的内容为E的Z值，TEXT的Z值与E的Z值相等。
剖切线及等高线均应为普通任意线型，直线 、多义线样条曲线等。剖切线可不为三维多义线 ，等高线可为三维多义线。
我要求得到源码，方便作灵活改造。
拜求各位帮忙
管理员别生气，我前面将这个帖子发到提问里面了，后面想提问里面没有悬赏，恐大家没有积极性，所以又发到这里。前面那个帖子我不知道如何能转到这里，所以重发。

清风明月名字

群主，我自己做 出来的软件，能够收回那些悬赏吗？或者我自己发表出来定为最佳答案?

清风明月名字

CJ001027在剖切线与等高线群的外观交点上写内容为高程的TEXT.LSP
我自己编好了，当然代码也是又是写又是抄的
CJ001027在剖切线与等高线群的外观交点上写内容为高程的TEXT.LSP
(DEFUN C:UU()
(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(m_IntersectWith m_ent1 单个图元))
(setq 高程 (CADDR (vlax-curve-getStartPoint 单个图元))
;;;  瀀猀2(vlax-curve-getEndPoint m_ent2)
  )
(foreach n ZL-GETINTERS
;;; (print n)
(setq xzb (car n))
(setq yzb (cadr n))

(entmake (list (cons 0"TEXT") (cons 1 (vl-princ-to-string 高程)) (cons 10 (list堀娀B YZB 高程))
     (cons 40 2.5)
     (cons 8 "0000用于图元属性快速输出利用（简称“属性”图层）")
     ))

  )


(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)
)

hyong10000

看看,一定不错

VBALISPER

很厉害.学习一下.

yxh1202

清风明月名字 发表于 2013-7-7 19:58
CJ001027在剖切线与等高线群的外观交点上写内容为高程的TEXT.LSP
我自己编好了，当然代码也是又是写又是抄 ...

能不选等高线，直接选剖切线来完成吗