歡迎來到http://www.tljciu.live !
當前位置:六六工程資料網建筑課堂工程資料工程測量LISP快速展點程序

LISP快速展點程序

08-22 13:45:35  瀏覽次數:412次  欄目:工程測量
標簽:工程測量規范,工程測量技術, LISP快速展點程序,http://www.tljciu.live
LISP快速展點程序 ;LISP展點程序
;展1000點:在HP(AMD Athlon64  3000+  256MB)電膠上僅耗時0.142秒;
;                    在金利(Geleron(R) CPU 2.40GHz 256MB)電膠上耗時0.882秒
;數據文件格式為:每一點的數據(點號、X、Y、H)為一行,用逗號或空格作為分隔符,即
;點號1  X1  Y1 H1   或者 點號1,  X1,  Y1, H1
;點號2  X2  Y2 H2   或者 點號2,  X2,  Y2, H2
;點號3  X3  Y3 H3   或者 點號3,  X3,  Y3, H3
;......
;點號n  Xn  Yn Hn   或者 點號n,  Xn,  Yn, Hn1
(defun c:kszd()
    (setq  ff (open (getfiled "請選擇要展點的數據文件" "" "txt" 2) "r")
           fhb nil  t0 (getvar "cdate")
           cm (getvar "cmdecho") os (getvar "osmode")
           tcm1 "高程注記"   tcm2 "點記"
    )
    (setvar "cmdecho" 0)(setvar "osmode" 0)
    (if (= (tblsearch "layer" tcm1) nil) (command "layer" "n" tcm1 ""))
    (if (= (tblsearch "layer" tcm2) nil) (command "layer" "n"  tcm2 ""))
    (while (setq zb (read-line ff))
        (while (vl-string-search "," zb) (setq zb (vl-string-subst " " "," zb)))
        (setq zb  (read (strcat "(" zb ")"))
              zb  (list (list (nth 2 zb) (nth 1 zb)) (vl-princ-to-string  (last zb)));注記高程
              ;zb  (list (list (nth 2 zb) (nth 1 zb)) (vl-princ-to-string  (car zb)));提示:注記點號請用該行
              fhb (append fhb (list zb))
        )
    )
    (setq t1 (getvar "cdate"))
    (close ff)
    (setq zb (vl-sort fhb '(lambda (e1 e2) (< (car (car e1)) (car (car e2)))))
          x0 (car (car (car zb)))  x1 (car (car (last zb)))
          zb (vl-sort fhb '(lambda (e1 e2) (< (cadr (car e1)) (cadr (car e2)))))
          y0 (cadr (car (car zb)))  y1 (cadr (car (last zb)))
    )
    (command "zoom" "w" (list x0 y0) (list x1 y1))
    (setq t2 (getvar "cdate"))
    (foreach zb fhb
        (setq zfc (last zb)
              ;pt  (mapcar '+ (car zb) '(1.5 -1.25));這行改為如下
              pt  (car zb)
        )
        (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
         '(62 . 1) '(40 . 2.5) '(50 . 0.0)
          ;(cons 8 tcm1)   (cons 1 zfc)  (cons 10 pt);這行改為如下
          (cons 8 tcm1)   (cons 1 zfc)  (cons 10 (mapcar '+ pt  '(1.5 -1.25)))                      )
        )
        (entmake (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint")
         '(62 . 2)
          (cons 8 tcm2)  (cons 10 pt)
                      )
        )
    )
    (setq t3 (getvar "cdate")
          dt1 (* 1000000 (- t1 t0))
        dt2 (* 1000000 (- t3 t2))
    )
    (princ (strcat "讀入數據共耗時:" (rtos dt1 2 3)
     "秒   展點共耗時" (rtos dt2 2 3) "秒"
                   "展點數:" (itoa (length fhb))
     "個  每展一點耗:"
     (rtos (/ dt2 (length fhb)) 2 10) "秒"
            )
    )
    (setvar "cmdecho" cm)(setvar "osmode" os)(princ)
)
,LISP快速展點程序

++《LISP快速展點程序》相關文章

22选五的开奖公告