我参考的是这篇老外的帖子，原文不再翻译，有兴趣的可以百度自己查看
论坛帖子地址：https://www.theswamp.org/index.php?PHPSESSID=hgb2jmd2g21qrkmgqe2f0r0f95&topic=9042.0
源码下载地址：http://pdcode.com/code.htm
Q1：根据图面三角网内插方格网节点高程(LISP)
;;框选范围内交点插入图块 By Gu_xl 2011.04
;;双线性内插计算内插高程值
(defun zInsert (ptl / L pt0 pt0x pt0y pt1 pt2 pta ptb ptc ptz r xa xb xc ya yb yc za zb zc zl zr)
(setq pt0 (car ptl)
pt0X (car pt0)
pt0Y (cadr pt0)
pt1 (polar (list pt0X pt0Y) 0 1000)
pt2 (polar (list pt0X pt0Y) pi 1000)
ptA (car (cadr ptl))
Xa (car ptA)
Ya (cadr ptA)
Za (caddr ptA)
ptB (cadr (cadr ptl))
Xb (car ptB)
Yb (cadr ptB)
Zb (caddr ptB)
ptC (caddr (cadr ptl))
Xc (car ptC)
Yc (cadr ptC)
Zc (caddr ptC)
)
;求交点
(setq L (inters pt1 pt2 (list Xa Ya) (list Xb Yb)))
(cond
((/= L nil)
(setq zL (+ Za (/ (* (- Zb Za) (- (car L) Xa)) (- Xb Xa))))
)
((= L nil)
(progn
(setq L (inters pt1 pt2 (list Xb Yb) (list Xc Yc)))
(setq zL (+ Zb (/ (* (- Zc Zb) (- (car L) Xb)) (- Xc Xb))))
)
)
)
(setq R (inters pt1 pt2 (list Xa Ya) (list Xc Yc)))
(cond
((/= R nil)
(setq zr (+ Za (/ (* (- Zc Za) (- (car R) Xa)) (- Xc Xa))))
)
((= R nil)
(progn
(setq R (inters pt1 pt2 (list Xb Yb) (list Xc Yc)))
(setq zr (+ Zb (/ (* (- Zc Zb) (- (car R) Xb)) (- Xc Xb))))
)
)
)
(setq ptZ (+ zL (/ (* (- zr zL) (- pt0X (car L))) (- (car R) (car L)))))
(list pt0X pt0Y ptZ)
)
;;;by Gu_xl
(defun gxl-cs:gcd (inspt height scale / pt pt1 blkdef obj)
(setvar “CMDECHO” 0)
(command “layer” “m” “检查高程点” “c” “1” “” “L” “CONTINUOUS” “” “”)
(if height
(setq height (rtos height 2 3))
(setq height “”)
)
(regapp “SOUTH”)
;;;检查字体 “HZ” 是否存在
(if (not (tblobjname “style” “HZ”))
(command “style” “HZ” “rs.shx,hztxt.shx” 0 1 0 “” “” “”)
)
;;;检查是否存在高程点图块定义
(if (not (tblobjname “block” “GC200”))
(progn
(setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point ‘(0 0 0)) “GC200”))
(setq obj
(vla-AddPolyline
blkdef
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 5))
‘(-0.2 0 0 0.2 0 0)
)
)
)
)
(vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
(vla-put-Closed obj :vlax-true)
(vla-put-ConstantWidth obj 0.4)
)
)
;;;插入块
(entmake (list
‘(0 . “INSERT”)
‘(100 . “AcDbEntity”)
‘(100 . “AcDbBlockReference”)
‘(66 . 1);;;属性跟随标志,1跟随，0不跟随
(cons 2 “GC200”)
(cons 10 inspt)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
‘(-3 (“SOUTH” (1000 . “202101”)))
)
)
;;;插入属性
(entmake (list
‘(0 . “ATTRIB”)
‘(100 . “AcDbEntity”)
‘(100 . “AcDbText”)
(cons 10 (setq pt (polar inspt (* -0.5 PI) (* 1.8 scale))))
(cons 40 (* 2.0 scale))
(cons 50 0)
(cons 62 3)
(cons 41 0.8)
(cons 51 0)
(cons 1 height)
(cons 7 “宋体”)
(cons 72 0)
(cons 11 pt)
‘(100 . “AcDbAttribute”)
(cons 2 “height”)
(cons 70 0)
(cons 74 2)
)
)
;;;;;;;;;;;;;;;;;;;;;;;
;;;插入属性
;;;结束标志
(entmake ‘((0 . “SEQEND”)))
(princ)
)
(defun addgcptinpm (pt lst / an anl i L n p1 p2 plst ret vlst)
(setq n 0 L (length lst))
(while (< n L)
(setq vlst (car lst))
(setq i -1
p1 (last vlst)
)
(while (and (not ret) (setq p2 (nth (setq i (1+ i)) vlst)))
(cond
((equal p2 pt 1e-4) (setq ret t))
(t
(setq an (- (angle pt p1) (angle pt p2)))
(if (equal pi (abs an) 1e-4)
(setq ret t)
(setq anl (cons (rem an pi) anl))
)
)
)
(setq p1 p2)
)
(cond
(ret (setq plst (list pt vlst))) ;线上;
(t
(if (equal pi (abs (apply ‘+ anl)) 1e-4)
(setq plst (list pt vlst)) ;三角网内
nil ;外
)
)
)
(setq n (1+ n))
(setq lst (cdr lst))
(if plst (setq n L))
)
plst
)
;[功能] pline,lwpline点坐标表 By 无痕;;示例(vxs (car (entsel))),返回三维点坐标
(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 Curveinters (en1 en2 / pl pts)
(setq pl (vlax-invoke (vlax-ename->vla-object en2) ‘IntersectWith (vlax-ename->vla-object en1) acExtendNone))
(while pl
(setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
pl (cdr (cdr (cdr pl)))
)
)
pts
)
;;;曲线选择集交点
(defun ssinters (ss / pts en1 en2)
(while (> (sslength ss) 1)
(setq en1 (ssname ss 0))
(ssdel en1 ss)
(setq n (sslength ss))
(repeat n
(setq en2 (ssname ss (setq n (1- n))))
(setq pts (append pts (Curveinters en1 en2)))
)
)
pts
)
;;;实例: 按选择范围框内插入图块
(defun c:fgwgc(/ p1 p2 d minX minY maxX maxY pt pts p1 p2 ss os cmdecho blockname fff ssa cm en ii no wjm pzx ssa1 en1 ii1 no1 pzx1 ptb ptb1 sjwlst blc scale)
(prompt “\n 请选择设计三角网：”)
(setq ssa (ssget ‘((0 . “POLYLINE”) (8 . “sjw”))))
(setq ii 0
no 0
)
(repeat (sslength ssa)
(setq en (ssname ssa ii)
ptb (vxs en)
pzx (append pzx (list ptb))
ii (1+ ii) )
; (setq pzx (list (car pt) (cadr pt) (caddr pt)))
)
(setq sjwlst pzx)
(setq blc (getint “\n请输入比例尺1:”))
(setvar ‘userr1 blc);设置比例尺
;(setq zg (* 0.002 blc));字高
(setq scale (* 0.001 blc));缩放比例
(setq os (getvar “osmode”))
(setq cmdecho (getvar “cmdecho”))
(setvar “osmode” 0)
(setvar “cmdecho” 0)
;(setq blockname (getstring “\n插入块名称:”))
(if (null d) (setq d 1.))
(while (and
(setq p1 (getpoint “\n选择插入范围左下角：”))
(setq p2 (GETCORNER p1 “\n选择插入范围左下角：”))
)
(setq minX (apply ‘min (mapcar ‘car (list p1 p2)))
minY (apply ‘min (mapcar ‘cadr (list p1 p2)))
maxX (apply ‘max (mapcar ‘car (list p1 p2)))
maxY (apply ‘max (mapcar ‘cadr (list p1 p2)))
)
(grvecs (list 1 (list minx miny) (list maxx miny)
1 (list maxx miny) (list maxx maxy)
1 (list maxx maxy) (list minx maxy)
1 (list minx maxy) (list minx miny)
)
)
(setq ss (ssget “c” p1 p2 ‘((0 . “lwpolyline”))))
(if ss
(progn
(setq pts (ssinters ss))
(if pts
(foreach pt pts
(if (and (>= maxX (car pt) minX)
(>= maxY (cadr pt) minY)
(setq ptlst (addgcptinpm pt sjwlst))
)
;;插入图块
;(command “insert” blockname “_non” pt 1 1 0)
(progn
;;双线性内插计算内插点的高程值 返回内插点(x y z)
(setq zpt (zInsert ptlst))
(print zpt)
;(Entmakegcd 插入点 高程 图块比例 属性 文字字符 文字插入点 小数位数)
;(Entmakegcd zpt (caddr zpt) Scale inserD Tag txt ist1 txth ist2 xsws)
(gxl-cs:gcd zpt (caddr zpt) scale );展高程点
)
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
)
)
)
)
(princ “\n 回车键结束“)
)
(setvar “osmode” os)
(setvar “cmdecho” cmdecho)
(princ)
)
Q2：思路
1、通过ssget函数，得到ABCDEFG点选择集m，
2、由ssname函数得到选择集m中第一点A(假设第一点是A)，再从m选择集中找A点的最近点,得到B点(假如A点的最近点为B点），此时形成一条AB边。
3、将AB边左右两侧所有离散点CDEFG，分别与AB边连接形成三角形，判断形成的夹角哪个最大？得到最大夹角的那个三角形BCA(图中所示C点与AB边连接形成夹角最大，第一个三角形成，标示为1边），同时得到新边BC、CA,即1边
4、按逆时针方向，BC方向右侧离散点分别与BC边连接形成三角形，判断形成的夹角哪个最大？得到最大夹角三角形BFC（第二个三角形形成）,同时得到新边BF、FC，即2边。
5、CA方向右侧离散点分别与CA边连接形成三角形，判断形成的夹角哪个最大？得到最大夹角三角CDA（第三个三角形形成）,同时得到新边CD、DA，即2边。
6、此时图中所示的1边均以生成三角形，并得到多个新边2边，此时将1边排除，将2边做为1边，按以上45步骤操作，形成循环……，直到所有边都结束终止循环，形成三角网。
