; 由三角网计算土方平衡[mini_tfph].lsp

(or mai_cehui_gcd_blk
   (mai_load_files (mai_panel_search "谜你测绘功能设置文件.lsp"))
)

(defun c:mini_tfph ( / old_cmd cfgname mai_sym_list stop mm nn ss old_pwidth
						gcd_units gcd_blk_lay gcd_blk gcd_tin gcd_tin_style gcd_dgx gcd_dgx_hight gcd_dgx_style gcd_tfph
						cale_balance tri_ncgc tri_adj tri_dgx tri_area
					)

(defun cale_balance ( ss / get_v_by_high t0 pts high_t high_b ht hh ee vv mm areas )

(defun get_v_by_high ( face / p1 p2 p3 h1 h2 h3 b1 b2 b3 s v tt vv sin1 sin3 v2 )
	(mapcar (function set) '(p1 p2 p3 h1 h2 h3 b1 b2 b3 s v v2 sin1 sin3) face)
	(cond
		(	(<= ht h1) (list (+ (* s (- h1 ht)) v)))
		(	(<= ht h2)
			(setq
				tt (- ht h1)
				vv (/ (* 0.5 sin1 b1 (/ tt (- h2 h1)) b3 (/ tt (- h3 h1)) tt ) 3.)
			)
			(list (+ (- v (* s tt)) vv) (- vv))
		)
		(	(<= ht h3)
			(setq
				tt (- h3 ht)
				vv (/ (* 0.5 sin3 b2 (/ tt (- h3 h2)) b3 (/ tt (- h3 h1)) tt) 3.)
			)
			(list vv (- (+ (- v2 (* s tt)) vv)))
		)
		(	(list (- v (* s (- ht h1)))))
	)
)

	(princ "\n三角网数据处理中......")
	(setq
		ss (mapcar
				(function
					(lambda ( x /  p1 p2 p3 h1 h2 h3 s v h b1 b2 b3 v2 sin1 sin3 )
						(setq
							x (entget x)
							x (mai_remove_same (list (mai_dxf 10 x)(mai_dxf 11 x)(mai_dxf 12 x)(mai_dxf 13 x)))
							x (vl-sort x (function (lambda(m n)(<= (caddr m)(caddr n)))))
						)
						(mapcar 'set '(p1 p2 p3) x)
						(setq
							h1 (caddr p1)
							h2 (caddr p2)
							h3 (caddr p3)
							p1 (mai_3p_2p p1)
							p2 (mai_3p_2p p2)
							p3 (mai_3p_2p p3)
							h (mai_dist_to_line p3 p1 p2)
							b1 (distance p1 p2)
							b2 (distance p3 p2)
							b3 (distance p3 p1)
							s (* h 0.5 b1)
							v2 (* s (- h3 h1))
							v (/ (+ v2 (* 0.5 b1 (- h2 h1) h)) 3.)
							v2 (- v2 v)
							sin1 (/ s 0.5 b1 b3)
							sin3 (/ s 0.5 b2 b3)
						)
						(list p1 p2 p3 h1 h2 h3 b1 b2 b3 s v v2 sin1 sin3)
					)
				)
				ss
			)
		high_t (apply (function max) (mapcar (function (lambda(x)(nth 5 x))) ss))
		high_b (apply (function min) (mapcar (function cadddr) ss))
		areas (apply (function +) (mapcar (function (lambda(x)(nth 9 x))) ss))
		hh (list high_b high_t)
		ee 100
	)
	(while (and (>= (abs ee) 0.1) (> (abs (apply (function -) hh)) 0.0001))
		(setq
			ht (* 0.5 (apply (function +) hh))
			vv (apply 'append (mapcar (function get_v_by_high) ss))
			vv (mai_list_group_if vv '(lambda(x)(>= x 0)))
			vv (list (apply (function +) (car vv)) (apply (function +) (cadr vv)))
			ee (+ (* gcd_tfph (car vv)) (cadr vv))
			hh (if (> ee 0) (list ht (cadr hh)) (list (car hh) ht))
			mm (cond
					((not mm) (list ee vv ht))
					((>= (abs ee) (abs (car mm))) mm)
					((list ee vv ht))
				)
		)
	)
	(princ (strcat "\n最小高程 = " (rtos high_b 2 3) " ,最大高程 = " (rtos high_t 2 3) " ,土方平衡高程 = " (rtos (caddr mm) 2 3)))
	(princ (strcat "\n土方平衡时挖方 = " (rtos (caadr mm) 2 3) "立方米 ,填方 = " (rtos (- (cadadr mm)) 2 3) "立方米 ,挖填系数 = " (rtos gcd_tfph 2 2)))
	(setq ht (getdist (strcat "\n输入需要计算土方的场地高程【" (rtos high_b 2 3) "~" (rtos high_t 2 3) "】:<退出>")))
	(or ht (exit))
	(setq
		vv (apply 'append (mapcar (function get_v_by_high) ss))
		vv (mai_list_group_if vv (function (lambda(x)(>= x 0))))
		vv (list (apply (function +) (car vv)) (apply (function +) (cadr vv)))
		ee  (list
				(strcat "平场面积 = " (rtos areas 2 3) " 平方米")
				(strcat "最小高程 = " (rtos high_b 2 3) " 米")
				(strcat "最大高程 = " (rtos high_t 2 3) " 米")
				(strcat "平场标高 = " (rtos ht 2 3) " 米")
				(strcat "挖方量 = " (rtos (car vv) 2 2) " 立方米")
				(strcat "填方量 = " (rtos (- (cadr vv)) 2 2) " 立方米")
			)
	)
	(mapcar (function (lambda(x)(princ (strcat "\n" x)))) ee)
	(setq vv (mai_dos_tempfile "txt"))
	(mai_write_file vv ee)
	(mai_dos_execute (strcat "\"" (mai_panel_search "notepad2.exe") "\" \"" vv "\"") nil)
	(princ)
)




(defun tri_ncgc ( ss /  addgcptinpm zInsert pt tmp )

(defun addgcptinpm ( pt lst / z )
	(vl-some
		(function
			(lambda( x / y )
				(setq y (mapcar 'mai_3p_2p x))
				(if (> (mai_point_in_data pt (cons (last y) y)) -2) (setq z (cons pt x)))
			)
		)
		lst
	)
	z
)

;;双线性内插计算内插高程值
(defun zInsert ( ptl / pbc pt0 pt1 pt2 pt3 xa xb xc ya yb yc za zb zc pz )
	(mapcar (function set) '( pt0 pt1 pt2 pt3) ptl)
	(setq pt0 (mai_3p_2p pt0))
	(mapcar (function set) '(xa ya za) pt1)
	(mapcar (function set) '(xb yb zb) pt2)
	(mapcar (function set) '(xc yc zc) pt3)
	(cond
		(	(mai_equal pt0 (list xa ya)) (setq pz za))
		(	(mai_equal pt0 (list xb yb)) (setq pz zb))
		(	(mai_equal pt0 (list xc yc)) (setq pz zc))
		(	T
			(setq
				pbc (inters pt0 (list xa ya) (list xb yb) (list xc yc) nil)
				pz (mai_divide_point pt2 pt3 (/ (distance (list xb yb) pbc) (distance (list xb yb) (list xc yc))))
				pz (mai_divide_point pt1 pz (/ (distance (list xa ya) pt0) (distance (list xa ya) pbc)))
			)
		)
	)
	pz
)
	(setq ss (mapcar (function mai_get_face_points) ss))
	(apply (function mai_create_layer) gcd_blk_lay)
	(while
		(progn
			(initget "S")
			(setq pt (getpoint (strcat "\n[选择标高块(S)]当前块标高块为<" gcd_blk ">连续内插高程点:<退出>")))
		)
		(if (= pt "S")
			(if (setq tmp (car (mai_Entsel nil (strcat "选择标高块:<" gcd_blk ">") "没有找到块." '((0 . "insert")) nil)))
				(if (mai_get_blk_atts tmp nil)
					(setq gcd_blk (mai_dxf 2 tmp))
					(princ "\n所选块没属性。")
				)
			)
			;;角度法判断点在那个三角形 返回((ptx pty ptz) ((p1x p1y p1z) (p2x p2y p2z) (p3x p3y p3z)))
			(if (setq pt (addgcptinpm (mai_3p_2p pt) ss)) ;如果点在三角形线上或三角形内
				(progn
					;;双线性内插计算内插点的高程值 返回内插点(x y z)
					(setq pt (zInsert pt))
					(gxl_cs:gcd pt (caddr pt) mai_scale2 2 (car gcd_blk_lay))
				)
			)
		)
	)
	(princ)
)




(defun tri_adj ( /  ent pts  pt lay p1 p2 p3 p4 p5 p6 obj_sty )
	(while (setq ent (mai_entsel nil "选择3dface,单选要调整边的三角网triangle:<回车退出>" "没有找到任何3dface." '((0 . "polyline,3dface")) nil))
		(setq
			pt (mai_3p_2p (cadr ent))
			ent (car ent)
			pts (entget ent)
			lay (assoc 8 pts)
			obj_sty (assoc 0 pts)
			pts (mai_get_face_points ent)
			pts (mai_m_trans pts 0 1)
		)
		(if (= 3 (length pts))
			(progn
				(mapcar (function set) '(p1 p2 p3) pts)
				(setq
					pts (list
							(list (mai_dist_to_line pt (mai_3p_2p p1) (mai_3p_2p p2)) p1 p2 p3)
							(list (mai_dist_to_line pt (mai_3p_2p p1) (mai_3p_2p p3)) p1 p3 p2)
							(list (mai_dist_to_line pt (mai_3p_2p p2) (mai_3p_2p p3)) p2 p3 p1)
						)
					pts (cdar (vl-sort pts (function (lambda(x y) (< (car x) (car y))))))
				)
				(mapcar (function set) '(p1 p2 p3) pts)
				(setq
					p4 (mapcar 'min p1 p2 p3)
					p5 (mapcar 'max p1 p2 p3)
					pts (mai_divide_point p4 p5 0.5)
					p4 (mai_divide_point pts p4 1.01)
					p5 (mai_divide_point pts p5 1.01)
					pts (ssget "c" p4 p5 (list obj_sty lay))
					p6 nil
				)
				(ssdel ent pts)
				(vl-some
					(function
						(lambda(x / y)
							(setq y (vl-remove-if '(lambda(x)(mai_member x (list p1 p2))) (mai_get_face_points x)))
							(if (= 1 (length y))
								(setq p6 (cons x y))
							)
						)
					)
					(mai_ssget_2_list pts)
				)
				(if p6
					(progn
						(entdel ent)
						(entdel (car p6))
						(setvar "clayer" (cdr lay))
						(mai_entmake (cdr obj_sty) (list p3 p1 (cadr p6)))
						(mai_entmake (cdr obj_sty) (list p3 p2 (cadr p6)))
					)
				)
			)
		)
	)
	(princ)
)


(defun tri_dgx ( ss / nn )
	(apply (function mai_create_layer) gcd_dgx)
	(setvar "plinewid" 0)
	(princ "\n等高线数据处理中......")
	(setq
		ss (mapcar (function (lambda (x)(setq x (entget x)) (mai_remove_same (list (mai_dxf 10 x)(mai_dxf 11 x)(mai_dxf 12 x)(mai_dxf 13 x))))) ss)
		nn (entlast)
	)
	(mai_faces_elev ss gcd_dgx_hight)
	(and
		(= gcd_dgx_style "1")
		(setq ss (mai_ssget_2_list (mai_newset nn)))
		(foreach nn ss (command "_.pedit" nn "F" ""))
	)
	(princ)
)

(defun tri_area ( ss )
	(setq
		ss (mapcar
				(function
					(lambda (x)
						(setq
							x (entget x)
							x (mai_remove_same (list (mai_dxf 10 x)(mai_dxf 11 x)(mai_dxf 12 x)(mai_dxf 13 x)))
						)
						(mai_area_delta (car x)(cadr x) (caddr x))
					)
				)
				ss
			)
		ss (apply (function +) ss)
	)
	(princ (strcat "\n三角网表面积一共为 :" (rtos ss 2 2)))
	(princ)
)


	(mai_start nil)
	(mai_last_com "mini_tfph")
	(setq
		old_pwidth (getvar "plinewid")
		cfgname (mai_fix_dir1 (strcat mai_mini_path "Plus_lib\\迷你收录插件\\测绘\\mini_tfph.cfg"))
		mai_sym_list
			(list
				(list 'gcd_tin			mai_cehui_tin)         ;三角网所在图层及颜色
				(list 'gcd_tfph 	1)        			 ;等高线所在图层及颜色

				(list 'gcd_units 		"1=1米")
				(list 'gcd_scale 		500)
				(list 'gcd_blk_lay		mai_cehui_gcd_blk)
				(list 'gcd_blk			mai_cehui_gc_blkname)

				(list 'gcd_dgx 			mai_cehui_dgx)         ;等高线所在图层及颜色
				(list 'gcd_dgx_hight 	1)        			 ;等高线所在图层及颜色
				(list 'gcd_dgx_style 	"1")
			)
	)
	(mai_read_config cfgname mai_sym_list 'mai_tfph_op)
	(setq
		mm (mai_dcl_model1
				(list (list "-15" ))
				0
				"【三角网、土方平衡、等高线】"
				(list 1 1 45 0.01 -15 nil nil)
				(list
					(list "" 1 40)
						(list "三角网层:" "get_layer" gcd_tin)
						(list "" "text" T)
						(list "土方挖填系数:" (list "get_dist" 1 1.1 1.2 1.3 1.4 1.5 1.6 1.7 1.8 1.9 2.0) gcd_tfph)
						(list "由三角网计算土方平衡-------->>" "get_done" T)
						(list "由三角网计算地形表面积------>>" "get_done" T)

						;(list "" "text" T)
						(list "制图单位:" (list "radio" "1=1米" "1=1毫米") gcd_units)
						(list "制图比例 1:" (list "get_dist" 50 100 150 200 250 300 350 400 450 500 550 600 650 700 750 800 850 900 950 1000 1250 1500 1750 2000 2500 3000 4000 5000) gcd_scale)
						(list "高程块层:" "get_layer" gcd_blk_lay)
						(list "高程点块:" "get_block" gcd_blk)
						(list "三角网内标注任意点高程------>>" "get_done" T)

						(list "" "text" T)
						(list "等高线层:" "get_layer" gcd_dgx)
						(list "等高线高差:" (list "get_dist" 0.5 1 1.5 2 2.5 3 3.5 4 4.5 5) gcd_dgx_hight)
						(list "曲线拟合等高线" "toggle" gcd_dgx_style)
						(list "由三角网生成等高线---------->>" "get_done" T)
						(list "" "text" T)
						(list "选边局部调整三角网---------->>" "get_done" T)
				)
				nil
				nil
			)
		nn (cadddr mm)
		mm (cadr mm)
	)
	(or mm (exit))
	(mapcar '(lambda(x y) (set (car x) y)) mai_sym_list (vl-remove T mm))
	(mai_write_config cfgname mai_sym_list 'mai_tfph_op)
	(setq
		mai_scale gcd_scale
		mai_draw_units (if (= gcd_units "1=1米") 0.001 1)
		gcd_dgx_hight (* gcd_dgx_hight (if (= gcd_units "1=1米") 1 1000))
	)
	(mai_load_dim_style (>= mai_scale maidimsite))
	(mai_get_scale)
	(if (member nn (list 4 5 14 16 ))
		(setq
			ss (mai_select_first
					(list (cons 0 "3dface") (cons 8 (car gcd_tin)))
					"选择需要计算处理的triangle三角网3dface实体:<回车退出>"
					"没有找到任何3dface."
				)
			ss (mai_ssget_2_list ss)
		)
	)
	(cond
		(	(= 4 nn) (cale_balance ss))
		(	(= 5 nn) (tri_area ss))
		(	(= 10 nn) (tri_ncgc ss))
		(	(= 15 nn) (tri_dgx ss))
		(	(= 17 nn) (tri_adj))
	)
	(mai_end)
)
