;面积求和
;;; 面积求和.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建立图层
)