mj1.lsp

一个在AUTOCAD下计算多段线面积的程序

;;;命令名称:
;;;            MT:  参数设置, P 输入人均指标； U 面积计算结果以公顷为单位；F 打
;;;　  　　　　　　　印结果时在前面加层名, A   在上方标注层名; T 　输入标注字高,
;;;                  D  小数点位数
;;;            MD  取消上述参数设置
;;;            TT :  按层求和, 求某层所有数字总和
;;;            TY :  点选求和, 只计算用鼠标所选择的数字之和
;;;            TR :  框选求和, 计算选择框内所有数字之和, 可多次选择
;;;            ML:  计算面积, 按层计算，输入层名称后，计算该层所有 PLINE 线的
;;;                  面积之和
;;;            MM: 计算面积, 计算选择框内所有 PLINE 线面积之和, 可多次选择
;;;            MC:  计算面积, 按颜色计算，输入颜色名（代号）后，计算以该颜色画
;;;                 的所有 PLINE 线的面积之和，BYLAYER 或 BYBLOCK 的颜色
;;;                 不能以这种方式计算。
;;;            MJ:  计算面积，用鼠标单选 PLINE 线计算。
;;;            NN:  以用地面积推算各地块的人口，计算前先用MT命令输入人均用地
;;;                 面积指标。

(defun c:mt ()       ;;; 参数设置 PLINE PLINE 
   (setq cs1 nil cs2 nil cs3 nil)
   (setq cs (getstring"\nPopulatin/Unit/Layer name/text-High/Desimal "))
   (if (or (= cs "d")(= cs "D"))
     (setq csd (getint "Input the Number of desimal ")))
     (if (= csd nil)(setq csd 2))
   (if (or (= cs "h") (= cs "H"))
        (setq cst (getreal"Input text high, Please ")))
      (if (= cst nil )
      (setq cst 2.5))
   (if (or (= cs "u") (= cs "U"))
       (setq ck1 1))
   (if (or (= cs "p") (= cs "P"))
       (setq csp (getreal"\n请输入人均用地指标：")))
   (if (or (= cs "l") (= cs "L"))
       (setq cslay (getstring"\nput layaer name Above or Front? ")))
)

(defun c:md ()       ;;; 参数设置 PLINE PLINE 
   (setq cs1 nil cs2 nil cs3 nil)
   (setq cs (getstring"\nUnit/Layer name/text-High "))
   (if (or (= cs "t") (= cs "T"))
        (setq cst 2.5))
   (if (or (= cs "u") (= cs "U"))
       (setq ck1 21))
   (if (or (= cs "l") (= cs "L"))
       (setq cs3 (getstring"\nput layaer name Above or Front? ")))
   (if (or (= cs3 "f") (= cs3 "F"))
       (setq ck1 13)) 
   (if (or (= cs3 "a") (= cs3 "A"))
       (setq ck1 14))
)

(DEFUN C:tt()     ;统计,计算某一层的所有数字总和
   (setq aa nil)        
   (setq tnumb 0)
   (setq ltnm (getstring"\nPlease Input the Layer Name : "))
   (SETQ Aa (SSGET "x" (list (cons 0 "text")
                             (cons 8 ltnm)
   )        )          )
   (jsss)
)   
(defun c:ty ()   ;;;框选求和
   (setq aa nil tnumb 0)
   (setq aa (ssget))
   (jsss)
)

(defun c:tr ()    ;;; 框选求和2
   (setq aa nil)
   (setq tnumb 0)
   (setq aa (ssget "x" (list (cons 0 "text"))))
   (jsss)
)

