LISP文件 統計多段線的面積命令tjmj-並中心標註

;面積求和
;;; 面積求和.LSP
;;; 功能: 計算多個選擇對象的總面積
;創建新圖層 newlayer

(defun c:tjmj (/ olderr oldcmdecho errexit undox restore ss1 nr en tot_area ZMJ)
	;統計命令 tjmj
	;出錯處理 執行函數()
	(setq textH 0.4)
	(setq circleH (* textH 1.5))
	;設置字體高度
	(defun errexit (s)
		(restore)
	)
	;撤銷
	(defun undox ()
		(command "._undo" "_E")
		(setvar "cmdecho" oldcmdecho)
		(setq *error* olderr)
		(princ)
	)

	(setq olderr *error*
		restore undox
		*error* errexit
	)
	;正式命令 只統計多段線
	(setq oldcmdecho (getvar "cmdecho"))
	(setvar "cmdecho" 0)
	(setq oldsanp (getvar "osmode"))
	(command "._UNDO" "_BE")
	(if (setq ss1 (ssget '((-4 . "<OR")
							(0 . "POLYLINE")
							(0 . "LWPOLYLINE")
							;(0 . "CIRCLE")
							;(0 . "ELLIPSE")
							;(0 . "SPLINE")
							;(0 . "REGION")
							(-4 . "OR>")
						)
				   )
		)
		(progn
			(setq nr 0)
			;對象序號
			(setq tot_area 0.0)
			(setq all_data '())
			(setq en (ssname ss1 nr))
			;獲取實體
			(while en
				(command "._area" "_O" en)
				(setq tot_area (+ tot_area (getvar "area")))
				(setq nr (1+ nr))
				(setq i 0)
				(setq en_data (entget en))
				;獲取多線段線頂點座標
				(setq pts nil)
				(setvar "osmode" 0)
				(repeat (length en_data)
					(if (= (car (nth i en_data)) 10)
						(setq pts (append pts (list (cdr (nth i en_data)))))
					)
					(setq i (1+ i))
				)
				(setq j 0)
				(setq pc_x 0.0)
				(setq pc_y 0.0)
				(repeat (length pts)
					(setq pc_x (+ pc_x (car (nth j pts))))
					(setq pc_y (+ pc_y (cadr (nth j pts))))
					(setq j (1+ j))
				)
				(setq pc_x (/ pc_x (length pts)))
				(setq pc_y (/ pc_y (length pts)))
				(setq pc1 (list pc_x pc_y))
				;計算插入文字 點位置
				;插入序號 單個面積
				;(setq pc1 (car pts))
				; Plot circle 
				(command "circle" pc1 circleH)
				(command "text" "m" pc1 textH 0 (itoa nr))
				;獲取創建的text 將他改爲指定圖層中
				;(setq en_t1 (entget (entlast)))
				;(setq en_t1 (subst (cons 8 0) (assoc 8 en_t1) en_t1))
				;(princ oldlist)
				
				(setq pc2 (list (car pc1) (- (cadr pc1) (* textH 2))))
				(setq en_area (getvar "area"))
				(princ (strcat "\nNo.=" (itoa nr) " 單個面積=" (rtos en_area 2 3)))
				(command "text" "m" pc2 textH 0 (strcat "S=" (rtos en_area 2 3) "m2"))
				(princ)
				;(princ en_t2)
				(setvar "osmode" oldsanp)
				(setq all_data (cons (list nr en_area) all_data))
				(setq en (ssname ss1 nr))
			)
			
			(princ (strcat "\n總面積 = " (rtos tot_area) "\n"))			
			;輸出數據=========================
			; Reverse the list
			(setq all_data (reverse all_data))
			; write file 
			(setq dat_file (getfiled "Save file as" "C:\\tempfile" "csv" 1))
			(setq fo (open dat_file "w"))
			(write-line "NO., Area" fo)
			; element index start from 0
			(setq n (length all_data)
				  i 0
			)
			(princ (strcat "\n多段線對象個數=" (itoa n)))
			(repeat n
				(setq data (nth i all_data))
				(write-line (strcat (itoa (1+ i)) ", "
									(rtos (nth 1 data) 2 3)
						)
						fo
				 )
				(setq i (1+ i))
			)
			(write-line (strcat "\n總面積 = " (rtos tot_area) "\n") fo)
			(close fo)
			(princ (strcat "\nWrite file:" dat_file))
			(prin1)
		)
				;if執行表達式
	)
	(princ)
)

(defun c:newLayer () 
	(setq lw (getvar "LWDEFAULT"))
	(if (not (tblsearch "layer" "001線路-拆遷"))
	 	(entmake 
	 		(list '(0 . "LAYER") 
			;CELTYPE
	 				'(100 . "AcDbSymbolTableRecord") 
	 				'(100 . "AcDbLayerTableRecord") 
	 				'(6 . "Continuous") 
	 				'(62 . 1) 
	 				'(370 . 25)
	 				'(70 . 0) 
	 				'(290 . 7) 
	 				'(2 . "001線路-拆遷")))
;6組碼4102【線型】,62組碼【顏1653色】,370組碼【線寬】回,70組碼【可見】
;290組碼【打答印】，2組碼【圖層名稱】
	 )
	 ;autolisp建立圖層
)