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 . "")
						)
				   )
		)
		(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建立图层
)