(defun jsss()   
   (if (= csd nil)
       (setq csd 2))
   (if (or (= cst nil)(= cst 0)) 
       (setq cst 2.5))
   (SETQ www (SSNAME aA 0))
   (SETQ TNUMB (SSLENGTH Aa)) 
   (SETQ YDMJ 0.0 JZMJ 0.0 ZZMJ 0.0)
   (SETQ TTTT 0)

   (WHILE www
      (SETQ TNM (ENTGET www))
      (SETQ P0 (CDR (ASSOC 10 TNM)))
      (SETQ TPX (CAR P0))
      (SETQ TPY (CAR (CDR P0)))
                 (SETQ TEEX (CDR (ASSOC 1 TNM)))
                 (SETQ TDATE (ATOF TEEX))
                 (SETQ YDMJ (+ YDMJ TDATE))
      (setq tttt (+ tttt 1))
      (setq www (ssname aa tttt))
   )
   (setq rk (rtos ydmj 2 csd))
   (SETQ PO (getpoint "\nInput the Start Place for TEXT, PLease  "))
   (COMMAND "TEXT" PO cst 0 rk)
)
         

(defun c:ml ()
   (SETQ LNM (GETSTRING "\Input the Layer Name, Please : "))
   (setq m (ssget "x" (list (cons 0 "POLYLINE")
                            (cons 8 lnm)
                      )
          ))
   (MJJS)
)

(DEFUN C:mc ()
  (SETQ cnm (GETint "\nPlease Input Color number  :"))
  (setq m (ssget "x" (list (cons 0 "polyline")
                           (cons 62 cnm)
                     )
          ))
  (mjjs))


(DEFUN C:mm ()         ;;;框选 PLINE 线计算面积
  (SETQ M (SSGET))
  (MJJS))

(DEFUN MJJS ()
   (if (= csd nil)
       (setq csd 2))
   (if (or (= cst nil)(= cst 0)) 
       (setq cst 2.5))
  (setq uu (ssname m 0))
  (setq nn (sslength m))
  (setq tmj 0 smj 0)
  (setq t 0 nnn 0)
  (while nnn
       (command "area" "e" uu)
       (setq ssmj (list (getvar "area")))
       (setq smj (car ssmj))
       (setq tmj (+ tmj smj))
       (setq t (+ t 1))
       (setq uu (ssname m t))
       (if (= t nn) (setq nnn nil)) 
  )
  (if (= ck1 1)
      (setq tmmj (rtos (/ tmj 10000) 2 csd
      )          )
      (setq tmmj (rtos tmj 2 csd))
  )
  (SETVAR "OSMODE" 32)
  (setq po (getpoint "\nInput the Text Start Point Place, Please : "))
  (if (/= cslay nil)
      (lmmjs)
      (mmmm)
  )
)


(defun mmmm ()  
  (command "text" po 2.5 0 tmmj)
)

(defun lmmjs ()  
  (if (or (= cslay "f")(= cslay "F")) 
      (progn     
         (setq csl (* 5 cst))
         (setq p1 (polar po 0 csl))
      )
      (progn
         (setq a1 (- 0 (/ pi 2)))
         (setq p1 (polar po a1 100))
      ))
  (SETVAR "OSMODE" 0)
  (command "text" po cst 0 lnm)
  (command "text" p1 cst 0 tmmj))


(defun c:mj ()            ;;;计算 PLINE 线面积,  单选, 以公顷为单位, 标注层名
  (if (= csd nil)(setq csd 2))
  (setq plnm (car (setq plnm1 (entsel"Select a Polyline, Please: "))))
  (setq plnmm (entget plnm))
  (setq lnm (cdr (assoc 8 plnmm )))
  (command "area" "e" plnm)
  (setq ssmj (car (list (getvar "area"))))
  (if (= ck1 1)
      (setq tmmj (rtos (/ ssmj 10000) 2 csd))
      (setq tmmj (rtos ssmj 2 csd)))
  (setq po (getpoint "\nInput the Text Start Point Place, Please : "))  
  (if (/= cslay nil)
      (lmmjs)
      (mmmm)
    )
)

(defun c:nn ()       ;;;用人均用地指标计算人口
  
  (setq plnm (car (setq plnm1 (entsel"Select a Polyline, Please: "))))
  (princ "面积")
  (setq plnmm (entget plnm))
  (setq lnmtext (cdr (assoc 8 plnmm )))
  (command "area" "e" plnm)
  (setq ssmj (car (list (getvar "area"))))
  (setq plmj (rtos (/ ssmj csp) 2 0))
  (setq p0 (getpoint"Please give a point for Text: "))
  (command "text" p0 cst 0 plmj)
)