Chuyển đến nội dung
Diễn đàn CADViet
fire_unicorn

Vấn đề với lisp tính khối lượng đào đắp

Các bài được khuyến nghị

Trước giờ em vẫn load các lisp sau để tính khối lượng nạo vét:

Area.lsp

;;*****************************************
;;*****************************************
(defun Tinh_dt (list_pt p1 p2 p3 p4 mep_ngang / diem1 diem2 d1 d2 bl kt i)
(progn
(setq dientich nil)
(setq bl (- (length list_pt) 1))
(setq d1 (list (nth 0 p2) cdmax))
(setq d2 (list (nth 0 p2) cdmin))
(setq d3 (list (nth 0 p3) cdmax))
(setq d4 (list (nth 0 p3) cdmin))

(setq i 0 dc1 nil dc2 nil diem1 nil diem2 nil)
(repeat bl
(progn
  (setq dc1 (inters d1 d2 (nth i list_pt) (nth (1+ i) list_pt)))
  (setq dc2 (inters d3 d4 (nth i list_pt) (nth (1+ i) list_pt)))
  (if (/= dc1 nil) (setq diem1 dc1))
  (if (/= dc2 nil) (setq diem2 dc2))
)
(setq i (1+ i))
)

(setq dc1 nil dc2 nil dk1 nil)

(setq list_dc '());; khai bao list diem cat
(setq i 0 h 0 dc nil)

(repeat bl
 (progn	
 (setq dc (inters (nth i list_pt) (nth (1+ i) list_pt) p1 p2))
 (if (/= dc nil) (progn (setq list_dc (cons dc list_dc) dk1 1 h (1+ h))))
 )
 (setq i (1+ i))
)


(setq i 0 dc nil)
(repeat bl  
 (progn	
 (setq dc (inters (nth i list_pt) (nth (1+ i) list_pt) p2 p3))		
 (if (/= dc nil) (setq list_dc (cons dc list_dc)))
 )
 (setq i (1+ i))
)

(setq i 0 k 0 dc nil dk2 nil)
(repeat bl   
 (progn
 (setq dc (inters (nth i list_pt) (nth (1+ i) list_pt) p3 p4))
	 (if (/= dc nil)
		 (progn
			 (setq list_dc (cons dc list_dc))
			 (setq dk2 1)
			 (setq k (1+ k))				  
		 )
	 )
 )
 (setq i (1+ i))
)									   


(setq dc nil)

(if (and (= k 1) (< (nth 1 diem2) mep_ngang))
  (setq list_dc (cdr list_dc))
)


(setq list_dc (reverse list_dc))

(if (and (= h 1) (< (nth 1 diem1) mep_ngang))
  (setq list_dc (cdr list_dc))
)

(if (and (/= dk1 nil) (> h 1))
 (progn
 (setq listt1 '())	  
 (setq so1 (car list_dc))
 (setq list_dc (cdr list_dc))
 (setq so2 (car list_dc))
 (setq list_dc (cdr list_dc))
 (setq kt T i 0)
 (setq listt1 (cons so1 listt1))
(while kt
(progn		 
	 (setq p (nth i list_pt))
	 (if (<= (nth 1 p) (nth 1 so2)) (setq kt nil))
	 (if (and (> (nth 0 p) (nth 0 so1)) (> (nth 1 p) (nth 1 so2)))
	(setq listt1 (cons p listt1))
		 )			 
	 (setq i (1+ i))
)
)
 (setq listt1 (cons so2 listt1))	
 (command "AREA")
 (foreach n listt1 (command n))
 (command "" "") 
 (setq dt1 (getvar "AREA"))
 )
)


(if (and (/= dk2 nil) (> k 1))
 (progn
 (setq listt1 '()) 
 (setq list_dc (reverse list_dc))
 (setq list_pt (reverse list_pt))	
 (setq so1 (car list_dc))
 (setq list_dc (cdr list_dc))
 (setq so2 (car list_dc))
 (setq list_dc (cdr list_dc))
 (setq kt T i 0)
 (setq listt1 (cons so1 listt1))
(while kt
(progn		 
	 (setq p (nth i list_pt))
	 (if (<= (nth 1 p) (nth 1 so2)) (setq kt nil))
	 (if (and (< (nth 0 p) (nth 0 so1)) (> (nth 1 p) (nth 1 so2)))
	(setq listt1 (cons p listt1))
		 )			 
	 (setq i (1+ i))
)
)
 (setq listt1 (cons so2 listt1))	
 (command "AREA")
 (foreach n listt1 (command n))
 (command "" "") 
 (setq dt2 (getvar "AREA"))

 (setq list_dc (reverse list_dc))
 (setq list_pt (reverse list_pt))

 )
)

(setq listt1 nil so1 nil so2 nil h nil k nil)

(setq list_dc (reverse list_dc))
(setq list_dc1 '())

(if (> (length list_dc) 0)
 (progn
(setq i 0)
(repeat (length list_dc)
	(if (/= (nth i list_dc) nil)
		(setq list_dc1 (cons (nth i list_dc) list_dc1)))
(setq i (1+ i))
)
  )	
)


(setq list_dc list_dc1 list_dc1 nil)


(if (> (length list_dc) 1)
(progn
  (setq i 0)
  (setq list_up '())
  (repeat (- (length list_dc) 1)
  (progn
  (setq ptu1 (nth i list_dc))
  (setq ptu2 (nth (1+ i) list_dc))	  
  (if (/= ptu1 nil)
	(progn
	(setq list_up (cons ptu1 list_up))		
   ;;(setq kt T)		
(setq j 0)
	(repeat (length list_pt)
	   (progn		 
		 (setq p5 (nth j list_pt))				   	   
		 (if (/= ptu2 nil)				 
		   (if (and (> (nth 0 p5) (nth 0 ptu1)) 
					(<= (nth 0 p5) (nth 0 ptu2))				
					(>= (nth 1 p5) (nth 1 p2)))
					(setq list_up (cons p5 list_up))))						 
	   )
	   (setq j (1+ j))		  
	)		 
  ))
  (setq i (1+ i))
 ;;(setq kt T j 0)
  )
  )
(setq list_up (cons (last list_dc) list_up))
))


(setq ptu1 nil ptu2 nil i nil j nil)

(if (and (/= diem2 nil) (> (nth 1 diem2) mep_ngang) (= dk2 1))
 (setq list_up (cons p3 list_up)))


(if (and (/= diem1 nil) (> (nth 1 diem1) mep_ngang) (= dk1 1))
 (setq list_up (cons p2 list_up)))

(if (and (/= diem1 nil) (< (nth 1 diem1) mep_ngang))
 (setq list_up (cons p2 list_up)))

(setq list_up (reverse list_up))


(if (/= list_up nil)
(progn
(command "AREA")
(foreach n list_up (command n))
(command "" "") 
(setq dientich (getvar "AREA"))
)
)
(if (= dientich nil) (setq dientich 0))
(if (/= dt1 nil) (setq dientich (+ dientich dt1)))
(if (/= dt2 nil) (setq dientich (+ dientich dt2)))

(setq p1 nil p2 nil p3 nil p4 nil p5 nil dc nil d nil so_dc nil d1 nil i nil)
(setq list_up nil list_dc nil bl nil dt1 nil dt2 nil)
)
);;end_tinh_dt
;;*******************************************
;;Tinh dien tich du ra giua cac mep + duong sai so voi duong tu nhien
(defun dientich_phu (list_diem d1 d2)
(setq b_lap (- (length list_diem) 1))
(setq i 0)
(setq dientich1 0)
(setq list_midpoint '())

(repeat b_lap 
  (progn
  (setq diem (nth i list_diem))  
  (if (and (> (nth 0 diem) (nth 0 d1)) (< (nth 0 diem) (nth 0 d2)))
(setq list_midpoint (cons diem list_midpoint))
  )		   
  )  
(setq i (1+ i))
)
(setq diem nil i nil b_lap nil)
(if (>= (length list_midpoint) 0)
 (progn
	   (setq list_midpoint (reverse (cons d2 list_midpoint)))
	   (setq list_midpoint (cons d1 list_midpoint))		  
	   (command "AREA")
	   (foreach n list_midpoint (command n))
	   (command "" "")
	   (setq dientich1 (getvar "AREA"))
 )
)
(setq list_midpoint nil)
);;end_fun
;;*******************************************
(defun ham1 (list_pt p11 p21 p31 p51 midpoint)
(setq lst '() dientich2 0 point1 nil)
(progn
  (setq i 0 dc1 nil)
  (repeat (- (length list_pt) 2)
 (setq dc1 (inters (nth i list_pt) (nth (1+ i) list_pt) p11 p51))				
  (setq i (1+ i)))
  (if (/= dc1 nil) (setq point1 dc1))	

  (if (= point1 nil)									
  (progn
  (setq i 0 kt T dc1 nil)
  (while kt   
  (progn	
  (if (= i (- (length list_pt) 2)) (setq kt nil))	
  (setq dc1 (inters (nth i list_pt) (nth (1+ i) list_pt) p21 p31))

  (if (/= dc1 nil) (progn (setq point1 dc1) (setq kt nil)))		   
  (setq i (1+ i))))

  )
  )

  (if (= point1 nil)									
  (progn
  (setq i 0 kt T dc1 nil)
  (while kt   
  (progn	
  (if (= i (- (length list_pt) 2)) (setq kt nil))	
  (setq dc1 (inters (nth i list_pt) (nth (1+ i) list_pt) p51 p31))
  (if (/= dc1 nil) (progn (setq point1 dc1) (setq kt nil)))		   
  (setq i (1+ i))))
  )
  )


  (setq lst (cons p11 lst))   
  (setq lst (cons midpoint lst))
  (setq i 0)
  (repeat (- (length list_pt) 1)		   
   (if (and (> (nth 0 (nth i list_pt)) (nth 0 midpoint))
			(< (nth 0 (nth i list_pt)) (nth 0 point1)))
   (setq lst (cons (nth i list_pt) lst)))
(setq i (1+ i))
)
(setq lst (cons point1 lst))

(if (> (nth 0 point1) (nth 0 p21))  (setq lst (cons p21 lst)))   
(if (> (nth 0 point1) (nth 0 p51))  (setq lst (cons p51 lst)))   

(if (/= lst nil)
(progn
  (command "AREA")
  (foreach n lst (command n))
  (command "" "")
  (setq dientich2 (getvar "AREA")))
)
)

(setq lst nil i nil t nil midpoint nil point1 nil dc1 nil dc2 nil)
);;end_fun

;;********************************************
(defun ham2 (list_pt p41 p31 p21 p61 midpoint)
(setq lst '() dientich3 0)
(progn
  (setq i 0 dc nil)   
  (repeat (- (length list_pt) 2)		   
 (setq dc (inters (nth i list_pt) (nth (1+ i) list_pt) p61 p41))
 (if (and (/= dc nil) (> (nth 0 dc) (nth 0 p61))) (setq point2 dc))			  
  (setq i (1+ i))
  )

  (if (= point2 nil)
  (progn
  (setq i 0 dc nil)
  (repeat (- (length list_pt) 2)		 
  (setq dc (inters (nth i list_pt) (nth (1+ i) list_pt) p21 p31))
	(if (/= dc nil) (setq point2 dc))			  
  (setq i (1+ i))
  )
  ))

  (if (= point2 nil)
  (progn
  (setq i 0 dc nil)
  (repeat (- (length list_pt) 2)		 
  (setq dc (inters (nth i list_pt) (nth (1+ i) list_pt) p61 p31))
	(if (/= dc nil) (setq point2 dc))			  
  (setq i (1+ i))
  )
  ))


 (setq lst (cons point2 lst))
  (setq i 0)
  (repeat (- (length list_pt) 2)	  
   (if (and (> (nth 0 (nth i list_pt)) (nth 0 point2))
			(< (nth 0 (nth i list_pt)) (nth 0 midpoint)))	   
	   (setq lst (cons (nth i list_pt) lst)))
  (setq i (1+ i))
  )   

  (setq lst (cons midpoint lst))
  (setq lst (cons p41 lst))   
  (if (> (nth 0 p61) (nth 0 point2) ) (setq lst (cons p61 lst)))
  (if (> (nth 0 p31) (nth 0 point2) ) (setq lst (cons p31 lst)))

 (if (/= lst nil)
 (progn

   (command "AREA")
   (foreach n lst (command n))
   (command "" "")
   (setq dientich3 (getvar "AREA")))
 )
)

(setq lst nil i nil t nil midpoint nil point2 nil dc1 nil dc2 nil)
);;end_fun
;;*******************************************
(defun DIEN_TICH ()
(setvar "LUNITS" 2)
(setvar "LUPREC" 2)
 (setq cdss (- cdd ssd)) 
 (setq pt1 (list (- mt (* (- cdmax cdd) n1)) cdmax))
 (setq pt2 (list mt cdd))
 (setq pt3 (list mn cdd))
 (setq pt4 (list (+ mn (* (- cdmax cdd) n2)) cdmax))

 (setq pt11 (list (- (nth 0 pt1) ssn) (nth 1 pt1)))
 (setq pt41 (list (+ (nth 0 pt4) ssn) (nth 1 pt4)))
 (setq pt51 (list (- mt ssn) cdd))
 (setq pt61 (list (+ mn ssn) cdd))
 (setq pt21 (list mt (- cdd ssd)))
 (setq pt31 (list mn (- cdd ssd)))
 (setq pt71 (inters pt11 pt51 pt31 pt21 nil))
 (setq pt81 (inters pt41 pt61 pt21 pt31 nil))

 (setq dientichthua1 (* (abs (- (nth 0 pt71) mt)) (/ ssd 2)))
 (setq dientichthua2 (* (abs (- (nth 0 pt81) mn)) (/ ssd 2)))


(if (< (nth 0 pt71) mt)
  (setq dientichthua1 (- 0 dientichthua1)))
(if (> (nth 0 pt81) mn)
  (setq dientichthua2 (- 0 dientichthua2)))

(setq dientichdoira (/ (* ssn ssd) 4))
;; Tim giao diem cua duong sau nao vet voi duong sai so du kien

(setq so_buoc (- (length kccdsnv) 1))
(setq i 0)
(repeat so_buoc
  (progn
 (setq pt5 (list (nth i kccdsnv) (nth i cdsnv)))
 (setq pt6 (list (nth (1+ i) kccdsnv) (nth (1+ i) cdsnv)))

 (setq dc1 (inters pt5 pt6 pt11 pt51 T))
 (setq dc2 (inters pt5 pt6 pt61 pt41 T))

 (if (/= dc1 nil) (setq diem_luu1 dc1))	
 (if (/= dc2 nil) (setq diem_luu2 dc2))
  )
  (setq i (1+ i))

)

;;Phan tim giao diem cat cua 2 mep voi duong tu nhien


(setq i 0 bdd1 nil bdd2 nil bdd3 nil bdd4 nil dc1 nil dc2 nil)
2(setq so_buoc (- (length kccdtn) 1))

(repeat so_buoc
  (progn
 (setq pt5 (list (nth i kccdtn) (nth i cdtn)))
 (setq pt6 (list (nth (1+ i) kccdtn) (nth (1+ i) cdtn)))

 (setq dc1 (inters pt5 pt6 pt1 pt2 T))
 (setq dc2 (inters pt5 pt6 pt11 pt51 T))
 (setq dc3 (inters pt5 pt6 pt21 pt51 T))	

 (if (/= dc1 nil) (progn (setq pt1 dc1 bdd1 T)))
 (if (/= dc2 nil) (progn (setq pt11 dc2 bdd2 T)))
 (if (/= dc3 nil) (progn (setq pt11 dc3 bdd5 T)))

 (setq dc1 (inters pt5 pt6 pt3 pt4 T))
 (setq dc2 (inters pt5 pt6 pt61 pt41 T))
 (setq dc3 (inters pt5 pt6 pt31 pt61 T))

 (if (/= dc1 nil) (progn (setq pt4 dc1 bdd3 T)))
 (if (/= dc2 nil) (progn (setq pt41 dc2 bdd4 T)))
 (if (/= dc3 nil) (progn (setq pt11 dc3 bdd6 T)))
  ) 
  (setq i (1+ i))
)

(setq dc1 nil dc2 nil i 0 bdd7 nil bdd8 nil)
(repeat so_buoc
  (progn
 (setq pt5 (list (nth i kccdsnv) (nth i cdsnv)))
 (setq pt6 (list (nth (1+ i) kccdsnv) (nth (1+ i) cdsnv)))

 (setq dc1 (inters pt5 pt6 pt11 pt51 T))
 (setq dc2 (inters pt5 pt6 pt41 pt61 T))


 (if (/= dc1 nil) (setq bdd7 T))
 (if (/= dc2 nil) (setq bdd8 T))
  ) 
  (setq i (1+ i))
)


(if (/= bdd5 nil)	
(progn
(setq pt11 pt51)	
)
)

(if (/= bdd6 nil)	
(progn
(setq pt41 pt61)
)
)

(if (and (= bdd2 nil) (= bdd5 nil) (/= bdd1 nil))
	(setq pt11 (list (- (nth 0 pt1) ssn) (nth 1 pt1)))						 
)

(if (and (= bdd4 nil) (= bdd6 nil) (/= bdd3 nil))
	(setq pt41 (list (+ (nth 0 pt4) ssn) (nth 1 pt4)))	 
)


;;kiem tra xem duong sau nao vet co cat duong tu nhien o giua cua pt1 va pt11 khong?

(setq i 0 pt11_luu nil pt5 nil pt6 nil kt T dc nil)

(while kt
(progn
	 (setq pt5 (list (nth i kccdsnv) (nth i cdsnv)))
	 (setq pt6 (list (nth (1+ i) kccdsnv) (nth (1+ i) cdsnv)))	 
	 (setq dc (inters pt5 pt6 pt11 pt1 T))
	 (if (/= dc nil) (setq pt11_luu dc))	
	 (if (or (/= dc nil) (> (nth i kccdsnv) (nth 0 pt2))) (setq kt nil))
	 (setq i (1+ i))
)
)


;;kiem tra xem duongn sau nao vet co cat duong tu nhien o giua cua pt4 va pt41 khong?

(setq i 0 pt41_luu nil pt5 nil pt6 nil dc nil kt T)
(setq kccdsnv (reverse kccdsnv))
(setq cdsnv (reverse cdsnv))

(while kt
(progn
	 (setq pt5 (list (nth i kccdsnv) (nth i cdsnv)))
	 (setq pt6 (list (nth (1+ i) kccdsnv) (nth (1+ i) cdsnv)))	 
	 (setq dc (inters pt5 pt6 pt4 pt41 T))		 
	 (if (/= dc nil) (setq pt41_luu dc))	
	 (if (or (/= dc nil) (< (nth i kccdsnv) (nth 0 pt3))) (setq kt nil))
	 (setq i (1+ i))
)
)



(setq kccdsnv (reverse kccdsnv))
(setq cdsnv (reverse cdsnv))
(setq dc nil)

;;Giao diem voi day thiet ke 

(setq i 0)
(setq so_buoc (- (length kccdtn) 1))
(setq list1 '())

(repeat so_buoc

  (progn
 (setq pt5 (list (nth i kccdtn) (nth i cdtn)))
 (setq pt6 (list (nth (1+ i) kccdtn) (nth (1+ i) cdtn)))

 (setq dc (inters pt5 pt6 pt2 pt3 T))

 (if (/= dc nil)
   (cond
	 ((or (and (> (nth 1 pt5) cdd) (< (nth 1 pt6) cdd))
		  (and (< (nth 1 pt5) cdd) (> (nth 1 pt6) cdd)))
		  (setq list1 (cons dc list1))
	 )


	 ((if (and (> i 0) (< i (- so_buoc 1)))
		  (cond
			  ((and (= (equal (nth 1 pt6) cdd) T)
					(<= (nth (+ i 2) cdtn) cdd)
					(> (nth 1 pt5) cdd))
				 (setq list1 (cons dc list1))
			  )

			  ((and (= (equal (nth 1 pt5) cdd) T)
					(> (nth 1 pt6) cdd)
					(<= (nth (- i 1) cdtn) cdd))
				 (setq list1 (cons dc list1))
			  )
		  )				  
	  )
	 )	
   )
 )
  )
  (setq i (1+ i))
)

(setq dc nil pt5 nil pt6 nil)

(setq so_buoc (length kccdsnv) i 0)
(setq list_snv '() list_tn '())

(repeat so_buoc
(setq list_snv (cons (list (nth i kccdsnv) (nth i cdsnv)) list_snv))
(setq list_tn (cons (list (nth i kccdtn) (nth i cdtn)) list_tn))
(setq i (1+ i))
)

(setq list_snv (reverse list_snv))
(setq list_tn (reverse list_tn))

(setq bl (- (length list_tn) 1))
(setq d1 (list (nth 0 pt2) cdmax))
(setq d2 (list (nth 0 pt2) cdmin))
(setq d3 (list (nth 0 pt3) cdmax))
(setq d4 (list (nth 0 pt3) cdmin))

(setq i 0)
(repeat bl
(progn
  (setq dc1 (inters d1 d2 (nth i list_tn) (nth (1+ i) list_tn)))
  (setq dc2 (inters d3 d4 (nth i list_tn) (nth (1+ i) list_tn)))
  (if (/= dc1 nil) (setq moc1 dc1))
  (if (/= dc2 nil) (setq moc2 dc2))
)
(setq i (1+ i))
)

(setq i 0 kiemtra nil)

(repeat bl
  (progn
 (setq pt5 (list (nth i kccdsnv) (nth i cdsnv)))
 (setq pt6 (list (nth (1+ i) kccdsnv) (nth (1+ i) cdsnv)))

 (setq dc1 (inters pt5 pt6 pt11 pt51 T))
 (setq dc2 (inters pt5 pt6 pt21 pt51))	
 (setq dc3 (inters pt5 pt6 pt61 pt41 T))
 (setq dc4 (inters pt5 pt6 pt31 pt61))
 (setq dc5 (inters pt5 pt6 pt21 pt31 T))

 (if (or (/= dc1 nil) (/= dc2 nil) (/= dc3 nil) (/= dc4 nil) (/= dc5 nil))
  	(setq kiemtra T)
 )
  ) 
  (setq i (1+ i))
)

(setq dc1 nil dc2 nil d1 nil d2 nil d3 nil d4 nil bl nil)

;;phan tinh toan

(progn

(setq list1 (reverse list1))
(setq so_ptu (length list1))

(print list1)

(cond
 ( (= so_ptu 0)

 (if (and (= bdd1 T) (= bdd3 T))
 (progn
(setq list_lt '() kt T i 0)
(setq list_lt (cons pt1 list_lt))
(while kt
   (if (and (> (nth i kccdtn) (nth 0 pt1))
			(< (nth i kccdtn) (nth 0 pt4)))

   (setq list_lt (cons (list (nth i kccdtn) (nth i cdtn)) list_lt))
   )
   (setq i (1+ i))
   (if (> (nth i kccdtn) (nth 0 pt4)) (setq kt nil))	   
)
(setq list_lt (cons pt4 list_lt))
(setq list_lt (reverse (cons pt2 (cons pt3 list_lt))))
(if (> (length list_lt) 2)
   (progn
	  (command "AREA")
	  (foreach n list_lt (command n))
	  (command "")	
	  (setq dthh (getvar "AREA"))
	  (command "AREA" pt1 pt2 pt3 pt4 pt41 pt61 pt31 pt21 pt51 pt11 "")
	  (setq dtss (getvar "AREA"))
   )
)

(dientich_phu list_tn pt11 pt1)
(setq dtss (+ dtss dientich1))

(dientich_phu list_tn pt4 pt41)
(setq dtss (+ dtss dientich1))

(if (= kiemtra T)			   	 
(progn	

	(if (/= pt11_luu nil)
	(progn
	(ham1 list_snv pt11 pt21 pt31 pt51 pt11_luu)
	(if (/= dientich2 nil) (setq dtsnv (+ dtsnv dientich2)))
	)
	)


	(if (/= pt41_luu nil)
	(progn
	(ham2 list_snv pt41 pt31 pt21 pt61 pt41_luu)
	(if (/= dientich3 nil) (setq dtsnv (+ dtsnv dientich3)))
	)
	)


	(if (/= pt11_luu nil) (setq pt11 pt71))	
	(if (/= pt41_luu nil) (setq pt41 pt81))
	(tinh_dt list_snv pt11 pt71 pt81 pt41 cdss)
	(setq dtsnv (+ dtsnv dientich))   

		(if (/= bdd7 nil) (setq dtsnv (+ dtsnv dientichthua1)))
	(if (/= bdd8 nil) (setq dtsnv (+ dtsnv dientichthua2)))	




))

 )))

 ( (/= so_ptu 0)		

 (progn  
(TINH_DT list_tn pt1 pt2 pt3 pt4 cdd)
(setq dthh dientich)	

(setq list2 '())
(setq i 0)		
(repeat so_ptu
	  (progn
			 (setq dc (list (nth 0 (nth i list1)) (- cdd ssd)))
			 (setq list2 (cons dc list2))

	  )
	  (setq i (1+ i))
)

(setq list2 (reverse list2))


(cond
  ((= (rem so_ptu 2) 0)
  (progn 

	(setq t1 (car list2) t2 (last list2))
	(setq t3 (car list1) t4 (last list1))

(if (and (/= bdd1 nil) (> (nth 1 moc1) cdd))
	(progn
	(setq t3 (list (+ (nth 0 t3) ssn) (nth 1 t3))) 
	(command "AREA" pt11 pt51 pt21 t1 t3 pt2 pt1 "")
	(setq dtss (getvar "AREA"))
	(dientich_phu list_tn pt11 pt1)
	(setq dtss (+ dtss dientich1))	   
(if (> dtss dientichdoira) (setq dtss (- dtss dientichdoira)))

(if (= kiemtra T)
(progn	
(if (/= pt11_luu nil) 
(progn
	(ham1 list_snv pt11 pt21 pt31 pt51 pt11_luu)
	(if (/= dientich2 nil) (setq dtsnv (+ dtsnv dientich2)))
)
)


(if (= pt11_luu nil) (progn (tinh_dt list_snv pt11 pt71 t1 t3 cdss) (setq dtsnv (+ dtsnv dientich))))

	(if (/= bdd7 nil) (setq dtsnv (+ dtsnv dientichthua1)))		
))

	(setq list1 (cdr list1))
(setq list2 (cdr list2))
	)
)

(if (and (/= bdd3 nil) (> (nth 1 moc2) cdd))	  
	(progn
	 (setq t4 (list (- (nth 0 t4) ssn) (nth 1 t4)))	  
	 (command "AREA" t4 t2 pt31 pt61 pt41 pt4 pt3 "")
	 (setq dtss (+ dtss (getvar "AREA")))
	 (dientich_phu list_tn pt4 pt41)
	 (setq dtss (+ dtss dientich1))
 (if (> dtss dientichdoira) (setq dtss (- dtss dientichdoira)))

(if kiemtra
	(progn	
(if (/= pt41_luu nil)
(progn
	(ham2 list_snv pt41 pt31 pt21 pt61 pt41_luu)
	(if (/= dientich3 nil) (setq dtsnv (+ dtsnv dientich3)))
)
)

(if (= pt41_luu nil) (progn (tinh_dt list_snv t4 t2 pt81 pt41 cdss) (setq dtsnv (+ dtsnv dientich))))

(if (/= bdd8 nil) (setq dtsnv (+ dtsnv dientichthua2)))
))

	 (setq list1 ( reverse (cdr (reverse list1))))
 (setq list2 ( reverse (cdr (reverse list2))))
	)
)


(if (> (length list1) 1)
		(progn
		   (setq i 0)			   
		   (repeat (/ (length list1) 2)
			(progn
			 (setq t1 (nth i list1) t2 (nth i list2))
			 (setq t3 (nth (1+ i) list2) t4 (nth (1+ i) list1))
			 (setq t1 (list (- (nth 0 t1) ssn) (nth 1 t1)))
			 (setq t4 (list (+ (nth 0 t4) ssn) (nth 1 t4)))
			 (command "AREA" t1 t2 t3 t4 "")
			 (setq dtss (+ dtss (getvar "AREA")))
	 (if (> dtss (* dientichdoira 2)) (setq dtss (- dtss (* dientichdoira 2))))
			 (tinh_dt list_snv t1 t2 t3 t4 cdss)
			 (setq dtsnv (+ dtsnv dientich))
			)
			(setq i (+ i 2))
		   )
		)
)


))

((= (rem so_ptu 2) 1)
(progn
	(if (/= bdd1 nil)
	(if (and (/= moc1 nil) (> (nth 1 moc1) cdd))
	   (progn
	   (setq t1 (car list2) t2 (car list1))
	   (setq t2 (list (+ (nth 0 t2) ssn) (nth 1 t2)))
	   (command "AREA" pt11 pt51 pt21 t1 t2 pt2 pt1 "")
	   (setq dtss (getvar "AREA"))
	   (dientich_phu list_tn pt11 pt1)
	   (setq dtss (+ dtss dientich1))
   (if (> dtss dientichdoira) (setq dtss (- dtss dientichdoira)))	

   (if (= kiemtra T)
   (progn
	   (if (/= pt11_luu nil)
   (progn
	(ham1 list_snv pt11 pt21 pt31 pt51 pt11_luu)
	(if (/= dientich2 nil) (setq dtsnv (+ dtsnv dientich2)))
   )
   )

   (if (= pt11_luu nil) (progn (tinh_dt list_snv pt11 pt71 t1 t2 cdss) (setq dtsnv (+ dtsnv dientich))))

   (if (/= bdd7 nil) (setq dtsnv (+ dtsnv dientichthua1)))	
	   ))

   (setq list1 (cdr list1))
   (setq list2 (cdr list2))	
	   )
	))

	(if (/= bdd3 nil)
	(if (and (/= moc2 nil) (> (nth 1 moc2) cdd))
	   (progn
	   (setq t1 (last list1) t2 (last list2))
	   (setq t1 (list (- (nth 0 t1) ssn) (nth 1 t1)))
	   (command "AREA" t1 t2 pt31 pt61 pt41 pt4 pt3 "")
	   (setq dtss (getvar "AREA"))
	   (dientich_phu list_tn pt4 pt41)
	   (setq dtss (+ dtss dientich1))
   (if (> dtss dientichdoira) (setq dtss (- dtss dientichdoira)))

   (if (= kiemtra T)
   (progn	
	   (if (/= pt41_luu nil)
   (progn
	(ham2 list_snv pt41 pt31 pt21 pt61 pt41_luu)
	(if (/= dientich3 nil) (setq dtsnv (+ dtsnv dientich3)))
   )
   )


   (if (= pt41_luu nil) (progn (tinh_dt list_snv t1 t2 pt81 pt41 cdss) (setq dtsnv (+ dtsnv dientich))))

   (if (/= bdd8 nil) (setq dtsnv (+ dtsnv dientichthua1)))
	   ))

	   (setq list1 ( reverse (cdr (reverse list1))))
   (setq list2 ( reverse (cdr (reverse list2))))
	   )									   
	))								  

	(if (> (length list1) 0)
		 (progn 
		   (setq i 0)							 
		   (repeat (/ (length list1) 2)
			(progn				 
			 (setq t1 (nth i list1) t2 (nth i list2))
			 (setq t1 (list (- (nth 0 t1) ssn) (nth 1 t1))) 
			 (setq t3 (nth (1+ i) list2) t4 (nth (1+ i) list1))
			 (setq t4 (list (- (nth 0 t1) ssn) (nth 1 t4)))
			 (command "AREA" t1 t2 t3 t4 "")
			 (setq dtss (+ dtss (getvar "AREA")))				 
	 (if (> dtss (* dientichdoira 2)) (setq dtss (- dtss (* dientichdoira 2)))) 

	 (if kiemtra
	 (progn
			 (tinh_dt list_snv t1 t2 t3 t4 cdss)
			 (setq dtsnv (+ dtsnv dientich))
	 ))
			)
			(setq i (+ i 2))
		   )
		 )
	)	   


)) 
  )  
  ))
)
)

(setq dtsnv (- dtss dtsnv))

)
;;************************************
(defun CAL_AREA ()
 (setq dthh 0 dtss 0 dtsnv 0)
 (dien_tich)
 (command "COLOR" "GREEN" "")
 (command "_.STYLE" "KC1" ".VnTimeI" "0" "1" "5" "N" "N" "")
 (setq ddat (list (/ ghmn 2) 15))
 (command "TEXT" "J" "C" ddat "2" "0" (strcat "Shh  = " (rtos dthh) " m2"))
 (setq ddat (list (/ ghmn 2) 12))
 (command "TEXT" "J" "C" ddat "2" "0" (strcat "Sss  = " (rtos dtss) " m2"))
 (setq ddat (list (/ ghmn 2) 9))
 (command "TEXT" "J" "C" ddat "2" "0" (strcat "Ssnv = " (rtos dtsnv) " m2"))
 (setq d11 (list -85 (- ghd 70)))
 (setq d12 (list -85 50))
 (setq d13 (list (+ ghmn 10) 50))	
 (setq d14 (list (+ ghmn 10) (- ghd 70)))	
 (command "_.LINE" d11 d12 d13 d14 d11 "")
 (setq d1 (list (- (nth 0 d11) 5) (- (nth 1 d11) 10)))
 (setq d3 (list (+ (nth 0 d13) 5) (+ (nth 1 d13) 5))) 
 (command "ZOOM" "WINDOW" d1 d3 "")

 (setq d12 (list ( - (nth 0 d13) 30) 50))
 (setq d11 (list (nth 0 d12) 30))
 (setq d14 (list (nth 0 d13) 30))	
 (command "_.LINE" d11 d12 "")
 (command "_.LINE" d11 d14 "")
 (setq ddat (list ( - (nth 0 d13) 15) 43))
 (command "_.STYLE" "KC2" ".VnTimeH" "0" "1" "15" "N" "N" "")
 (command "TEXT"  "J" "C" ddat "5" "0" namect "")
 (setq d11 (list (nth 0 d12) 40))
 (setq d14 (list (nth 0 d13) 40))
 (command "_.LINE" d11 d14 "")


 (setq d11 nil d12 nil d13 nil d14 nil ghmn nil ghd nil d1 nil d3 nil so_ptu nil) 
 (setq filename nil dthh nil dtss nil dtsnv nil list_midpoint nil cd nil)
 (setq list_lt nil list_up nil dientich nil dientich1 nil dientich2 nil)
 (setq dientich3 nil list1 nil list2 nil t1 nil t2 nil t3 nil mdtrong nil n2 nil)
 (setq t4 nil cd1 nil dc2 nil i nil j nil cdss nil list_snv nil  mdngoai nil)
 (setq pt1 nil pt2 nil pt3 nil pt4 nil bdd1 nil bdd2 nil bdd4 nil tlx nil tln nil bdd5 nil bdd6 nil)
 (setq pt11 nil pt21 nil pt31 nil pt41 nil list_tn nil so_buoc nil)
 (setq cdtn nil kcltn nil kccdtn nil cdsnv nil kclsnv nil kccdsnv nil)
 (setq mt nil dtrong nil mn nil dngoai nil cdd nil cdday nil ssd nil deta_X nil)
 (setq ssn nil deta_Y nil cdmax nil cdmax nil cdmin nil cdmin nil n1 nil)
 (setq point1 nil point2 nil moc1 nil moc2 nil ghmn nil ddat nil dc nil)
 (setq dientichthua1 nil dientichthua2 nil dientichdoira nil kiemtra nil)

 (setvar "BLIPMODE" 1)
 (setvar "LUPREC" 4)  
 (command "_.REGENALL") 
);;end
;;**************************************
;;END_FILE

Cal1.lsp

(defun C:CAL1 ()
(DRAW)
(CAL_AREA)
)

Draw.lsp

;;*******************************************
(defun mytext (diem st)
(command "TEXT" "J" "C" diem  "3.0" "0" st "")
(setq diem nil)
);;end defun viet chu ra man hinh
;;*******************************************
;;Chuong trinh ve
(defun DRAW ()
(READ_DATA)
(setvar "LUPREC" 4)
(setvar "TEXTFILL" 1)
(setvar "LUNITS" 2)
(setq st '("Cao ®é tù nhiªn (m)" "K/c lÎ tù nhiªn (m)" "K/c céng dån TN (m)"
	   "Cao ®é thiÕt kÕ (m)" "K/c lÎ thiÕt kÕ (m)"
	   "Cao ®é SNV (m)" "K/c lÎ SNV (m)" "K/c céng dån SNV (m)" ""))

(if (and (>= (last cdtn) cdd) (< (last kccdtn) mn) (> (last kccdtn) (- mn 20)))
(bao_loi ""
 (strcat "D÷ liÖu ch­a ®­îc n¹p gÇn ®Õn mÐp ngoµi."
		 "\nB¹n nªn n¹p thªm mét vµi cao ®é n÷a ®Ó vÏ!."))
)

(if (> n1 100)
(setq pt1 (list mt cdmax)) 
(setq pt1 (list (- mt (* (- cdmax cdd) n1)) cdmax))
)
(setq pt2 (list mt cdd))
(setq pt3 (list mn cdd))

(if (> n2 100)
(setq pt4 (list mn cdmax)) 
(setq pt4 (list (+ mn (* (- cdmax cdd) n2)) cdmax))
)

(command "LTSCALE" "10" "")
(cond
((<= (abs (- cdmax cdmin)) 15) (setq buoc 1))
((and (> (abs (- cdmax cdmin)) 15) (<= (abs (- cdmax cdmin)) 30)) (setq buoc 2))
((and (> (abs (- cdmax cdmin)) 30) (<= (abs (- cdmax cdmin)) 45)) (setq buoc 4))
((> (abs (- cdmax cdmin)) 45) (setq buoc 1))
)

(setvar "BLIPMODE" 0)
(command "LAYER" "M" "DRAW" "")
(command "COLOR" "WHITE" "")

 (setq pt11 (list (- (nth 0 pt1) ssn) (nth 1 pt1)))
 (setq pt41 (list (+ (nth 0 pt4) ssn) (nth 1 pt4)))

 (setq pt21 (list mt (- cdd ssd)))
 (setq pt31 (list mn (- cdd ssd)))

 (setq pt51 (list (- mt ssn) cdd))
 (setq pt61 (list (+ mn ssn) cdd))

(setq i 0 bdd1 nil bdd2 nil bdd3 nil bdd4 nil)
(setq so_buoc (- (length kccdtn) 1))

(repeat so_buoc
  (progn
 (setq pt5 (list (nth i kccdtn) (nth i cdtn)))
 (setq pt6 (list (nth (1+ i) kccdtn) (nth (1+ i) cdtn)))

 (setq dc1 (inters pt5 pt6 pt1 pt2))
 (setq dc2 (inters pt5 pt6 pt11 pt51))
 (setq dc3 (inters pt5 pt6 pt21 pt51))	

 (if (/= dc1 nil) (progn (setq pt1 dc1 bdd1 T)))	 	
 (if (/= dc2 nil) (progn (setq pt11 dc2 bdd2 T)))
 (if (/= dc3 nil) (progn (setq pt11 dc3 bdd5 T)))


 (setq dc1 (inters pt5 pt6 pt3 pt4))
 (setq dc2 (inters pt5 pt6 pt41 pt61))
 (setq dc3 (inters pt5 pt6 pt31 pt61))

 (if (/= dc1 nil) (progn (setq pt4 dc1 bdd3 T)))	 
 (if (/= dc2 nil) (progn (setq pt41 dc2 bdd4 T)))
 (if (/= dc3 nil) (progn (setq pt41 dc3 bdd6 T)))	
  )
  (setq i (1+ i))
)


(if (/= bdd5 nil)	
(progn
(setq pt11 pt51)	
)
)

(if (/= bdd6 nil)	
(progn
(setq pt41 pt61)
)
)


(if (and (= bdd1 nil) (= bdd5 nil))	
(setq pt1 pt2 pt11 pt21))

(if (and (= bdd6 nil) (= bdd3 nil))	
(setq pt4 pt3 pt41 pt31))

(if (and (= bdd2 nil) (/= bdd1 nil))
(setq pt11 (list (- (nth 0 pt1) ssn) (nth 1 pt1))) 
)

(if (and (= bdd4 nil) (/= bdd3 nil))
(setq pt41 (list (+ (nth 0 pt4) ssn) (nth 1 pt4)))
)

;;Dat diem so sanh de ve duong sai so sau nay
(setq diemss1 pt1 diemss2 pt4)

(setq mn1 (+ (nth 0 pt4) ssn))
(setq gt1 (last kccdtn))
(setq gt2 (last kccdsnv))
(setq gt (max gt1 gt2 mn mn1))

(setq tln (getreal "\nNhap vao ti le ngang cho ban ve (1 / 1.5 / 2 / ...):"))
(if (= tln nil)
(setq tln 1.5)
)

(setq ghmn (+ (* gt tln) 10))

(setq tlx (/ 10.0 buoc))
(setq gt1 nil gt2 nil mn1 nil gt nil)
(setq ddcd (- 0 cdmax))

;;Ve he toa do
(setq pt_up (fix cdmax) pt_dow (fix cdmin))
(if (= (equal pt_up cdmax) nil)
(progn (setq pt_up (+ pt_up 1) ddcd (- ddcd (- pt_up cdmax)))))
(if (= (equal pt_dow cdmin) nil) (setq pt_dow (- pt_dow 1)))
(command "COLOR" "GREEN" "")
(command "_.STYLE" "KC1" ".VnTime" "0" "1" "15" "N" "N" "")

(setq ddcd (* ddcd tlx))
(setq tdy 0)
(setq stt pt_up)
(while (<= pt_dow stt)

 (progn
 (setq diem1 (list -10 (* tdy 10)))
 (setq diem2 (list -9 (* tdy 10)))
 (setq startptext (list -20 (* tdy 10)))
 (setq stttext (strcat  (itoa stt) ".0"))
 (command "LINE" diem1 diem2 "")
 (command "TEXT" startptext "2.0" "0" stttext "") 
(if (= (rem tdy 2) 0)
	(progn
		(setq diem3 (list -10 (* (+ tdy 1) 10)))
		 	(setq diem4 (list -9 (* (+ tdy 1) 10)))
		(command "SOLID" diem1 diem2 diem3 diem4 "")	
	)
)
 )
 (setq tdy (1- tdy))
 (setq stt (- stt buoc))
)

(setq ghd (* tdy 10))
(setq diem1 (list -10 0))
(setq diem2 (list -10 (* (+ tdy 1) 10)))
(command "LINE" diem1 diem2 "")
(setq diem1 (list -9 0))
(setq diem2 (list -9 (* (+ tdy 1) 10)))
(command "LINE" diem1 diem2 "")

(setq stt nil tdy nil startptext nil stttext nil diem1 nil diem2 nil tdy1 nil)

;; Tinh toan va ve duong tu nhien

(setq list1 '())
(setq i 0)
(repeat (length cdtn)
 (progn
 (setq td (+ (* (nth i cdtn) tlx)  ddcd))
 (setq hd (* (nth i kccdtn) tln))
 (setq ptu (list hd td))	 
 (setq list1 (cons ptu list1))
 )
 (setq i (1+ i))
)

(setq list1 (reverse list1))
(setq ptu nil i nil td nil hd nil i nil)
(command "LINETYPE" "LOAD" "DASHED" "ACAD.LIN" "SET" "DASHED" "")
(command "COLOR" "RED" "")
(command "PLINE")	
(foreach n list1 (command n))
(command "")

(setq list1 '())
(setq i 0)
(repeat (length cdsnv)
 (progn
   (setq td (+ (* (nth i cdsnv) tlx) ddcd))
   (setq hd (* (nth i kccdsnv) tln))
   (setq ptu (list hd td)) 
   (setq list1 (cons ptu list1))
 )
 (setq i (1+ i))
)

(setq list1 (reverse list1))

(setq ptu nil i nil td nil hd nil)

(command "LINETYPE" "SET" "CONTINUOUS"  "")
(command "COLOR" "CYAN" "")
(command "PLINE" )	
(foreach n list1 (command n))
(command "")

(setq list1 nil)

;; Xem tai mt, mn giao diem voi duong tu nhien o dau

(setq i 0)
(setq so_buoc (- (length kccdtn) 1))
(setq list1 '())

(repeat so_buoc

  (progn
 (setq pt5 (list (nth i kccdtn) (nth i cdtn)))
 (setq pt6 (list (nth (1+ i) kccdtn) (nth (1+ i) cdtn)))

 (setq dc (inters pt5 pt6 pt2 pt3))

 (if (/= dc nil)
   (cond
	 ((or (and (> (nth 1 pt5) cdd) (< (nth 1 pt6) cdd))
		  (and (< (nth 1 pt5) cdd) (> (nth 1 pt6) cdd)))

		  (setq list1 (cons dc list1))
	 )

	 ((or (and (> (nth 1 pt5) cdd) (= (nth 1 pt6) cdd))
		  (and (= (nth 1 pt5) cdd) (> (nth 1 pt6) cdd)))

		  (setq list1 (cons dc list1))
	 )


	 ((if (and (> i 0) (< i (- so_buoc 1)))
		  (cond
			  ((and (= (equal (nth 1 pt6) cdd) T)
					(<= (nth (+ i 2) cdtn) cdd)
					(> (nth 1 pt5) cdd)
			   )
				 (setq list1 (cons dc list1))
			  )

			  ((and (= (equal (nth 1 pt5) cdd) T)
					(> (nth 1 pt6) cdd)
					(<= (nth (- i 1) cdtn) cdd))
				 (setq list1 (cons dc list1))
			  )

		  )

	  )
	 )	
   )
 )
  )  
  (setq i (1+ i))
)

(setq list1 (reverse list1))
(setq dc nil pt5 nil pt6 nil so_buoc nil i nil)
(setq pt1text pt1 pt4text pt4)

;;Ve duong thiet ke

(setq pt1 (list (* (nth 0 pt1) tln) (+ (* (nth 1 pt1) tlx) ddcd)))
(setq pt4 (list (* (nth 0 pt4) tln) (+ (* (nth 1 pt4) tlx) ddcd)))
(setq pt2 (list (* mt tln) (+ (* cdd tlx) ddcd)))
(setq pt3 (list (* mn tln) (+ (* cdd tlx) ddcd)))

 (command "LINETYPE" "SET" "CONTINUOUS" "")
 (command "COLOR" "MAGENTA" "")  
 (command "LINE" pt1 pt2 pt3 pt4 "")
 (command "COLOR" "RED" "")
 (command "LINE" (list (nth 0 pt1) ghd) pt1 "")
 (command "LINE" (list (nth 0 pt2) ghd) pt2 "")
 (command "LINE" (list (nth 0 pt3) ghd) pt3 "")
 (command "LINE" (list (nth 0 pt4) ghd) pt4 "")

 (command "COLOR" "GREEN" "")

 (command "LINE" (list (nth 0 pt1) (- ghd 32)) (list (nth 0 pt1) (- ghd 40)) "")
 (command "LINE" (list (nth 0 pt2) (- ghd 32)) (list (nth 0 pt2) (- ghd 40)) "")
 (command "LINE" (list (nth 0 pt3) (- ghd 32)) (list (nth 0 pt3) (- ghd 40)) "")
 (command "LINE" (list (nth 0 pt4) (- ghd 32)) (list (nth 0 pt4) (- ghd 40)) "")  

;; Ve duong sai so

(setq pt11 (list (* (nth 0 pt11) tln) (+ (* (nth 1 pt11) tlx) ddcd)))
(setq pt41 (list (* (nth 0 pt41) tln) (+ (* (nth 1 pt41) tlx) ddcd)))
(setq pt21 (list (* (nth 0 pt21) tln) (+ (* (nth 1 pt21) tlx) ddcd)))
(setq pt31 (list (* (nth 0 pt31) tln) (+ (* (nth 1 pt31) tlx) ddcd)))
(setq pt51 (list (* (nth 0 pt51) tln) (+ (* (nth 1 pt51) tlx) ddcd)))
(setq pt61 (list (* (nth 0 pt61) tln) (+ (* (nth 1 pt61) tlx) ddcd)))


(command "LINETYPE" "LOAD" "CENTER" "ACAD.LIN" "SET" "CENTER" "")
(command "COLOR" "WHITE" "")

(setq sd (length list1))
(cond
 ( (= sd 0)
 (if (and (= bdd4 T) (= bdd1 T))
 (command "LINE" pt11 pt51 pt21 pt31 pt61 pt41 ""))
 )

 ( (/= sd 0)
(progn
(setq list2 '())
(setq i 0)		
(repeat sd
	  (progn
			 (setq dc (list (nth 0 (nth i list1)) (- cdd ssd)))
			 (setq list2 (cons dc list2))

	  )
	  (setq i (1+ i))
)

(setq list2 (reverse list2))


(cond
  ((= (rem sd 2) 0)
   (progn 

	(setq t1 (list (* (nth 0 (car list2)) tln) (+ (* (nth 1 (car list2)) tlx) ddcd)))
	(setq t2 (list (* (nth 0 (last list2)) tln) (+ (* (nth 1 (last list2)) tlx) ddcd)))
	(setq t3 (list (* (+ (nth 0 (car list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (car list1)) (/ ssd 2)) tlx) ddcd)))
	(setq t4 (list (* (- (nth 0 (last list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (last list1)) (/ ssd 2)) tlx) ddcd)))

	(if (and (/= bdd3 nil) (> (nth 1 diemss2) cdd)) (command "LINE" pt41 pt61 pt31 t2 t4 ""))

	(if (and (/= bdd1 nil) (> (nth 1 diemss1) cdd)) (command "LINE" pt11 pt51 pt21 t1 t3 ""))

	(if (and (/= bdd1 nil) (> (length list1) 2))
		(progn
		   (setq i 1)
		   (repeat (/ (- sd 2) 2)
			(progn
			 (setq t1 (list (* (- (nth 0 (nth i list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (nth i list1)) (/ ssd 2)) tlx) ddcd)))
			 (setq t2 (list (* (nth 0 (nth i list2)) tln) (+ (* (nth 1 (nth i list2)) tlx) ddcd)))
			 (setq t3 (list (* (nth 0 (nth (1+ i) list2)) tln) (+ (* (nth 1 (nth (1+ i) list2)) tlx) ddcd)))
			 (setq t4 (list (* (+ (nth 0 (nth (1+ i) list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (nth (1+ i) list1)) (/ ssd 2)) tlx) ddcd)))
			 (command "LINE" t1 t2 t3 t4 "")
			)
			(setq i (+ i 2))
		   )
		)
	)	

	(if (and (= bdd1 nil) (>= (length list1) 2))
		(progn
		   (setq i 0)
		   (repeat (/ sd 2)
			(progn
			 (setq t1 (list (* (- (nth 0 (nth i list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (nth i list1)) (/ ssd 2)) tlx) ddcd)))
			 (setq t2 (list (* (nth 0 (nth i list2)) tln) (+ (* (nth 1 (nth i list2)) tlx) ddcd)))
			 (setq t3 (list (* (nth 0 (nth (1+ i) list2)) tln) (+ (* (nth 1 (nth (1+ i) list2)) tlx) ddcd)))
			 (setq t4 (list (* (+ (nth 0 (nth (1+ i) list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (nth (1+ i) list1)) (/ ssd 2)) tlx) ddcd)))
			 (command "LINE" t1 t2 t3 t4 "")
			)
			(setq i (+ i 2))
		   )
		)
	)	 

  ))

  ((= (rem sd 2) 1)
   (progn

	   (setq t1 (list (* (nth 0 (car list2)) tln) (+ (* (nth 1 (car list2)) tlx) ddcd)))
	   (setq t2 (list (* (+ (nth 0 (car list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (car list1)) (/ ssd 2)) tlx) ddcd)))

	   (if (and (/= bdd1 nil) (> (nth 1 diemss1) cdd)) (command "LINE" pt11 pt51 pt21 t1 t2 ""))

	   (setq t1 (list (* (- (nth 0 (last list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (last list1)) (/ ssd 2)) tlx) ddcd)))
	   (setq t2 (list (* (nth 0 (last list2)) tln) (+ (* (nth 1 (last list2)) tlx) ddcd)))		   

	   (if (and (/= bdd3 nil) (> (nth 1 diemss2) cdd)) (command "LINE" t1 t2 pt31 pt61 pt41 ""))

	   (if (and (/= bdd1 nil) (> (length list1) 1))
		 (progn
		   (setq i 1)
		   (repeat (/ (- sd 1) 2)
			(progn
			 (setq t1 (list (* (- (nth 0 (nth i list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (nth i list1)) (/ ssd 2)) tlx) ddcd)))
			 (setq t2 (list (* (nth 0 (nth i list2)) tln) (+ (* (nth 1 (nth i list2)) tlx) ddcd)))
			 (setq t3 (list (* (nth 0 (nth (1+ i) list2)) tln) (+ (* (nth 1 (nth (1+ i) list2)) tlx) ddcd)))
			 (setq t4 (list (* (+ (nth 0 (nth (1+ i) list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (nth (1+ i) list1)) (/ ssd 2)) tlx) ddcd)))
			 (command "LINE" t1 t2 t3 t4 "")
			)
			(setq i (+ i 2))
		   )
		 )
	   )

	   (if (and (= bdd1 nil) (> (length list1) 2))
		 (progn
		   (setq i 0)
		   (repeat (/ (- sd 1) 2)
			(progn
			 (setq t1 (list (* (- (nth 0 (nth i list1)) ssn) tln) (+ (* (nth 1 (nth i list1)) tlx) ddcd)))
			 (setq t2 (list (* (nth 0 (nth i list2)) tln) (+ (* (nth 1 (nth i list2)) tlx) ddcd)))
			 (setq t3 (list (* (nth 0 (nth (1+ i) list2)) tln) (+ (* (nth 1 (nth (1+ i) list2)) tlx) ddcd)))
			 (setq t4 (list (* (+ (nth 0 (nth (1+ i) list1)) ssn) tln) (+ (* (nth 1 (nth (1+ i) list1)) tlx) ddcd)))
			 (command "LINE" t1 t2 t3 t4 "")
			)
			(setq i (+ i 2))
		   )
		 )
	   )

   )
  )	   
)
)  
 )
)

(command "LINETYPE" "SET" "DASHED" "")
(command "COLOR" "RED" "")

(if (and (= bdd4 nil) (/= bdd3 nil)) (command "LINE" pt4 pt41 ""))

(setq pt11 nil pt31 nil pt21 nil pt41 nill t1 nil t2 nil t3 nil t4 nil)
(setq bdd1 nil bdd2 nil bdd3 nil bdd4 nil list1 nil list2 nil diemss1 nil diemss2 nil)
(setq dc1 nil dc2 nil p1 nil p2 nil ptt1 nil ptt2 nil so_buoc nil)

(command "LINETYPE" "SET" "CONTINUOUS" "")
(command "COLOR" "GREEN" "")
(command "_.STYLE" "KC1" ".VnTime" "0" "1" "15" "N" "N" "")

;;ve duong dong cua duong tu nhien va duong phan cach khoang cach le duong tu nhien
(setvar "LUPREC" 1)
(setvar "LUNITS" 2)
(setq i 0)
(repeat (length cdtn)
 (progn
  (setq td1 (+ (* (nth i cdtn) tlx) ddcd))
  (setq hd1 (* (nth i kccdtn) tln))
  (setq d1 (list hd1 td1))   

  (setq d2 (list hd1 ghd))
  (setq starttext (list hd1 (- ghd 6)))
  (command "LINE" d1 d2 "")
  (mytext starttext (rtos (nth i cdtn)))

  (setq d1 (list hd1 (- ghd 8)))
  (setq d2 (list hd1 (- ghd 16)))
  (setq starttext (list hd1 (- ghd 22)))
  (command "LINE" d1 d2 "")
  (mytext starttext (rtos (nth i kccdtn)))
  (if (> i 0)
  (progn
	(setq hd (+ (nth i kccdtn) (nth (- i 1) kccdtn)))
	(setq hd (* (/ hd 2.0) tln))   
	(setq starttext (list hd (- ghd 14)))
	(mytext starttext (rtos (nth i kcltn)))
  ))
 )

 (setq i (1+ i))
)

(setq td1 nil hd1 nil d1 nil d2 nil starttext nil i nil)
(setq text1 (rtos (nth 1 pt1text)))
(mytext (list (nth 0 pt1) (- ghd 30)) text1)
(mytext (list (nth 0 pt2) (- ghd 30)) cdday)
(mytext (list (nth 0 pt3) (- ghd 30)) cdday)
(setq text1 (rtos (nth 1 pt4text)))
(mytext (list (nth 0 pt4) (- ghd 30)) text1)
(setq text1 nil l nil)


(setq hd1 (/ (+ (nth 0 pt2) (nth 0 pt1)) 2.0))
(setq text (rtos (- mt (nth 0 pt1text))))
(mytext (list hd1 (- ghd 38)) text)
(setq hd1 (/ (+ (nth 0 pt3) (nth 0 pt2)) 2.0))
(setq text (rtos (- mn mt)))
(mytext (list hd1 (- ghd 38)) text)
(setq hd1 (/ (+ (nth 0 pt4) (nth 0 pt3)) 2.0))
(setq text (rtos (- (nth 0 pt4text) mn)))
(mytext (list hd1 (- ghd 38)) text)			 
(setq pt1text nil pt4text nil)

;;ve duong dong cua duong sau nao vet va duong phan cach khoang cach le snv

(setq i 0)
(repeat (length cdsnv)

(progn
  (setq td1 (+ (* (nth i cdsnv) tlx) ddcd))
  (setq hd1 (* (nth i kccdsnv) tln))
  (setq d1 (list hd1 td1))   

  (setq d2 (list hd1 ghd))
  (setq starttext (list hd1 (- ghd 46)))
  (command "LINETYPE" "SET" "DASHED" "")
  (command "COLOR" "8" "")
  (command "LINE" d1 d2 "")
  (command "LINETYPE" "SET" "CONTINUOUS" "")
  (command "COLOR" "GREEN" "")
  (mytext starttext (rtos (nth i cdsnv)))

  (setq d1 (list hd1 (- ghd 48)))
  (setq d2 (list hd1 (- ghd 56)))
  (setq starttext (list hd1 (- ghd 62)))
  (command "LINE" d1 d2 "")
  (mytext starttext (rtos (nth i kccdsnv)))
(if (> i 0)
 (progn
	(setq hd (+ (nth i kccdsnv) (nth (- i 1) kccdsnv)))
	(setq hd (* (/ hd 2.0) tln))
	(setq starttext (list hd (- ghd 54)))
	(mytext starttext (rtos (nth i kclsnv)))
 )
)									
)
 (setq i (1+ i))
)

(setq td1 nil hd1 nil d1 nil d2 nil starttext nil i nil)

;;Viet chu trong khung
(setq tdy ghd)
(setq i 0)
(repeat 9
(progn 
	(setq tdytext (- tdy 6.0))
	(setq diem1 (strcat "-75," (rtos tdy)))
	(setq diem2 (strcat (rtos ghmn) "," (rtos tdy)))
	(setq startptext (strcat "-70," (rtos tdytext)))
	(command "LINE" diem1 diem2 "")
	(command "TEXT" startptext "3.0" "0" (nth i st) "")
)
	(setq tdy (- tdy 8))
	(setq i (1+ i))
)

(setq diem1 (strcat "-75," (rtos ghd)))
(setq diem2 (strcat "-75," (rtos (- ghd 64))))
(command "LINE" diem1 diem2 "")

(setq diem1 (strcat "-9," (rtos ghd)))
(setq diem2 (strcat "-9," (rtos (- ghd 64))))
(command "LINE" diem1 diem2"")

(setq diem1 (strcat (rtos ghmn) "," (rtos ghd)))
(setq diem2 (strcat (rtos ghmn) "," (rtos (- ghd 64))))
(command "LINE" diem1 diem2 "")

(setq ddat (list (/ ghmn 2) 20))
(command "_.STYLE" "KC2" ".VnTimeH" "0" "1" "15" "N" "N" "")
(command "TEXT"  "J" "C" ddat "3" "0" (strcat "MÆt c¾t: " SHBV) "")
(command "_.STYLE" "KC1" ".VnTime" "0" "1" "15" "N" "N" "")
(setq i nil tdy nil diem1 nil diem2 nil tdytext nil startptext nil ddcd nil)

)
;;*******************************
;;END_FILE

error.lsp

//Ham bao loi ban dau khi tim file chuong trinh
(defun bao_loi (file_ct msg)
 (defun *error* (s)
 (if old_error (setq *error* old_error)) (princ))
 (if msg (alert (strcat " Ch­¬ng tr×nh bÞ lçi ! " File_ct "\n\n" msg " \n")))
 (setq filename nil)
 (exit)  
);;end defun
//****************************

và Read.lsp

*****************************************************************************
(defun Read_data (/ fo)
(setvar "LUNITS" 2)
(setvar "LUPREC" 2)
(if (= filename nil) (setq filename (getfiled "Open Data" "C:/NAOVET/" "TXT" 8)))
(if (/= filename nil)
(progn
(setq cdtn '() kcltn '() kccdtn '() cdsnv '() kclsnv '() kccdsnv'())
(setq sodong 0)
(setq fo (open filename "r"))	
(if fo
	(progn
	(while (and (setq st (read-line fo)) (/= st ""))						
	(setq sodong (1+ sodong))
	(cond
		   ((= sodong 1) (setq namect st))
		   ((= sodong 2) (setq shbv st))			   		   
	   ((= sodong 3) (setq mt (distof st)))	
	   ((= sodong 4) (setq mn (distof st)))
	   ((= sodong 5) (setq cdd (distof st)))	
	   ((= sodong 6) (setq n1 (distof st)))
	   ((= sodong 7) (setq n2 (distof st)))
	   ((= sodong 8) (setq cdmax (distof st)))
	   ((= sodong 9) (setq cdmin (distof st)))
	   ((= sodong 10) (setq ssd (distof st)))	
	   ((= sodong 11) (setq ssn (distof st)))
	   ((>= sodong 12) 
		(progn
			(setq d (strlen st))				
			(setq dem 0)	
			(setq vitri '())	
			(repeat d
			(setq dem (1+ dem))
			(setq s (substr st dem 1))				
			(if (= s "\t")
				(setq vitri (cons dem vitri))						
			)
			)		
			(setq vitri (reverse vitri))
			(setq cdtn (cons (distof (substr st 1 (nth 0 vitri)) 2) cdtn))	
			(setq kcltn (cons (distof (substr st (nth 0 vitri) (- (nth 1 vitri) (nth 0 vitri))) 2) kcltn))					
			(setq kccdtn (cons (distof (substr st (nth 1 vitri) (- (nth 2 vitri) (nth 1 vitri))) 2) kccdtn))
			(setq cdsnv (cons (distof (substr st (nth 2 vitri) (- (nth 3 vitri) (nth 2 vitri))) 2) cdsnv))
			(setq kclsnv (cons (distof (substr st (nth 3 vitri) (- (nth 4 vitri) (nth 3 vitri))) 2) kclsnv))	
			(setq kccdsnv (cons (distof (substr st (nth 4 vitri)) 2) kccdsnv))	

		)
	   )

 	)	
			)
		)
	)

(close fo)
)

)
(setq cdtn (reverse cdtn))
(setq kcltn (reverse kcltn))
(setq kccdtn (reverse kccdtn))
(setq cdsnv (reverse cdsnv))
(setq kclsnv (reverse kclsnv))
(setq kccdsnv (reverse kccdsnv))
(setq d (strlen shbv))
(setq dem d)
(repeat d
(setq s (substr shbv dem 1))
(if (= s "\t") (setq shbv (substr shbv 1 (1- dem))))
(setq dem (1- dem))	
)
(setq dem nil s nil vitri nil fo nil sodong nil d nil st nil filename nil)
)
***********************************************************

với lệnh cal1 để nhập số liệu mặt cắt có dạng:

17.5					
44.5					
-1.68					
5					
5					
2					
-6					
0					
0					
-0.16	0	0	-0.16	0	0
-0.77	2.5	2.5	-0.77	2.5	2.5
-1.38	2.5	5	-1.55	2.5	5
-1.94	2.5	7.5	-1.80	2.5	7.5
-2.31	2.5	10	-2.05	2.5	10
-2.67	2.5	12.5	-2.30	2.5	12.5
-3.04	2.5	15	-2.55	2.5	15
-3.41	2.5	17.5	-2.80	2.5	17.5
-3.77	2.5	20	-3.05	2.5	20
-4.14	2.5	22.5	-3.10	2.5	22.5
-4.38	2.5	25	-3.15	2.5	25
-4.01	2.5	27.5	-3.20	2.5	27.5
-3.58	2.5	30	-3.25	2.5	30
-3.16	2.5	32.5	-3.30	2.5	32.5
-2.74	2.5	35	-3.35	2.5	35
-2.32	2.5	37.5	-3.40	2.5	37.5
-2	2.5	40	-3.45	2.5	40
-1.57	2.5	42.5	-3.45	2.5	42.5
-1.12	2.5	45	-3.45	2.5	45
-0.65	2.5	47.5	-3.45	2.5	47.5
-0.31	2.5	50	-3.45	2.5	50
-0.01	2.5	52.5	-3.48	2.5	52.5
0.28	2.5	55	-3.50	2.5	55
0.56	2.5	57.5	0.56	2.5	57.5
0.84	2.5	60	0.84	2.5	60

Vấn đề em gặp phải là số liệu xuất ra phần thập phân làm tròn đến 1 chữ số sau dấu "." chứ không phải là 2 như em mong muốn (1.6 thay vì 1.56). Vậy rất mong các bác giỏi lisp chỉ bảo giúp em giải quyết vấn đề này với ạ. Em xin cảm ơn.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

mình cũng đã dùng cái lisp này để lên mặt cắt cho các công trình nạo vét ( nói chung là rất thuận tiện, nhanh chóng, dễ chỉnh sửa) vấn đề của bạn nêu ở trên đây thực ra trước đây mình cũng không để ý lắm vì sai số nạo vét chỉ lấy đến đềcimét là cùng. Nhưng mới đây mình đang làm 1 cái dự án nạo vét "hơi chuối" vì cao độ thiết kế lẻ -2.28 hic hic! thế nên khi lên mặt cắt cũng bị làm tròn giống bạn ở trên đây mà ko biết cách nào khắc phục. Các bác cao thủ xem thế nào giúp một tay với!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Trước giờ em vẫn load các lisp sau để tính khối lượng nạo vét:

Area.lsp

Vấn đề em gặp phải là số liệu xuất ra phần thập phân làm tròn đến 1 chữ số sau dấu "." chứ không phải là 2 như em mong muốn (1.6 thay vì 1.56). Vậy rất mong các bác giỏi lisp chỉ bảo giúp em giải quyết vấn đề này với ạ. Em xin cảm ơn.

 

Chào bạn fỉre_unicorn,

Cha mẹ ơi, cái lisp của bạn dài quá. Đọc muốn lồi con mắt luôn bạn ạ.

Vấn đề của bạn thực ra chỉ là do cái biến hệ thống luprec thôi. Nhưng tìm được nó muôn xỉu luôn. Trong lisp của bạn cái biến hệ thống này được đặt đi đặt lại nhiều lần, chắc người viết có ý của họ, mình chả dám can thiệp vào vì sợ nó sai đi cái mà người viết muốn bạn ạ.

Thú thực là mình chưa hiểu hết về cái lisp của bạn, nhưng chắc chắn cái kết quả của bạn chỉ hiển thị một số thập phân là do cái biến luprec này được đặt lại lần cuối cùng trước khi xuất kết quả là 1 bạn ạ.

Vậy nên nếu bạn muốn hiển thị là bao nhiêu chữ số thập phân thì bạn hãy sửa lại cái dòng code (setvar "luprec" 1) bạn nhé. Rất may là cái việc đặt biến luprec bằng 1 này chỉ có một lần duy nhất trước khi kết thúc chương trình nên bạn không sợ nhầm lẫn đâu. Còn các dòng code (setvar ....) khác trong chương trình bạn cứ mặc thây nó, đừng đụng vào kẻo lisp nó chạy ra kết quả không đúng là bỏ bu đấy.

Ví dụ: bạn muốn thể hiện hai chữ số thập phân trong kết quả thì bạn sửa dòng code đó thành (setvar "luprec" 2)

 

Chúc bạn như ý nhé.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Chào bạn fỉe_unicorn,

Cha mẹ ơi, cái lisp của bạn dài quá. Đọc muốn lồi con mắt luôn bạn ạ.

Vấn đề của bạn thực ra chỉ là do cái biến hệ thống luprec thôi. Nhưng tìm được nó muôn xỉu luôn. Trong lisp của bạn cái biến hệ thống này được đặt đi đặt lại nhiều lần, chắc người viết có ý của họ, mình chả dám can thiệp vào vì sợ nó sai đi cái mà người viết muốn bạn ạ.

Thú thực là mình chưa hiểu hết về cái lisp của bạn, nhưng chắc chắn cái kết quả của bạn chỉ hiển thị một số thập phân là do cái biến luprec này được đặt lại lần cuối cùng trước khi xuất kết quả là 1 bạn ạ.

Vậy nên nếu bạn muốn hiển thị là bao nhiêu chữ số thập phân thì bạn hãy sửa lại cái dòng code (setvar "luprec" 1) bạn nhé. Rất may là cái việc đặt biến luprec bằng 1 này chỉ có một lần duy nhất trước khi kết thúc chương trình nên bạn không sợ nhầm lẫn đâu. Còn các dòng code (setvar ....) khác trong chương trình bạn cứ mặc thây nó, đừng đụng vào kẻo lisp nó chạy ra kết quả không đúng là bỏ bu đấy.

Ví dụ: bạn muốn thể hiện hai chữ số thập phân trong kết quả thì bạn sửa dòng code đó thành (setvar "luprec" 2)

 

Chúc bạn như ý nhé.

Hú hú, đúng rồi anh ạ, em cảm ơn anh nhiều nhé.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Trước giờ em vẫn load các lisp sau để tính khối lượng nạo vét:

Chào bạn fire_unicorn, Lisp của bạn sưu tầm rất ư là dài dòng, như bạn thanhbinh nói, tôi đọc muốn tắt thở luôn.

Tuy nhiên, tôi cũng muốn học hỏi thêm, Mục đích của Lisp là tính khối lượng nạo vét. Bạn có thể cho mình biết bản vẽ trước và sau khi thực hiện Lisp được không?. Cái file dữ liệu của bạn là từ đâu ra?

Biết đâu, tôi sẽ giúp bạn tinh giản lại cái lisp này cho bạn và mọị người tham khảo

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Các bác có thể hướng dẫn anh em sử dụng lisp nạo vét này được không, em cung sắp phải làm nạo vét, san lấp mà không biết phải làm thế nào. Cám ơn bác nhiều lắm

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Chào bạn fỉre_unicorn,

Cha mẹ ơi, cái lisp của bạn dài quá. Đọc muốn lồi con mắt luôn bạn ạ.

Vấn đề của bạn thực ra chỉ là do cái biến hệ thống luprec thôi. Nhưng tìm được nó muôn xỉu luôn. Trong lisp của bạn cái biến hệ thống này được đặt đi đặt lại nhiều lần, chắc người viết có ý của họ, mình chả dám can thiệp vào vì sợ nó sai đi cái mà người viết muốn bạn ạ.

Thú thực là mình chưa hiểu hết về cái lisp của bạn, nhưng chắc chắn cái kết quả của bạn chỉ hiển thị một số thập phân là do cái biến luprec này được đặt lại lần cuối cùng trước khi xuất kết quả là 1 bạn ạ.

Vậy nên nếu bạn muốn hiển thị là bao nhiêu chữ số thập phân thì bạn hãy sửa lại cái dòng code (setvar "luprec" 1) bạn nhé. Rất may là cái việc đặt biến luprec bằng 1 này chỉ có một lần duy nhất trước khi kết thúc chương trình nên bạn không sợ nhầm lẫn đâu. Còn các dòng code (setvar ....) khác trong chương trình bạn cứ mặc thây nó, đừng đụng vào kẻo lisp nó chạy ra kết quả không đúng là bỏ bu đấy.

Ví dụ: bạn muốn thể hiện hai chữ số thập phân trong kết quả thì bạn sửa dòng code đó thành (setvar "luprec" 2)

 

Chúc bạn như ý nhé.

 

Anh có thể hướng dẫn em cách dùng nó để tính nạo vét và cho ra mặt cắt đó được không ạ , xin cám ơn anh trước ạ!!!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Chào các Bác ! Em cũng đang chuẩn bị làm nạo vét và san lấp. Mong các Bác hướng dẫn thật chi tiết cách sử dụng lisp này. Cám ơn các Bác nhiều.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Trước giờ em vẫn load các lisp sau để tính khối lượng nạo vét:

Area.lsp

;;*****************************************
;;*****************************************
(defun Tinh_dt (list_pt p1 p2 p3 p4 mep_ngang / diem1 diem2 d1 d2 bl kt i)
(progn
(setq dientich nil)
(setq bl (- (length list_pt) 1))
(setq d1 (list (nth 0 p2) cdmax))
(setq d2 (list (nth 0 p2) cdmin))
(setq d3 (list (nth 0 p3) cdmax))
(setq d4 (list (nth 0 p3) cdmin))

(setq i 0 dc1 nil dc2 nil diem1 nil diem2 nil)
(repeat bl
(progn
  (setq dc1 (inters d1 d2 (nth i list_pt) (nth (1+ i) list_pt)))
  (setq dc2 (inters d3 d4 (nth i list_pt) (nth (1+ i) list_pt)))
  (if (/= dc1 nil) (setq diem1 dc1))
  (if (/= dc2 nil) (setq diem2 dc2))
)
(setq i (1+ i))
)

(setq dc1 nil dc2 nil dk1 nil)

(setq list_dc '());; khai bao list diem cat
(setq i 0 h 0 dc nil)

(repeat bl
    (progn   
    (setq dc (inters (nth i list_pt) (nth (1+ i) list_pt) p1 p2))
    (if (/= dc nil) (progn (setq list_dc (cons dc list_dc) dk1 1 h (1+ h))))
    )
    (setq i (1+ i))
)


(setq i 0 dc nil)
(repeat bl  
    (progn   
    (setq dc (inters (nth i list_pt) (nth (1+ i) list_pt) p2 p3))	   
    (if (/= dc nil) (setq list_dc (cons dc list_dc)))
    )
    (setq i (1+ i))
)

(setq i 0 k 0 dc nil dk2 nil)
(repeat bl  
    (progn
    (setq dc (inters (nth i list_pt) (nth (1+ i) list_pt) p3 p4))
     (if (/= dc nil)
	     (progn
		     (setq list_dc (cons dc list_dc))
		     (setq dk2 1)
		     (setq k (1+ k))			     
	     )
     )
    )
    (setq i (1+ i))
)								       


(setq dc nil)

(if (and (= k 1) (< (nth 1 diem2) mep_ngang))
  (setq list_dc (cdr list_dc))
)


(setq list_dc (reverse list_dc))

(if (and (= h 1) (< (nth 1 diem1) mep_ngang))
  (setq list_dc (cdr list_dc))
)

(if (and (/= dk1 nil) (> h 1))
 (progn
    (setq listt1 '())     
    (setq so1 (car list_dc))
    (setq list_dc (cdr list_dc))
    (setq so2 (car list_dc))
    (setq list_dc (cdr list_dc))
    (setq kt T i 0)
    (setq listt1 (cons so1 listt1))
(while kt
(progn	     
     (setq p (nth i list_pt))
     (if (<= (nth 1 p) (nth 1 so2)) (setq kt nil))
     (if (and (> (nth 0 p) (nth 0 so1)) (> (nth 1 p) (nth 1 so2)))
	(setq listt1 (cons p listt1))
	     )		     
     (setq i (1+ i))
)
)
    (setq listt1 (cons so2 listt1))   
    (command "AREA")
    (foreach n listt1 (command n))
    (command "" "")
    (setq dt1 (getvar "AREA"))
 )
)


(if (and (/= dk2 nil) (> k 1))
 (progn
    (setq listt1 '())
    (setq list_dc (reverse list_dc))
    (setq list_pt (reverse list_pt))   
    (setq so1 (car list_dc))
    (setq list_dc (cdr list_dc))
    (setq so2 (car list_dc))
    (setq list_dc (cdr list_dc))
    (setq kt T i 0)
    (setq listt1 (cons so1 listt1))
(while kt
(progn	     
     (setq p (nth i list_pt))
     (if (<= (nth 1 p) (nth 1 so2)) (setq kt nil))
     (if (and (< (nth 0 p) (nth 0 so1)) (> (nth 1 p) (nth 1 so2)))
	(setq listt1 (cons p listt1))
	     )		     
     (setq i (1+ i))
)
)
    (setq listt1 (cons so2 listt1))   
    (command "AREA")
    (foreach n listt1 (command n))
    (command "" "")
    (setq dt2 (getvar "AREA"))

    (setq list_dc (reverse list_dc))
    (setq list_pt (reverse list_pt))

 )
)

(setq listt1 nil so1 nil so2 nil h nil k nil)

(setq list_dc (reverse list_dc))
(setq list_dc1 '())

(if (> (length list_dc) 0)
 (progn
(setq i 0)
(repeat (length list_dc)
(if (/= (nth i list_dc) nil)
		(setq list_dc1 (cons (nth i list_dc) list_dc1)))
(setq i (1+ i))
)
  )   
)


(setq list_dc list_dc1 list_dc1 nil)


(if (> (length list_dc) 1)
(progn
  (setq i 0)
  (setq list_up '())
  (repeat (- (length list_dc) 1)
  (progn
 	(setq ptu1 (nth i list_dc))
 	(setq ptu2 (nth (1+ i) list_dc))     
 	(if (/= ptu1 nil)
	(progn
	(setq list_up (cons ptu1 list_up))	   
      ;;(setq kt T)	   
(setq j 0)
	(repeat (length list_pt)
       (progn	     
	     (setq p5 (nth j list_pt))			              
	     (if (/= ptu2 nil)			     
	       (if (and (> (nth 0 p5) (nth 0 ptu1))
					(<= (nth 0 p5) (nth 0 ptu2))			   
					(>= (nth 1 p5) (nth 1 p2)))
					(setq list_up (cons p5 list_up))))					     
       )
       (setq j (1+ j))	     
	)	     
 	))
  (setq i (1+ i))
 ;;(setq kt T j 0)
  )
  )
(setq list_up (cons (last list_dc) list_up))
))


(setq ptu1 nil ptu2 nil i nil j nil)

(if (and (/= diem2 nil) (> (nth 1 diem2) mep_ngang) (= dk2 1))
 (setq list_up (cons p3 list_up)))


(if (and (/= diem1 nil) (> (nth 1 diem1) mep_ngang) (= dk1 1))
 (setq list_up (cons p2 list_up)))

(if (and (/= diem1 nil) (< (nth 1 diem1) mep_ngang))
 (setq list_up (cons p2 list_up)))

(setq list_up (reverse list_up))


(if (/= list_up nil)
(progn
(command "AREA")
(foreach n list_up (command n))
(command "" "")
(setq dientich (getvar "AREA"))
)
)
(if (= dientich nil) (setq dientich 0))
(if (/= dt1 nil) (setq dientich (+ dientich dt1)))
(if (/= dt2 nil) (setq dientich (+ dientich dt2)))

(setq p1 nil p2 nil p3 nil p4 nil p5 nil dc nil d nil so_dc nil d1 nil i nil)
(setq list_up nil list_dc nil bl nil dt1 nil dt2 nil)
)
);;end_tinh_dt
;;*******************************************
;;Tinh dien tich du ra giua cac mep + duong sai so voi duong tu nhien
(defun dientich_phu (list_diem d1 d2)
(setq b_lap (- (length list_diem) 1))
(setq i 0)
(setq dientich1 0)
(setq list_midpoint '())

(repeat b_lap
  (progn
 	(setq diem (nth i list_diem))  
 	(if (and (> (nth 0 diem) (nth 0 d1)) (< (nth 0 diem) (nth 0 d2)))
(setq list_midpoint (cons diem list_midpoint))
 	)	       
  )  
(setq i (1+ i))
)
(setq diem nil i nil b_lap nil)
(if (>= (length list_midpoint) 0)
    (progn
       (setq list_midpoint (reverse (cons d2 list_midpoint)))
       (setq list_midpoint (cons d1 list_midpoint))	     
       (command "AREA")
       (foreach n list_midpoint (command n))
       (command "" "")
       (setq dientich1 (getvar "AREA"))
    )
)
(setq list_midpoint nil)
);;end_fun
;;*******************************************
(defun ham1 (list_pt p11 p21 p31 p51 midpoint)
(setq lst '() dientich2 0 point1 nil)
(progn
  (setq i 0 dc1 nil)
  (repeat (- (length list_pt) 2)
    (setq dc1 (inters (nth i list_pt) (nth (1+ i) list_pt) p11 p51))			   
  (setq i (1+ i)))
  (if (/= dc1 nil) (setq point1 dc1))   

  (if (= point1 nil)								   
  (progn
  (setq i 0 kt T dc1 nil)
  (while kt  
  (progn   
 	(if (= i (- (length list_pt) 2)) (setq kt nil))   
 	(setq dc1 (inters (nth i list_pt) (nth (1+ i) list_pt) p21 p31))

 	(if (/= dc1 nil) (progn (setq point1 dc1) (setq kt nil)))	       
 	(setq i (1+ i))))

  )
  )

  (if (= point1 nil)								   
  (progn
  (setq i 0 kt T dc1 nil)
  (while kt  
  (progn   
 	(if (= i (- (length list_pt) 2)) (setq kt nil))   
 	(setq dc1 (inters (nth i list_pt) (nth (1+ i) list_pt) p51 p31))
 	(if (/= dc1 nil) (progn (setq point1 dc1) (setq kt nil)))	       
 	(setq i (1+ i))))
  )
  )


  (setq lst (cons p11 lst))  
  (setq lst (cons midpoint lst))
  (setq i 0)
  (repeat (- (length list_pt) 1)	       
      (if (and (> (nth 0 (nth i list_pt)) (nth 0 midpoint))
			(< (nth 0 (nth i list_pt)) (nth 0 point1)))
      (setq lst (cons (nth i list_pt) lst)))
(setq i (1+ i))
)
(setq lst (cons point1 lst))

(if (> (nth 0 point1) (nth 0 p21))  (setq lst (cons p21 lst)))  
(if (> (nth 0 point1) (nth 0 p51))  (setq lst (cons p51 lst)))  

(if (/= lst nil)
(progn
 	(command "AREA")
 	(foreach n lst (command n))
 	(command "" "")
 	(setq dientich2 (getvar "AREA")))
)
)

(setq lst nil i nil t nil midpoint nil point1 nil dc1 nil dc2 nil)
);;end_fun

;;********************************************
(defun ham2 (list_pt p41 p31 p21 p61 midpoint)
(setq lst '() dientich3 0)
(progn
  (setq i 0 dc nil)  
  (repeat (- (length list_pt) 2)	       
    (setq dc (inters (nth i list_pt) (nth (1+ i) list_pt) p61 p41))
    (if (and (/= dc nil) (> (nth 0 dc) (nth 0 p61))) (setq point2 dc))		     
  (setq i (1+ i))
  )

  (if (= point2 nil)
  (progn
 	(setq i 0 dc nil)
 	(repeat (- (length list_pt) 2)	     
 	(setq dc (inters (nth i list_pt) (nth (1+ i) list_pt) p21 p31))
	(if (/= dc nil) (setq point2 dc))		     
 	(setq i (1+ i))
 	)
  ))

  (if (= point2 nil)
  (progn
 	(setq i 0 dc nil)
 	(repeat (- (length list_pt) 2)	     
 	(setq dc (inters (nth i list_pt) (nth (1+ i) list_pt) p61 p31))
	(if (/= dc nil) (setq point2 dc))		     
 	(setq i (1+ i))
 	)
  ))


 (setq lst (cons point2 lst))
  (setq i 0)
  (repeat (- (length list_pt) 2)     
      (if (and (> (nth 0 (nth i list_pt)) (nth 0 point2))
			(< (nth 0 (nth i list_pt)) (nth 0 midpoint)))       
       (setq lst (cons (nth i list_pt) lst)))
  (setq i (1+ i))
  )  

  (setq lst (cons midpoint lst))
  (setq lst (cons p41 lst))  
  (if (> (nth 0 p61) (nth 0 point2) ) (setq lst (cons p61 lst)))
  (if (> (nth 0 p31) (nth 0 point2) ) (setq lst (cons p31 lst)))

    (if (/= lst nil)
    (progn

      (command "AREA")
      (foreach n lst (command n))
      (command "" "")
      (setq dientich3 (getvar "AREA")))
    )
)

(setq lst nil i nil t nil midpoint nil point2 nil dc1 nil dc2 nil)
);;end_fun
;;*******************************************
(defun DIEN_TICH ()
(setvar "LUNITS" 2)
(setvar "LUPREC" 2)
 (setq cdss (- cdd ssd))
 (setq pt1 (list (- mt (* (- cdmax cdd) n1)) cdmax))
 (setq pt2 (list mt cdd))
 (setq pt3 (list mn cdd))
 (setq pt4 (list (+ mn (* (- cdmax cdd) n2)) cdmax))

 (setq pt11 (list (- (nth 0 pt1) ssn) (nth 1 pt1)))
 (setq pt41 (list (+ (nth 0 pt4) ssn) (nth 1 pt4)))
 (setq pt51 (list (- mt ssn) cdd))
 (setq pt61 (list (+ mn ssn) cdd))
 (setq pt21 (list mt (- cdd ssd)))
 (setq pt31 (list mn (- cdd ssd)))
 (setq pt71 (inters pt11 pt51 pt31 pt21 nil))
 (setq pt81 (inters pt41 pt61 pt21 pt31 nil))

 (setq dientichthua1 (* (abs (- (nth 0 pt71) mt)) (/ ssd 2)))
 (setq dientichthua2 (* (abs (- (nth 0 pt81) mn)) (/ ssd 2)))


(if (< (nth 0 pt71) mt)
 	(setq dientichthua1 (- 0 dientichthua1)))
(if (> (nth 0 pt81) mn)
 	(setq dientichthua2 (- 0 dientichthua2)))

(setq dientichdoira (/ (* ssn ssd) 4))
;; Tim giao diem cua duong sau nao vet voi duong sai so du kien

(setq so_buoc (- (length kccdsnv) 1))
(setq i 0)
(repeat so_buoc
  (progn
    (setq pt5 (list (nth i kccdsnv) (nth i cdsnv)))
    (setq pt6 (list (nth (1+ i) kccdsnv) (nth (1+ i) cdsnv)))

    (setq dc1 (inters pt5 pt6 pt11 pt51 T))
    (setq dc2 (inters pt5 pt6 pt61 pt41 T))

    (if (/= dc1 nil) (setq diem_luu1 dc1))   
    (if (/= dc2 nil) (setq diem_luu2 dc2))
  )
  (setq i (1+ i))

)

;;Phan tim giao diem cat cua 2 mep voi duong tu nhien


(setq i 0 bdd1 nil bdd2 nil bdd3 nil bdd4 nil dc1 nil dc2 nil)
2(setq so_buoc (- (length kccdtn) 1))

(repeat so_buoc
  (progn
    (setq pt5 (list (nth i kccdtn) (nth i cdtn)))
    (setq pt6 (list (nth (1+ i) kccdtn) (nth (1+ i) cdtn)))

    (setq dc1 (inters pt5 pt6 pt1 pt2 T))
    (setq dc2 (inters pt5 pt6 pt11 pt51 T))
    (setq dc3 (inters pt5 pt6 pt21 pt51 T))   

    (if (/= dc1 nil) (progn (setq pt1 dc1 bdd1 T)))
    (if (/= dc2 nil) (progn (setq pt11 dc2 bdd2 T)))
    (if (/= dc3 nil) (progn (setq pt11 dc3 bdd5 T)))

    (setq dc1 (inters pt5 pt6 pt3 pt4 T))
    (setq dc2 (inters pt5 pt6 pt61 pt41 T))
    (setq dc3 (inters pt5 pt6 pt31 pt61 T))

    (if (/= dc1 nil) (progn (setq pt4 dc1 bdd3 T)))
    (if (/= dc2 nil) (progn (setq pt41 dc2 bdd4 T)))
    (if (/= dc3 nil) (progn (setq pt11 dc3 bdd6 T)))
  )
  (setq i (1+ i))
)

(setq dc1 nil dc2 nil i 0 bdd7 nil bdd8 nil)
(repeat so_buoc
  (progn
    (setq pt5 (list (nth i kccdsnv) (nth i cdsnv)))
    (setq pt6 (list (nth (1+ i) kccdsnv) (nth (1+ i) cdsnv)))

    (setq dc1 (inters pt5 pt6 pt11 pt51 T))
    (setq dc2 (inters pt5 pt6 pt41 pt61 T))


    (if (/= dc1 nil) (setq bdd7 T))
    (if (/= dc2 nil) (setq bdd8 T))
  )
  (setq i (1+ i))
)


(if (/= bdd5 nil)   
(progn
(setq pt11 pt51)   
)
)

(if (/= bdd6 nil)   
(progn
(setq pt41 pt61)
)
)

(if (and (= bdd2 nil) (= bdd5 nil) (/= bdd1 nil))
(setq pt11 (list (- (nth 0 pt1) ssn) (nth 1 pt1)))					     
)

(if (and (= bdd4 nil) (= bdd6 nil) (/= bdd3 nil))
(setq pt41 (list (+ (nth 0 pt4) ssn) (nth 1 pt4)))     
)


;;kiem tra xem duong sau nao vet co cat duong tu nhien o giua cua pt1 va pt11 khong?

(setq i 0 pt11_luu nil pt5 nil pt6 nil kt T dc nil)

(while kt
(progn
     (setq pt5 (list (nth i kccdsnv) (nth i cdsnv)))
     (setq pt6 (list (nth (1+ i) kccdsnv) (nth (1+ i) cdsnv)))     
     (setq dc (inters pt5 pt6 pt11 pt1 T))
     (if (/= dc nil) (setq pt11_luu dc))   
     (if (or (/= dc nil) (> (nth i kccdsnv) (nth 0 pt2))) (setq kt nil))
     (setq i (1+ i))
)
)


;;kiem tra xem duongn sau nao vet co cat duong tu nhien o giua cua pt4 va pt41 khong?

(setq i 0 pt41_luu nil pt5 nil pt6 nil dc nil kt T)
(setq kccdsnv (reverse kccdsnv))
(setq cdsnv (reverse cdsnv))

(while kt
(progn
     (setq pt5 (list (nth i kccdsnv) (nth i cdsnv)))
     (setq pt6 (list (nth (1+ i) kccdsnv) (nth (1+ i) cdsnv)))     
     (setq dc (inters pt5 pt6 pt4 pt41 T))	     
     (if (/= dc nil) (setq pt41_luu dc))   
     (if (or (/= dc nil) (< (nth i kccdsnv) (nth 0 pt3))) (setq kt nil))
     (setq i (1+ i))
)
)



(setq kccdsnv (reverse kccdsnv))
(setq cdsnv (reverse cdsnv))
(setq dc nil)

;;Giao diem voi day thiet ke

(setq i 0)
(setq so_buoc (- (length kccdtn) 1))
(setq list1 '())

(repeat so_buoc

  (progn
    (setq pt5 (list (nth i kccdtn) (nth i cdtn)))
    (setq pt6 (list (nth (1+ i) kccdtn) (nth (1+ i) cdtn)))

    (setq dc (inters pt5 pt6 pt2 pt3 T))

    (if (/= dc nil)
      (cond
     ((or (and (> (nth 1 pt5) cdd) (< (nth 1 pt6) cdd))
	  	(and (< (nth 1 pt5) cdd) (> (nth 1 pt6) cdd)))
	  	(setq list1 (cons dc list1))
     )


     ((if (and (> i 0) (< i (- so_buoc 1)))
	  	(cond
		  	((and (= (equal (nth 1 pt6) cdd) T)
					(<= (nth (+ i 2) cdtn) cdd)
					(> (nth 1 pt5) cdd))
			     (setq list1 (cons dc list1))
		  	)

		  	((and (= (equal (nth 1 pt5) cdd) T)
					(> (nth 1 pt6) cdd)
					(<= (nth (- i 1) cdtn) cdd))
			     (setq list1 (cons dc list1))
		  	)
	  	)			     
  	)
     )   
      )
    )
  )
  (setq i (1+ i))
)

(setq dc nil pt5 nil pt6 nil)

(setq so_buoc (length kccdsnv) i 0)
(setq list_snv '() list_tn '())

(repeat so_buoc
(setq list_snv (cons (list (nth i kccdsnv) (nth i cdsnv)) list_snv))
(setq list_tn (cons (list (nth i kccdtn) (nth i cdtn)) list_tn))
(setq i (1+ i))
)

(setq list_snv (reverse list_snv))
(setq list_tn (reverse list_tn))

(setq bl (- (length list_tn) 1))
(setq d1 (list (nth 0 pt2) cdmax))
(setq d2 (list (nth 0 pt2) cdmin))
(setq d3 (list (nth 0 pt3) cdmax))
(setq d4 (list (nth 0 pt3) cdmin))

(setq i 0)
(repeat bl
(progn
  (setq dc1 (inters d1 d2 (nth i list_tn) (nth (1+ i) list_tn)))
  (setq dc2 (inters d3 d4 (nth i list_tn) (nth (1+ i) list_tn)))
  (if (/= dc1 nil) (setq moc1 dc1))
  (if (/= dc2 nil) (setq moc2 dc2))
)
(setq i (1+ i))
)

(setq i 0 kiemtra nil)

(repeat bl
  (progn
    (setq pt5 (list (nth i kccdsnv) (nth i cdsnv)))
    (setq pt6 (list (nth (1+ i) kccdsnv) (nth (1+ i) cdsnv)))

    (setq dc1 (inters pt5 pt6 pt11 pt51 T))
    (setq dc2 (inters pt5 pt6 pt21 pt51))   
    (setq dc3 (inters pt5 pt6 pt61 pt41 T))
    (setq dc4 (inters pt5 pt6 pt31 pt61))
    (setq dc5 (inters pt5 pt6 pt21 pt31 T))

    (if (or (/= dc1 nil) (/= dc2 nil) (/= dc3 nil) (/= dc4 nil) (/= dc5 nil))
  	(setq kiemtra T)
    )
  )
  (setq i (1+ i))
)

(setq dc1 nil dc2 nil d1 nil d2 nil d3 nil d4 nil bl nil)

;;phan tinh toan

(progn

(setq list1 (reverse list1))
(setq so_ptu (length list1))

(print list1)

(cond
 ( (= so_ptu 0)

 (if (and (= bdd1 T) (= bdd3 T))
 (progn
(setq list_lt '() kt T i 0)
(setq list_lt (cons pt1 list_lt))
(while kt
      (if (and (> (nth i kccdtn) (nth 0 pt1))
			(< (nth i kccdtn) (nth 0 pt4)))

      (setq list_lt (cons (list (nth i kccdtn) (nth i cdtn)) list_lt))
      )
      (setq i (1+ i))
      (if (> (nth i kccdtn) (nth 0 pt4)) (setq kt nil))       
)
(setq list_lt (cons pt4 list_lt))
(setq list_lt (reverse (cons pt2 (cons pt3 list_lt))))
(if (> (length list_lt) 2)
      (progn
  	(command "AREA")
  	(foreach n list_lt (command n))
  	(command "")   
  	(setq dthh (getvar "AREA"))
  	(command "AREA" pt1 pt2 pt3 pt4 pt41 pt61 pt31 pt21 pt51 pt11 "")
  	(setq dtss (getvar "AREA"))
      )
)

(dientich_phu list_tn pt11 pt1)
(setq dtss (+ dtss dientich1))

(dientich_phu list_tn pt4 pt41)
(setq dtss (+ dtss dientich1))

(if (= kiemtra T)		            
(progn   

	(if (/= pt11_luu nil)
	(progn
	(ham1 list_snv pt11 pt21 pt31 pt51 pt11_luu)
	(if (/= dientich2 nil) (setq dtsnv (+ dtsnv dientich2)))
	)
	)


	(if (/= pt41_luu nil)
	(progn
	(ham2 list_snv pt41 pt31 pt21 pt61 pt41_luu)
	(if (/= dientich3 nil) (setq dtsnv (+ dtsnv dientich3)))
	)
	)


	(if (/= pt11_luu nil) (setq pt11 pt71))   
	(if (/= pt41_luu nil) (setq pt41 pt81))
	(tinh_dt list_snv pt11 pt71 pt81 pt41 cdss)
	(setq dtsnv (+ dtsnv dientich))  

		(if (/= bdd7 nil) (setq dtsnv (+ dtsnv dientichthua1)))
	(if (/= bdd8 nil) (setq dtsnv (+ dtsnv dientichthua2)))   




))

 )))

 ( (/= so_ptu 0)	   

 (progn  
(TINH_DT list_tn pt1 pt2 pt3 pt4 cdd)
(setq dthh dientich)   

(setq list2 '())
(setq i 0)	   
(repeat so_ptu
  	(progn
		     (setq dc (list (nth 0 (nth i list1)) (- cdd ssd)))
		     (setq list2 (cons dc list2))

  	)
  	(setq i (1+ i))
)

(setq list2 (reverse list2))


(cond
 	((= (rem so_ptu 2) 0)
 	(progn

	(setq t1 (car list2) t2 (last list2))
	(setq t3 (car list1) t4 (last list1))

(if (and (/= bdd1 nil) (> (nth 1 moc1) cdd))
	(progn
	(setq t3 (list (+ (nth 0 t3) ssn) (nth 1 t3)))
	(command "AREA" pt11 pt51 pt21 t1 t3 pt2 pt1 "")
	(setq dtss (getvar "AREA"))
	(dientich_phu list_tn pt11 pt1)
	(setq dtss (+ dtss dientich1))       
(if (> dtss dientichdoira) (setq dtss (- dtss dientichdoira)))

(if (= kiemtra T)
(progn   
(if (/= pt11_luu nil)
(progn
	(ham1 list_snv pt11 pt21 pt31 pt51 pt11_luu)
	(if (/= dientich2 nil) (setq dtsnv (+ dtsnv dientich2)))
)
)


(if (= pt11_luu nil) (progn (tinh_dt list_snv pt11 pt71 t1 t3 cdss) (setq dtsnv (+ dtsnv dientich))))

	(if (/= bdd7 nil) (setq dtsnv (+ dtsnv dientichthua1)))	   
))

	(setq list1 (cdr list1))
(setq list2 (cdr list2))
	)
)

(if (and (/= bdd3 nil) (> (nth 1 moc2) cdd))     
	(progn
     (setq t4 (list (- (nth 0 t4) ssn) (nth 1 t4)))     
     (command "AREA" t4 t2 pt31 pt61 pt41 pt4 pt3 "")
     (setq dtss (+ dtss (getvar "AREA")))
     (dientich_phu list_tn pt4 pt41)
     (setq dtss (+ dtss dientich1))
    (if (> dtss dientichdoira) (setq dtss (- dtss dientichdoira)))

(if kiemtra
(progn   
(if (/= pt41_luu nil)
(progn
	(ham2 list_snv pt41 pt31 pt21 pt61 pt41_luu)
	(if (/= dientich3 nil) (setq dtsnv (+ dtsnv dientich3)))
)
)

(if (= pt41_luu nil) (progn (tinh_dt list_snv t4 t2 pt81 pt41 cdss) (setq dtsnv (+ dtsnv dientich))))

(if (/= bdd8 nil) (setq dtsnv (+ dtsnv dientichthua2)))
))

     (setq list1 ( reverse (cdr (reverse list1))))
    (setq list2 ( reverse (cdr (reverse list2))))
	)
)


(if (> (length list1) 1)
		(progn
	       (setq i 0)		       
	       (repeat (/ (length list1) 2)
			(progn
		     (setq t1 (nth i list1) t2 (nth i list2))
		     (setq t3 (nth (1+ i) list2) t4 (nth (1+ i) list1))
		     (setq t1 (list (- (nth 0 t1) ssn) (nth 1 t1)))
		     (setq t4 (list (+ (nth 0 t4) ssn) (nth 1 t4)))
		     (command "AREA" t1 t2 t3 t4 "")
		     (setq dtss (+ dtss (getvar "AREA")))
     (if (> dtss (* dientichdoira 2)) (setq dtss (- dtss (* dientichdoira 2))))
		     (tinh_dt list_snv t1 t2 t3 t4 cdss)
		     (setq dtsnv (+ dtsnv dientich))
			)
			(setq i (+ i 2))
	       )
		)
)


))

((= (rem so_ptu 2) 1)
(progn
	(if (/= bdd1 nil)
	(if (and (/= moc1 nil) (> (nth 1 moc1) cdd))
       (progn
       (setq t1 (car list2) t2 (car list1))
       (setq t2 (list (+ (nth 0 t2) ssn) (nth 1 t2)))
       (command "AREA" pt11 pt51 pt21 t1 t2 pt2 pt1 "")
       (setq dtss (getvar "AREA"))
       (dientich_phu list_tn pt11 pt1)
       (setq dtss (+ dtss dientich1))
      (if (> dtss dientichdoira) (setq dtss (- dtss dientichdoira)))   

      (if (= kiemtra T)
      (progn
       (if (/= pt11_luu nil)
      (progn
	(ham1 list_snv pt11 pt21 pt31 pt51 pt11_luu)
	(if (/= dientich2 nil) (setq dtsnv (+ dtsnv dientich2)))
      )
      )

      (if (= pt11_luu nil) (progn (tinh_dt list_snv pt11 pt71 t1 t2 cdss) (setq dtsnv (+ dtsnv dientich))))

      (if (/= bdd7 nil) (setq dtsnv (+ dtsnv dientichthua1)))   
       ))

      (setq list1 (cdr list1))
      (setq list2 (cdr list2))   
       )
	))

	(if (/= bdd3 nil)
	(if (and (/= moc2 nil) (> (nth 1 moc2) cdd))
       (progn
       (setq t1 (last list1) t2 (last list2))
       (setq t1 (list (- (nth 0 t1) ssn) (nth 1 t1)))
       (command "AREA" t1 t2 pt31 pt61 pt41 pt4 pt3 "")
       (setq dtss (getvar "AREA"))
       (dientich_phu list_tn pt4 pt41)
       (setq dtss (+ dtss dientich1))
      (if (> dtss dientichdoira) (setq dtss (- dtss dientichdoira)))

      (if (= kiemtra T)
      (progn   
      (if (/= pt41_luu nil)
      (progn
	(ham2 list_snv pt41 pt31 pt21 pt61 pt41_luu)
	(if (/= dientich3 nil) (setq dtsnv (+ dtsnv dientich3)))
      )
      )


      (if (= pt41_luu nil) (progn (tinh_dt list_snv t1 t2 pt81 pt41 cdss) (setq dtsnv (+ dtsnv dientich))))

      (if (/= bdd8 nil) (setq dtsnv (+ dtsnv dientichthua1)))
       ))

       (setq list1 ( reverse (cdr (reverse list1))))
      (setq list2 ( reverse (cdr (reverse list2))))
       )								       
	))							     

	(if (> (length list1) 0)
	     (progn
	       (setq i 0)						     
	       (repeat (/ (length list1) 2)
			(progn			     
		     (setq t1 (nth i list1) t2 (nth i list2))
		     (setq t1 (list (- (nth 0 t1) ssn) (nth 1 t1)))
		     (setq t3 (nth (1+ i) list2) t4 (nth (1+ i) list1))
		     (setq t4 (list (- (nth 0 t1) ssn) (nth 1 t4)))
		     (command "AREA" t1 t2 t3 t4 "")
		     (setq dtss (+ dtss (getvar "AREA")))			     
     (if (> dtss (* dientichdoira 2)) (setq dtss (- dtss (* dientichdoira 2))))

     (if kiemtra
     (progn
		     (tinh_dt list_snv t1 t2 t3 t4 cdss)
		     (setq dtsnv (+ dtsnv dientich))
     ))
			)
			(setq i (+ i 2))
	       )
	     )
	)       


))
  )  
  ))
)
)

(setq dtsnv (- dtss dtsnv))

)
;;************************************
(defun CAL_AREA ()
 (setq dthh 0 dtss 0 dtsnv 0)
 (dien_tich)
 (command "COLOR" "GREEN" "")
 (command "_.STYLE" "KC1" ".VnTimeI" "0" "1" "5" "N" "N" "")
 (setq ddat (list (/ ghmn 2) 15))
 (command "TEXT" "J" "C" ddat "2" "0" (strcat "Shh  = " (rtos dthh) " m2"))
 (setq ddat (list (/ ghmn 2) 12))
 (command "TEXT" "J" "C" ddat "2" "0" (strcat "Sss  = " (rtos dtss) " m2"))
 (setq ddat (list (/ ghmn 2) 9))
 (command "TEXT" "J" "C" ddat "2" "0" (strcat "Ssnv = " (rtos dtsnv) " m2"))
 (setq d11 (list -85 (- ghd 70)))
 (setq d12 (list -85 50))
 (setq d13 (list (+ ghmn 10) 50))   
 (setq d14 (list (+ ghmn 10) (- ghd 70)))   
 (command "_.LINE" d11 d12 d13 d14 d11 "")
 (setq d1 (list (- (nth 0 d11) 5) (- (nth 1 d11) 10)))
 (setq d3 (list (+ (nth 0 d13) 5) (+ (nth 1 d13) 5)))
 (command "ZOOM" "WINDOW" d1 d3 "")

 (setq d12 (list ( - (nth 0 d13) 30) 50))
 (setq d11 (list (nth 0 d12) 30))
 (setq d14 (list (nth 0 d13) 30))   
 (command "_.LINE" d11 d12 "")
 (command "_.LINE" d11 d14 "")
 (setq ddat (list ( - (nth 0 d13) 15) 43))
 (command "_.STYLE" "KC2" ".VnTimeH" "0" "1" "15" "N" "N" "")
 (command "TEXT"  "J" "C" ddat "5" "0" namect "")
 (setq d11 (list (nth 0 d12) 40))
 (setq d14 (list (nth 0 d13) 40))
 (command "_.LINE" d11 d14 "")


 (setq d11 nil d12 nil d13 nil d14 nil ghmn nil ghd nil d1 nil d3 nil so_ptu nil)
 (setq filename nil dthh nil dtss nil dtsnv nil list_midpoint nil cd nil)
 (setq list_lt nil list_up nil dientich nil dientich1 nil dientich2 nil)
 (setq dientich3 nil list1 nil list2 nil t1 nil t2 nil t3 nil mdtrong nil n2 nil)
 (setq t4 nil cd1 nil dc2 nil i nil j nil cdss nil list_snv nil  mdngoai nil)
 (setq pt1 nil pt2 nil pt3 nil pt4 nil bdd1 nil bdd2 nil bdd4 nil tlx nil tln nil bdd5 nil bdd6 nil)
 (setq pt11 nil pt21 nil pt31 nil pt41 nil list_tn nil so_buoc nil)
 (setq cdtn nil kcltn nil kccdtn nil cdsnv nil kclsnv nil kccdsnv nil)
 (setq mt nil dtrong nil mn nil dngoai nil cdd nil cdday nil ssd nil deta_X nil)
 (setq ssn nil deta_Y nil cdmax nil cdmax nil cdmin nil cdmin nil n1 nil)
 (setq point1 nil point2 nil moc1 nil moc2 nil ghmn nil ddat nil dc nil)
 (setq dientichthua1 nil dientichthua2 nil dientichdoira nil kiemtra nil)

 (setvar "BLIPMODE" 1)
 (setvar "LUPREC" 4)  
 (command "_.REGENALL")
);;end
;;**************************************
;;END_FILE

Cal1.lsp

(defun C:CAL1 ()
(DRAW)
(CAL_AREA)
)

Draw.lsp

;;*******************************************
(defun mytext (diem st)
(command "TEXT" "J" "C" diem  "3.0" "0" st "")
(setq diem nil)
);;end defun viet chu ra man hinh
;;*******************************************
;;Chuong trinh ve
(defun DRAW ()
(READ_DATA)
(setvar "LUPREC" 4)
(setvar "TEXTFILL" 1)
(setvar "LUNITS" 2)
(setq st '("Cao ®é tù nhiªn (m)" "K/c lÎ tù nhiªn (m)" "K/c céng dån TN (m)"
       "Cao ®é thiÕt kÕ (m)" "K/c lÎ thiÕt kÕ (m)"
       "Cao ®é SNV (m)" "K/c lÎ SNV (m)" "K/c céng dån SNV (m)" ""))

(if (and (>= (last cdtn) cdd) (< (last kccdtn) mn) (> (last kccdtn) (- mn 20)))
(bao_loi ""
    (strcat "D÷ liÖu ch­a ®­îc n¹p gÇn ®Õn mÐp ngoµi."
	     "\nB¹n nªn n¹p thªm mét vµi cao ®é n÷a ®Ó vÏ!."))
)

(if (> n1 100)
(setq pt1 (list mt cdmax))
(setq pt1 (list (- mt (* (- cdmax cdd) n1)) cdmax))
)
(setq pt2 (list mt cdd))
(setq pt3 (list mn cdd))

(if (> n2 100)
(setq pt4 (list mn cdmax))
(setq pt4 (list (+ mn (* (- cdmax cdd) n2)) cdmax))
)

(command "LTSCALE" "10" "")
(cond
((<= (abs (- cdmax cdmin)) 15) (setq buoc 1))
((and (> (abs (- cdmax cdmin)) 15) (<= (abs (- cdmax cdmin)) 30)) (setq buoc 2))
((and (> (abs (- cdmax cdmin)) 30) (<= (abs (- cdmax cdmin)) 45)) (setq buoc 4))
((> (abs (- cdmax cdmin)) 45) (setq buoc 1))
)

(setvar "BLIPMODE" 0)
(command "LAYER" "M" "DRAW" "")
(command "COLOR" "WHITE" "")

 (setq pt11 (list (- (nth 0 pt1) ssn) (nth 1 pt1)))
 (setq pt41 (list (+ (nth 0 pt4) ssn) (nth 1 pt4)))

 (setq pt21 (list mt (- cdd ssd)))
 (setq pt31 (list mn (- cdd ssd)))

 (setq pt51 (list (- mt ssn) cdd))
 (setq pt61 (list (+ mn ssn) cdd))

(setq i 0 bdd1 nil bdd2 nil bdd3 nil bdd4 nil)
(setq so_buoc (- (length kccdtn) 1))

(repeat so_buoc
  (progn
    (setq pt5 (list (nth i kccdtn) (nth i cdtn)))
    (setq pt6 (list (nth (1+ i) kccdtn) (nth (1+ i) cdtn)))

    (setq dc1 (inters pt5 pt6 pt1 pt2))
    (setq dc2 (inters pt5 pt6 pt11 pt51))
    (setq dc3 (inters pt5 pt6 pt21 pt51))   

    (if (/= dc1 nil) (progn (setq pt1 dc1 bdd1 T)))        
    (if (/= dc2 nil) (progn (setq pt11 dc2 bdd2 T)))
    (if (/= dc3 nil) (progn (setq pt11 dc3 bdd5 T)))


    (setq dc1 (inters pt5 pt6 pt3 pt4))
    (setq dc2 (inters pt5 pt6 pt41 pt61))
    (setq dc3 (inters pt5 pt6 pt31 pt61))

    (if (/= dc1 nil) (progn (setq pt4 dc1 bdd3 T)))     
    (if (/= dc2 nil) (progn (setq pt41 dc2 bdd4 T)))
    (if (/= dc3 nil) (progn (setq pt41 dc3 bdd6 T)))   
  )
  (setq i (1+ i))
)


(if (/= bdd5 nil)   
(progn
(setq pt11 pt51)   
)
)

(if (/= bdd6 nil)   
(progn
(setq pt41 pt61)
)
)


(if (and (= bdd1 nil) (= bdd5 nil))   
(setq pt1 pt2 pt11 pt21))

(if (and (= bdd6 nil) (= bdd3 nil))   
(setq pt4 pt3 pt41 pt31))

(if (and (= bdd2 nil) (/= bdd1 nil))
(setq pt11 (list (- (nth 0 pt1) ssn) (nth 1 pt1)))
)

(if (and (= bdd4 nil) (/= bdd3 nil))
(setq pt41 (list (+ (nth 0 pt4) ssn) (nth 1 pt4)))
)

;;Dat diem so sanh de ve duong sai so sau nay
(setq diemss1 pt1 diemss2 pt4)

(setq mn1 (+ (nth 0 pt4) ssn))
(setq gt1 (last kccdtn))
(setq gt2 (last kccdsnv))
(setq gt (max gt1 gt2 mn mn1))

(setq tln (getreal "\nNhap vao ti le ngang cho ban ve (1 / 1.5 / 2 / ...):"))
(if (= tln nil)
(setq tln 1.5)
)

(setq ghmn (+ (* gt tln) 10))

(setq tlx (/ 10.0 buoc))
(setq gt1 nil gt2 nil mn1 nil gt nil)
(setq ddcd (- 0 cdmax))

;;Ve he toa do
(setq pt_up (fix cdmax) pt_dow (fix cdmin))
(if (= (equal pt_up cdmax) nil)
(progn (setq pt_up (+ pt_up 1) ddcd (- ddcd (- pt_up cdmax)))))
(if (= (equal pt_dow cdmin) nil) (setq pt_dow (- pt_dow 1)))
(command "COLOR" "GREEN" "")
(command "_.STYLE" "KC1" ".VnTime" "0" "1" "15" "N" "N" "")

(setq ddcd (* ddcd tlx))
(setq tdy 0)
(setq stt pt_up)
(while (<= pt_dow stt)

 (progn
    (setq diem1 (list -10 (* tdy 10)))
    (setq diem2 (list -9 (* tdy 10)))
    (setq startptext (list -20 (* tdy 10)))
    (setq stttext (strcat  (itoa stt) ".0"))
    (command "LINE" diem1 diem2 "")
    (command "TEXT" startptext "2.0" "0" stttext "")
(if (= (rem tdy 2) 0)
	(progn
		(setq diem3 (list -10 (* (+ tdy 1) 10)))
	     	(setq diem4 (list -9 (* (+ tdy 1) 10)))
		(command "SOLID" diem1 diem2 diem3 diem4 "")   
	)
)
 )
 (setq tdy (1- tdy))
 (setq stt (- stt buoc))
)

(setq ghd (* tdy 10))
(setq diem1 (list -10 0))
(setq diem2 (list -10 (* (+ tdy 1) 10)))
(command "LINE" diem1 diem2 "")
(setq diem1 (list -9 0))
(setq diem2 (list -9 (* (+ tdy 1) 10)))
(command "LINE" diem1 diem2 "")

(setq stt nil tdy nil startptext nil stttext nil diem1 nil diem2 nil tdy1 nil)

;; Tinh toan va ve duong tu nhien

(setq list1 '())
(setq i 0)
(repeat (length cdtn)
 (progn
    (setq td (+ (* (nth i cdtn) tlx)  ddcd))
    (setq hd (* (nth i kccdtn) tln))
    (setq ptu (list hd td))     
    (setq list1 (cons ptu list1))
 )
 (setq i (1+ i))
)

(setq list1 (reverse list1))
(setq ptu nil i nil td nil hd nil i nil)
(command "LINETYPE" "LOAD" "DASHED" "ACAD.LIN" "SET" "DASHED" "")
(command "COLOR" "RED" "")
(command "PLINE")   
(foreach n list1 (command n))
(command "")

(setq list1 '())
(setq i 0)
(repeat (length cdsnv)
 (progn
      (setq td (+ (* (nth i cdsnv) tlx) ddcd))
      (setq hd (* (nth i kccdsnv) tln))
      (setq ptu (list hd td))
      (setq list1 (cons ptu list1))
 )
 (setq i (1+ i))
)

(setq list1 (reverse list1))

(setq ptu nil i nil td nil hd nil)

(command "LINETYPE" "SET" "CONTINUOUS"  "")
(command "COLOR" "CYAN" "")
(command "PLINE" )   
(foreach n list1 (command n))
(command "")

(setq list1 nil)

;; Xem tai mt, mn giao diem voi duong tu nhien o dau

(setq i 0)
(setq so_buoc (- (length kccdtn) 1))
(setq list1 '())

(repeat so_buoc

  (progn
    (setq pt5 (list (nth i kccdtn) (nth i cdtn)))
    (setq pt6 (list (nth (1+ i) kccdtn) (nth (1+ i) cdtn)))

    (setq dc (inters pt5 pt6 pt2 pt3))

    (if (/= dc nil)
      (cond
     ((or (and (> (nth 1 pt5) cdd) (< (nth 1 pt6) cdd))
	  	(and (< (nth 1 pt5) cdd) (> (nth 1 pt6) cdd)))

	  	(setq list1 (cons dc list1))
     )

     ((or (and (> (nth 1 pt5) cdd) (= (nth 1 pt6) cdd))
	  	(and (= (nth 1 pt5) cdd) (> (nth 1 pt6) cdd)))

	  	(setq list1 (cons dc list1))
     )


     ((if (and (> i 0) (< i (- so_buoc 1)))
	  	(cond
		  	((and (= (equal (nth 1 pt6) cdd) T)
					(<= (nth (+ i 2) cdtn) cdd)
					(> (nth 1 pt5) cdd)
		       )
			     (setq list1 (cons dc list1))
		  	)

		  	((and (= (equal (nth 1 pt5) cdd) T)
					(> (nth 1 pt6) cdd)
					(<= (nth (- i 1) cdtn) cdd))
			     (setq list1 (cons dc list1))
		  	)

	  	)

  	)
     )   
      )
    )
  )  
  (setq i (1+ i))
)

(setq list1 (reverse list1))
(setq dc nil pt5 nil pt6 nil so_buoc nil i nil)
(setq pt1text pt1 pt4text pt4)

;;Ve duong thiet ke

(setq pt1 (list (* (nth 0 pt1) tln) (+ (* (nth 1 pt1) tlx) ddcd)))
(setq pt4 (list (* (nth 0 pt4) tln) (+ (* (nth 1 pt4) tlx) ddcd)))
(setq pt2 (list (* mt tln) (+ (* cdd tlx) ddcd)))
(setq pt3 (list (* mn tln) (+ (* cdd tlx) ddcd)))

 (command "LINETYPE" "SET" "CONTINUOUS" "")
 (command "COLOR" "MAGENTA" "")  
 (command "LINE" pt1 pt2 pt3 pt4 "")
 (command "COLOR" "RED" "")
 (command "LINE" (list (nth 0 pt1) ghd) pt1 "")
 (command "LINE" (list (nth 0 pt2) ghd) pt2 "")
 (command "LINE" (list (nth 0 pt3) ghd) pt3 "")
 (command "LINE" (list (nth 0 pt4) ghd) pt4 "")

 (command "COLOR" "GREEN" "")

 (command "LINE" (list (nth 0 pt1) (- ghd 32)) (list (nth 0 pt1) (- ghd 40)) "")
 (command "LINE" (list (nth 0 pt2) (- ghd 32)) (list (nth 0 pt2) (- ghd 40)) "")
 (command "LINE" (list (nth 0 pt3) (- ghd 32)) (list (nth 0 pt3) (- ghd 40)) "")
 (command "LINE" (list (nth 0 pt4) (- ghd 32)) (list (nth 0 pt4) (- ghd 40)) "")  

;; Ve duong sai so

(setq pt11 (list (* (nth 0 pt11) tln) (+ (* (nth 1 pt11) tlx) ddcd)))
(setq pt41 (list (* (nth 0 pt41) tln) (+ (* (nth 1 pt41) tlx) ddcd)))
(setq pt21 (list (* (nth 0 pt21) tln) (+ (* (nth 1 pt21) tlx) ddcd)))
(setq pt31 (list (* (nth 0 pt31) tln) (+ (* (nth 1 pt31) tlx) ddcd)))
(setq pt51 (list (* (nth 0 pt51) tln) (+ (* (nth 1 pt51) tlx) ddcd)))
(setq pt61 (list (* (nth 0 pt61) tln) (+ (* (nth 1 pt61) tlx) ddcd)))


(command "LINETYPE" "LOAD" "CENTER" "ACAD.LIN" "SET" "CENTER" "")
(command "COLOR" "WHITE" "")

(setq sd (length list1))
(cond
 ( (= sd 0)
    (if (and (= bdd4 T) (= bdd1 T))
    (command "LINE" pt11 pt51 pt21 pt31 pt61 pt41 ""))
 )

 ( (/= sd 0)
(progn
(setq list2 '())
(setq i 0)	   
(repeat sd
  	(progn
		     (setq dc (list (nth 0 (nth i list1)) (- cdd ssd)))
		     (setq list2 (cons dc list2))

  	)
  	(setq i (1+ i))
)

(setq list2 (reverse list2))


(cond
 	((= (rem sd 2) 0)
      (progn

	(setq t1 (list (* (nth 0 (car list2)) tln) (+ (* (nth 1 (car list2)) tlx) ddcd)))
	(setq t2 (list (* (nth 0 (last list2)) tln) (+ (* (nth 1 (last list2)) tlx) ddcd)))
	(setq t3 (list (* (+ (nth 0 (car list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (car list1)) (/ ssd 2)) tlx) ddcd)))
	(setq t4 (list (* (- (nth 0 (last list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (last list1)) (/ ssd 2)) tlx) ddcd)))

	(if (and (/= bdd3 nil) (> (nth 1 diemss2) cdd)) (command "LINE" pt41 pt61 pt31 t2 t4 ""))

	(if (and (/= bdd1 nil) (> (nth 1 diemss1) cdd)) (command "LINE" pt11 pt51 pt21 t1 t3 ""))

	(if (and (/= bdd1 nil) (> (length list1) 2))
		(progn
	       (setq i 1)
	       (repeat (/ (- sd 2) 2)
			(progn
		     (setq t1 (list (* (- (nth 0 (nth i list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (nth i list1)) (/ ssd 2)) tlx) ddcd)))
		     (setq t2 (list (* (nth 0 (nth i list2)) tln) (+ (* (nth 1 (nth i list2)) tlx) ddcd)))
		     (setq t3 (list (* (nth 0 (nth (1+ i) list2)) tln) (+ (* (nth 1 (nth (1+ i) list2)) tlx) ddcd)))
		     (setq t4 (list (* (+ (nth 0 (nth (1+ i) list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (nth (1+ i) list1)) (/ ssd 2)) tlx) ddcd)))
		     (command "LINE" t1 t2 t3 t4 "")
			)
			(setq i (+ i 2))
	       )
		)
	)   

	(if (and (= bdd1 nil) (>= (length list1) 2))
		(progn
	       (setq i 0)
	       (repeat (/ sd 2)
			(progn
		     (setq t1 (list (* (- (nth 0 (nth i list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (nth i list1)) (/ ssd 2)) tlx) ddcd)))
		     (setq t2 (list (* (nth 0 (nth i list2)) tln) (+ (* (nth 1 (nth i list2)) tlx) ddcd)))
		     (setq t3 (list (* (nth 0 (nth (1+ i) list2)) tln) (+ (* (nth 1 (nth (1+ i) list2)) tlx) ddcd)))
		     (setq t4 (list (* (+ (nth 0 (nth (1+ i) list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (nth (1+ i) list1)) (/ ssd 2)) tlx) ddcd)))
		     (command "LINE" t1 t2 t3 t4 "")
			)
			(setq i (+ i 2))
	       )
		)
	)     

 	))

 	((= (rem sd 2) 1)
      (progn

       (setq t1 (list (* (nth 0 (car list2)) tln) (+ (* (nth 1 (car list2)) tlx) ddcd)))
       (setq t2 (list (* (+ (nth 0 (car list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (car list1)) (/ ssd 2)) tlx) ddcd)))

       (if (and (/= bdd1 nil) (> (nth 1 diemss1) cdd)) (command "LINE" pt11 pt51 pt21 t1 t2 ""))

       (setq t1 (list (* (- (nth 0 (last list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (last list1)) (/ ssd 2)) tlx) ddcd)))
       (setq t2 (list (* (nth 0 (last list2)) tln) (+ (* (nth 1 (last list2)) tlx) ddcd)))	       

       (if (and (/= bdd3 nil) (> (nth 1 diemss2) cdd)) (command "LINE" t1 t2 pt31 pt61 pt41 ""))

       (if (and (/= bdd1 nil) (> (length list1) 1))
	     (progn
	       (setq i 1)
	       (repeat (/ (- sd 1) 2)
			(progn
		     (setq t1 (list (* (- (nth 0 (nth i list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (nth i list1)) (/ ssd 2)) tlx) ddcd)))
		     (setq t2 (list (* (nth 0 (nth i list2)) tln) (+ (* (nth 1 (nth i list2)) tlx) ddcd)))
		     (setq t3 (list (* (nth 0 (nth (1+ i) list2)) tln) (+ (* (nth 1 (nth (1+ i) list2)) tlx) ddcd)))
		     (setq t4 (list (* (+ (nth 0 (nth (1+ i) list1)) (/ ssn 2)) tln) (+ (* (- (nth 1 (nth (1+ i) list1)) (/ ssd 2)) tlx) ddcd)))
		     (command "LINE" t1 t2 t3 t4 "")
			)
			(setq i (+ i 2))
	       )
	     )
       )

       (if (and (= bdd1 nil) (> (length list1) 2))
	     (progn
	       (setq i 0)
	       (repeat (/ (- sd 1) 2)
			(progn
		     (setq t1 (list (* (- (nth 0 (nth i list1)) ssn) tln) (+ (* (nth 1 (nth i list1)) tlx) ddcd)))
		     (setq t2 (list (* (nth 0 (nth i list2)) tln) (+ (* (nth 1 (nth i list2)) tlx) ddcd)))
		     (setq t3 (list (* (nth 0 (nth (1+ i) list2)) tln) (+ (* (nth 1 (nth (1+ i) list2)) tlx) ddcd)))
		     (setq t4 (list (* (+ (nth 0 (nth (1+ i) list1)) ssn) tln) (+ (* (nth 1 (nth (1+ i) list1)) tlx) ddcd)))
		     (command "LINE" t1 t2 t3 t4 "")
			)
			(setq i (+ i 2))
	       )
	     )
       )

      )
 	)       
)
)  
 )
)

(command "LINETYPE" "SET" "DASHED" "")
(command "COLOR" "RED" "")

(if (and (= bdd4 nil) (/= bdd3 nil)) (command "LINE" pt4 pt41 ""))

(setq pt11 nil pt31 nil pt21 nil pt41 nill t1 nil t2 nil t3 nil t4 nil)
(setq bdd1 nil bdd2 nil bdd3 nil bdd4 nil list1 nil list2 nil diemss1 nil diemss2 nil)
(setq dc1 nil dc2 nil p1 nil p2 nil ptt1 nil ptt2 nil so_buoc nil)

(command "LINETYPE" "SET" "CONTINUOUS" "")
(command "COLOR" "GREEN" "")
(command "_.STYLE" "KC1" ".VnTime" "0" "1" "15" "N" "N" "")

;;ve duong dong cua duong tu nhien va duong phan cach khoang cach le duong tu nhien
(setvar "LUPREC" 1)
(setvar "LUNITS" 2)
(setq i 0)
(repeat (length cdtn)
 (progn
  (setq td1 (+ (* (nth i cdtn) tlx) ddcd))
  (setq hd1 (* (nth i kccdtn) tln))
  (setq d1 (list hd1 td1))  

  (setq d2 (list hd1 ghd))
  (setq starttext (list hd1 (- ghd 6)))
  (command "LINE" d1 d2 "")
  (mytext starttext (rtos (nth i cdtn)))

  (setq d1 (list hd1 (- ghd 8)))
  (setq d2 (list hd1 (- ghd 16)))
  (setq starttext (list hd1 (- ghd 22)))
  (command "LINE" d1 d2 "")
  (mytext starttext (rtos (nth i kccdtn)))
  (if (> i 0)
 	(progn
	(setq hd (+ (nth i kccdtn) (nth (- i 1) kccdtn)))
	(setq hd (* (/ hd 2.0) tln))  
	(setq starttext (list hd (- ghd 14)))
	(mytext starttext (rtos (nth i kcltn)))
  ))
 )

 (setq i (1+ i))
)

(setq td1 nil hd1 nil d1 nil d2 nil starttext nil i nil)
(setq text1 (rtos (nth 1 pt1text)))
(mytext (list (nth 0 pt1) (- ghd 30)) text1)
(mytext (list (nth 0 pt2) (- ghd 30)) cdday)
(mytext (list (nth 0 pt3) (- ghd 30)) cdday)
(setq text1 (rtos (nth 1 pt4text)))
(mytext (list (nth 0 pt4) (- ghd 30)) text1)
(setq text1 nil l nil)


(setq hd1 (/ (+ (nth 0 pt2) (nth 0 pt1)) 2.0))
(setq text (rtos (- mt (nth 0 pt1text))))
(mytext (list hd1 (- ghd 38)) text)
(setq hd1 (/ (+ (nth 0 pt3) (nth 0 pt2)) 2.0))
(setq text (rtos (- mn mt)))
(mytext (list hd1 (- ghd 38)) text)
(setq hd1 (/ (+ (nth 0 pt4) (nth 0 pt3)) 2.0))
(setq text (rtos (- (nth 0 pt4text) mn)))
(mytext (list hd1 (- ghd 38)) text)		     
(setq pt1text nil pt4text nil)

;;ve duong dong cua duong sau nao vet va duong phan cach khoang cach le snv

(setq i 0)
(repeat (length cdsnv)

(progn
  (setq td1 (+ (* (nth i cdsnv) tlx) ddcd))
  (setq hd1 (* (nth i kccdsnv) tln))
  (setq d1 (list hd1 td1))  

  (setq d2 (list hd1 ghd))
  (setq starttext (list hd1 (- ghd 46)))
  (command "LINETYPE" "SET" "DASHED" "")
  (command "COLOR" "8" "")
  (command "LINE" d1 d2 "")
  (command "LINETYPE" "SET" "CONTINUOUS" "")
  (command "COLOR" "GREEN" "")
  (mytext starttext (rtos (nth i cdsnv)))

  (setq d1 (list hd1 (- ghd 48)))
  (setq d2 (list hd1 (- ghd 56)))
  (setq starttext (list hd1 (- ghd 62)))
  (command "LINE" d1 d2 "")
  (mytext starttext (rtos (nth i kccdsnv)))
(if (> i 0)
    (progn
	(setq hd (+ (nth i kccdsnv) (nth (- i 1) kccdsnv)))
	(setq hd (* (/ hd 2.0) tln))
	(setq starttext (list hd (- ghd 54)))
	(mytext starttext (rtos (nth i kclsnv)))
    )
)								   
)
 (setq i (1+ i))
)

(setq td1 nil hd1 nil d1 nil d2 nil starttext nil i nil)

;;Viet chu trong khung
(setq tdy ghd)
(setq i 0)
(repeat 9
(progn
	(setq tdytext (- tdy 6.0))
	(setq diem1 (strcat "-75," (rtos tdy)))
	(setq diem2 (strcat (rtos ghmn) "," (rtos tdy)))
	(setq startptext (strcat "-70," (rtos tdytext)))
	(command "LINE" diem1 diem2 "")
	(command "TEXT" startptext "3.0" "0" (nth i st) "")
)
	(setq tdy (- tdy 8))
	(setq i (1+ i))
)

(setq diem1 (strcat "-75," (rtos ghd)))
(setq diem2 (strcat "-75," (rtos (- ghd 64))))
(command "LINE" diem1 diem2 "")

(setq diem1 (strcat "-9," (rtos ghd)))
(setq diem2 (strcat "-9," (rtos (- ghd 64))))
(command "LINE" diem1 diem2"")

(setq diem1 (strcat (rtos ghmn) "," (rtos ghd)))
(setq diem2 (strcat (rtos ghmn) "," (rtos (- ghd 64))))
(command "LINE" diem1 diem2 "")

(setq ddat (list (/ ghmn 2) 20))
(command "_.STYLE" "KC2" ".VnTimeH" "0" "1" "15" "N" "N" "")
(command "TEXT"  "J" "C" ddat "3" "0" (strcat "MÆt c¾t: " SHBV) "")
(command "_.STYLE" "KC1" ".VnTime" "0" "1" "15" "N" "N" "")
(setq i nil tdy nil diem1 nil diem2 nil tdytext nil startptext nil ddcd nil)

)
;;*******************************
;;END_FILE

error.lsp

//Ham bao loi ban dau khi tim file chuong trinh
(defun bao_loi (file_ct msg)
 (defun *error* (s)
 (if old_error (setq *error* old_error)) (princ))
 (if msg (alert (strcat " Ch­¬ng tr×nh bÞ lçi ! " File_ct "\n\n" msg " \n")))
 (setq filename nil)
 (exit)  
);;end defun
//****************************

và Read.lsp

*****************************************************************************
(defun Read_data (/ fo)
(setvar "LUNITS" 2)
(setvar "LUPREC" 2)
(if (= filename nil) (setq filename (getfiled "Open Data" "C:/NAOVET/" "TXT" 8)))
(if (/= filename nil)
(progn
(setq cdtn '() kcltn '() kccdtn '() cdsnv '() kclsnv '() kccdsnv'())
(setq sodong 0)
(setq fo (open filename "r"))   
(if fo
	(progn
	(while (and (setq st (read-line fo)) (/= st ""))					   
	(setq sodong (1+ sodong))
	(cond
	       ((= sodong 1) (setq namect st))
	       ((= sodong 2) (setq shbv st))		       	       
       ((= sodong 3) (setq mt (distof st)))   
       ((= sodong 4) (setq mn (distof st)))
       ((= sodong 5) (setq cdd (distof st)))   
       ((= sodong 6) (setq n1 (distof st)))
       ((= sodong 7) (setq n2 (distof st)))
       ((= sodong 8) (setq cdmax (distof st)))
       ((= sodong 9) (setq cdmin (distof st)))
       ((= sodong 10) (setq ssd (distof st)))   
       ((= sodong 11) (setq ssn (distof st)))
       ((>= sodong 12)
		(progn
			(setq d (strlen st))			   
			(setq dem 0)   
			(setq vitri '())   
			(repeat d
			(setq dem (1+ dem))
			(setq s (substr st dem 1))			   
			(if (= s "\t")
				(setq vitri (cons dem vitri))					   
			)
			)	   
			(setq vitri (reverse vitri))
			(setq cdtn (cons (distof (substr st 1 (nth 0 vitri)) 2) cdtn))   
			(setq kcltn (cons (distof (substr st (nth 0 vitri) (- (nth 1 vitri) (nth 0 vitri))) 2) kcltn))				   
			(setq kccdtn (cons (distof (substr st (nth 1 vitri) (- (nth 2 vitri) (nth 1 vitri))) 2) kccdtn))
			(setq cdsnv (cons (distof (substr st (nth 2 vitri) (- (nth 3 vitri) (nth 2 vitri))) 2) cdsnv))
			(setq kclsnv (cons (distof (substr st (nth 3 vitri) (- (nth 4 vitri) (nth 3 vitri))) 2) kclsnv))   
			(setq kccdsnv (cons (distof (substr st (nth 4 vitri)) 2) kccdsnv))   

		)
       )

    	)   
			)
		)
	)

(close fo)
)

)
(setq cdtn (reverse cdtn))
(setq kcltn (reverse kcltn))
(setq kccdtn (reverse kccdtn))
(setq cdsnv (reverse cdsnv))
(setq kclsnv (reverse kclsnv))
(setq kccdsnv (reverse kccdsnv))
(setq d (strlen shbv))
(setq dem d)
(repeat d
(setq s (substr shbv dem 1))
(if (= s "\t") (setq shbv (substr shbv 1 (1- dem))))
(setq dem (1- dem))   
)
(setq dem nil s nil vitri nil fo nil sodong nil d nil st nil filename nil)
)
***********************************************************

với lệnh cal1 để nhập số liệu mặt cắt có dạng:

17.5				   
44.5				   
-1.68				   
5				   
5				   
2				   
-6				   
0				   
0				   
-0.16	0	0	-0.16	0	0
-0.77	2.5	2.5	-0.77	2.5	2.5
-1.38	2.5	5	-1.55	2.5	5
-1.94	2.5	7.5	-1.80	2.5	7.5
-2.31	2.5	10	-2.05	2.5	10
-2.67	2.5	12.5	-2.30	2.5	12.5
-3.04	2.5	15	-2.55	2.5	15
-3.41	2.5	17.5	-2.80	2.5	17.5
-3.77	2.5	20	-3.05	2.5	20
-4.14	2.5	22.5	-3.10	2.5	22.5
-4.38	2.5	25	-3.15	2.5	25
-4.01	2.5	27.5	-3.20	2.5	27.5
-3.58	2.5	30	-3.25	2.5	30
-3.16	2.5	32.5	-3.30	2.5	32.5
-2.74	2.5	35	-3.35	2.5	35
-2.32	2.5	37.5	-3.40	2.5	37.5
-2	2.5	40	-3.45	2.5	40
-1.57	2.5	42.5	-3.45	2.5	42.5
-1.12	2.5	45	-3.45	2.5	45
-0.65	2.5	47.5	-3.45	2.5	47.5
-0.31	2.5	50	-3.45	2.5	50
-0.01	2.5	52.5	-3.48	2.5	52.5
0.28	2.5	55	-3.50	2.5	55
0.56	2.5	57.5	0.56	2.5	57.5
0.84	2.5	60	0.84	2.5	60

Vấn đề em gặp phải là số liệu xuất ra phần thập phân làm tròn đến 1 chữ số sau dấu "." chứ không phải là 2 như em mong muốn (1.6 thay vì 1.56). Vậy rất mong các bác giỏi lisp chỉ bảo giúp em giải quyết vấn đề này với ạ. Em xin cảm ơn.

E là thành viên mới còn ngu ngơ về lisp. A có thể hướng dẫn e sữ dụng đoạn lisp này được ko ak. Thanks

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Mong các bạn ai có lisp tính khối lượng đào đắp san nền gửi lại lisp với ạ. Mình vào tải nhưng bị mất link không tải được cái nào cả ạ. (nếu có chỉ giúp mình cách luôn ạ)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×