;面積求和
;;; 面積求和.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建立圖層
)