(defun c:tt ( / dataop dcl_file dcl_id dgxop dialog_return gc2op gcjl gcjlop gconeop key keys writerimage)
(vl-load-com)
(setq writerImage '((8 31 5 31 7) (5 31 5 32 7) (5 32 6 32 7) (6 32 7 32 7) (7 32 8 32 7) (8 32 8 31 7) (6 30 7 30 7) (7 30 6 30 7) (4 29 5 30 7) (5 30 5 39 7) (5 39 6 40 7) (6 40 7 40 7) (7 40 8 40 7) (8 40 9 40 7) (9 40 9 39 7) (9 39 10 39 7) (10 39 7 39 7) (7 39 6 38 7) (6 38 5 38 7) (5 38 5 31 7) (5 31 8 31 7) (8 31 7 31 7) (7 31 6 31 7) (6 31 6 30 7) (6 30 4 29 7) (7 21 7 22 7) (7 22 8 22 7) (8 22 7 21 7) (8 18 7 18 7) (7 18 8 19 7) (8 19 8 20 7) (8 20 8 21 7) (8 21 7 21 7) (7 21 8 22 7) (8 22 8 28 7) (8 28 8 29 7) (8 29 7 29 7) (7 29 4 29 7) (4 29 5 30 7) (5 30 6 30 7) (6 30 7 30 7) (7 30 7 31 7) (7 31 8 31 7) (8 31 8 30 7) (8 30 9 29 7) (9 29 9 27 7) (9 27 9 20 7) (9 20 9 19 7) (9 19 8 18 7) (7 17 7 18 7) (7 18 6 18 7) (6 18 6 20 7) (6 20 7 21 7) (7 21 7 20 7) (7 20 7 19 7) (7 19 8 18 7) (8 18 8 17 7) (8 17 7 17 7) (10 10 7 10 7) (7 10 8 10 7) (8 10 9 10 7) (9 10 9 11 7) (9 11 10 11 7) (10 11 11 12 7) (11 12 11 13 7) (11 13 11 14 7) (11 14 12 15 7) (12 15 12 17 7) (12 17 12 18 7) (12 18 12 19 7) (12 19 12 21 7) (12 21 12 27 7) (12 27 12 28 7) (12 28 12 30 7) (12 30 12 31 7) (12 31 12 32 7) (12 32 11 33 7) (11 33 11 34 7) (11 34 11 35 7) (11 35 11 36 7) (11 36 10 36 7) (10 36 10 37 7) (10 37 9 38 7) (9 38 8 39 7) (8 39 7 39 7) (7 39 10 39 7) (10 39 10 38 7) (10 38 11 37 7) (11 37 12 36 7) (12 36 12 35 7) (12 35 12 34 7) (12 34 13 31 7) (13 31 13 30 7) (13 30 13 29 7) (13 29 13 27 7) (13 27 13 21 7) (13 21 13 20 7) (13 20 13 19 7) (13 19 13 17 7) (13 17 13 16 7) (13 16 12 14 7) (12 14 12 13 7) (12 13 11 11 7) (11 11 11 10 7) (11 10 10 10 7) (7 9 6 9 7) (6 9 5 10 7) (5 10 4 11 7) (4 11 3 12 7) (3 12 3 13 7) (3 13 3 14 7) (3 14 2 15 7) (2 15 2 16 7) (2 16 2 17 7) (2 17 2 19 7) (2 19 2 20 7) (2 20 2 22 7) (2 22 2 23 7) (2 23 2 24 7) (2 24 3 25 7) (3 25 3 26 7) (3 26 3 27 7) (3 27 3 28 7) (3 28 4 29 7) (4 29 7 29 7) (7 29 6 29 7) (6 29 5 29 7) (5 29 5 28 7) (5 28 4 27 7) (4 27 4 26 7) (4 26 3 24 7) (3 24 3 23 7) (3 23 3 21 7) (3 21 3 20 7) (3 20 3 19 7) (3 19 3 17 7) (3 17 3 16 7) (3 16 3 15 7) (3 15 4 14 7) (4 14 4 13 7) (4 13 5 12 7) (5 12 5 11 7) (5 11 6 11 7) (6 11 7 10 7) (7 10 10 10 7) (10 10 10 9 7) (10 9 9 9 7) (9 9 8 9 7) (8 9 7 9 7) (24 9 13 9 7) (13 9 13 20 7) (13 20 16 20 7) (16 20 13 31 7) (13 31 14 30 7) (14 30 17 18 7) (17 18 14 18 7) (14 18 14 11 7) (14 11 23 11 7) (23 11 24 9 7) (24 9 23 11 7) (23 11 20 22 7) (20 22 23 22 7) (23 22 23 30 7) (23 30 14 30 7) (14 30 13 31 7) (13 31 24 31 7) (24 31 24 21 7) (24 21 21 21 7) (21 21 24 9 7) (29 22 28 24 7) (28 24 28 30 7) (28 30 25 30 7) (25 30 29 31 7) (29 31 29 24 7) (29 24 29 22 7) (29 22 29 24 7) (29 24 29 31 7) (29 31 30 30 7) (30 30 30 24 7) (30 24 30 22 7) (30 22 29 22 7) (29 9 29 15 7) (29 15 29 16 7) (29 16 30 17 7) (30 17 30 15 7) (30 15 30 11 7) (30 11 33 11 7) (33 11 29 9 7) (29 9 28 11 7) (28 11 28 15 7) (28 15 29 17 7) (29 17 30 17 7) (30 17 29 16 7) (29 16 29 15 7) (29 15 29 9 7) (34 9 29 9 7) (29 9 33 11 7) (33 11 33 15 7) (33 15 33 17 7) (33 17 33 18 7) (33 18 33 19 7) (33 19 32 20 7) (32 20 33 20 7) (33 20 33 21 7) (33 21 33 22 7) (33 22 33 23 7) (33 23 33 24 7) (33 24 33 30 7) (33 30 30 30 7) (30 30 29 31 7) (29 31 34 31 7) (34 31 34 24 7) (34 24 34 23 7) (34 23 34 22 7) (34 22 34 21 7) (34 21 34 19 7) (34 19 34 18 7) (34 18 34 16 7) (34 16 34 15 7) (34 15 34 9 7) (29 9 24 9 7) (24 9 24 14 7) (24 14 24 15 7) (24 15 24 16 7) (24 16 24 18 7) (24 18 25 19 7) (25 19 25 20 7) (25 20 25 21 7) (25 21 24 22 7) (24 22 24 23 7) (24 23 24 25 7) (24 25 24 31 7) (24 31 29 31 7) (29 31 25 30 7) (25 30 25 25 7) (25 25 25 24 7) (25 24 25 23 7) (25 23 25 22 7) (25 22 26 21 7) (26 21 26 20 7) (26 20 26 19 7) (26 19 26 18 7) (26 18 25 18 7) (25 18 25 17 7) (25 17 25 16 7) (25 16 25 14 7) (25 14 25 11 7) (25 11 28 11 7) (28 11 29 9 7) (40 2 35 2 7) (35 2 35 31 7) (35 31 36 30 7) (36 30 36 3 7) (36 3 39 3 7) (39 3 40 2 7) (40 2 39 3 7) (39 3 39 30 7) (39 30 36 30 7) (36 30 35 31 7) (35 31 40 31 7) (40 31 40 2 7)))
(setq dcl_id (load_dialog (setq Dcl_File (Write_Dcl_addgc))))
(vl-file-delete Dcl_File)
(setq Dialog_Return 2)
(while (> Dialog_Return 1)
(new_dialog "addgc" dcl_id)
(setq keys '("dataOp" "gc2Op" "dgxOp" "gconeOp" "gcjlOp" "gcjl" "accept" "cancel" "writerImage"))
(start_image "writerImage")
(fill_image 0 0 (dimx_tile "writerImage") (dimy_tile "writerImage") 1)
(mapcar 'eval (mapcar 'cons (mapcar '(lambda (x) 'vector_image) writerImage) writerImage))
(end_image)
(foreach key keys (action_tile key "(Action_addgc_Keys $key $value)"))
(mode_tile "gcjl" 1)
(setq Dialog_Return (start_dialog))
(cond
((= Dialog_Return 3)
(sratAddgc dataOp gc2Op dgxOp gconeOp gcjlOp gcjl)
(unload_dialog dcl_id)
)
)
)
(unload_dialog dcl_id)
(princ)
)
;;;参数 dataOp数据文件 gc2Op两端点高程 dgxOp两条等高线 gconeOp单个高程点 gcjlOp以距离间隔 gcjl距离
(defun sratAddgc (dataOp gc2Op dgxOp gconeOp gcjlOp gcjl / acaddocument acadobject ang coord dgxobj dis ent i infolst inserd ist1 ist2 k l mspace n name num pl pt pt1 pt1x pt1y pt1z pt2 ptlst s scale sjwlst ss tag txt txth use x xsws y z zpt)
;;;获取高程点的信息
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument AcadObject)
mSpace (vla-get-ModelSpace AcadDocument)
)
(cond
((= dataOp "1") ;数据文件生成高程点
(progn
(if (setq i 0 s (ssget '((8 . "GCD") (0 . "INSERT") (2 . "GC200"))))
(progn
(repeat (sslength s)
(setq pl (cons (cdr (assoc 10 (entget (ssname s i)))) pl)
i (1+ i)
)
)
;;;高程点信息(list Scale inserD Tag txt ist1 txth ist2 xsws)
(setq infolst (getgcinfo (ssname s 0)))
(setq Scale (car infolst)
inserD (cadr infolst)
Tag (caddr infolst)
txt (cadddr infolst)
ist1 (cadddr (reverse infolst))
txth (caddr (reverse infolst))
ist2 (cadr (reverse infolst))
xsws (car (reverse infolst))
)
;;;建立三角网
(setq sjwlst (addgcsjw pl))
(cond
((= gconeOp "1") ;单个高程点
(progn
(while (setq pt (getpoint "\n内插高程点"))
(setq pt (list (car pt) (cadr pt)))
;;角度法判断点在那个三角形 返回((ptx pty ptz) ((p1x p1y p1z) (p2x p2y p2z) (p3x p3y p3z)))
(setq ptlst (addgcptinpm pt sjwlst))
(if ptlst ;如果点在三角形线上或三角形内
(progn
;;双线性内插计算内插点的高程值 返回内插点(x y z)
(setq zpt (zInsert ptlst))
;(Entmakegcd 插入点 高程 图块比例 属性 文字字符 文字插入点 小数位数)
(Entmakegcd zpt (caddr zpt) Scale inserD Tag txt ist1 txth ist2 xsws)
)
)
)
)
)
((= gcjlOp "1") ;以距离间隔
(progn
(while
(and (setq pt1 (getpoint "\n选择第一点"))
(setq pt2 (getpoint "\n选择第二点"))
)
(setq dis (distance pt1 pt2)
ang (angle pt1 pt2)
num (atoi (rtos (/ dis gcjl) 2 0)) ;循环次数
n 0
)
(repeat num
(setq pt (polar pt1 ang (* n gcjl)))
(setq pt (list (car pt) (cadr pt)))
(setq ptlst (addgcptinpm pt sjwlst))
(if ptlst
(progn