测量lisp小程序

1. 坐标展点

读取坐标文本文件，标出点位与点号，高程（属性块）

  (defun c:plot_point () ;;;坐标展点
    (if (not (tblsearch "block" "block_point"))
    (write_block))
    (setq osmode_old (getvar "osmode"))
    (setvar "osmode" 0)
    (setvar "attdia" 0)  ;;;设定块的属性由命令行输入
    (setq file (getfiled "选定点位数据文件" "d:/" "txt" 0))
    (setq f (open file "r"))
    (setvar "cmdecho" 0)
    (setq s (read-line f))
    (while (/= s "000")
      (setq pn (substr s 17 4))
      (setq x (atof (substr s 37 10)))
      (setq y (atof (substr s 21 10)))
      (setq h (atof (substr s 53 10)) h (rtos h 2 2))
      (command "_insert" "block_point" (list x y) 1 1 0 pn h "")
      (setq s (read-line f))
    )
      (close file)
      (setvar "cmdecho" 1)
      (setvar "osmode" osmode_old)
  )
  (defun write_block () ;;;创建一个名为block_point的块
    (command "_attdef" "" "No" "点号" "" '(1 0.5) 1 "")
    (setq e1 (entlast))
    (command "_attdef" "" "Height" "高程" "" '(1 -1.5) 1 "")
    (command "line" '(1 0) '(5 0) "")
    (command "point" '(0 0))
    (setq e2 (entnext e1) e3 (entnext e2) e4 (entnext e3))
    (setq ss (ssadd))
    (ssadd e1 ss)
    (ssadd e2 ss)
    (ssadd e3 ss)
    (ssadd e4 ss)
    (command "_block" "block_point" '(0 0) ss "") 
    (entdel e1)
    (entdel e2)
    (entdel e3)
    (entdel e4)
  )

2. 坐标解算：内外插点法

（捕捉两个已知点，输入与第一个点的距离）

  (defun c:insert_point ()
    (setq osmode (getvar "osmode"))
    (setvar "osmode" 9) ;;;只捕捉端点和节点
    (setq pt1 (getpoint "输入第一个点"))
    (setq pt2 (getpoint "输入第二个点" pt1))
    (setvar "osmode" 0)
    (setq dist (getdist "输入与第一个点的距离,同向为正，反向为负" pt1))
    (setq D (distance pt1 pt2))
    (setq lambda1 (/ dist (- D dist))) ;;;lambda为AP：PB的比值，方便用定比分点公式
    (setq x (/ (+ (car pt1) (* lambda1 (car pt2))) (1+ lambda1)))
    (setq y (/ (+ (cadr pt1) (* lambda1 (cadr pt2))) (1+ lambda1)))
    (command "point" (list x y))
    (setvar "osmode" osmode)
  )

3. 坐标解算：直角坐标法

（捕捉两个已知点，输入与第一个点的距离以及到连线的垂距）

  (defun c:verticle_dist ()
    (setq osmode (getvar "osmode"))
    (setvar "osmode" 16393) ;;;只捕捉端点和节点
    (setq pt1 (getpoint "输入第一个点"))
    (setq pt2 (getpoint "输入第二个点" pt1))
    (setvar "osmode" 0)
    (setq L (getdist "输入与第一个点沿线的距离,同向为正，反向为负" pt1))
    (setq h (getdist "输入到连线的垂距，逆时针为正，顺时针为负"))
    (setq x0 (car pt1) y0 (cadr pt1));;;运用直角坐标变换公式
    (setq theta (angle pt1 pt2))
    (setq x (+ (* (cos theta) L) (* (sin theta) (- 0 h)) x0))
    (setq y (+ (* (sin theta) L) (* (cos theta) h) y0))  
    (command "point" (list x y))
    (setvar "osmode" osmode)
  )

4. 坐标解算：距离交汇法

（捕捉两个已知点，输入两个距离）

  (defun c:dist_intersect(/ b a c)
    (setq osmode (getvar "osmode"))
    (setvar "osmode" 16393) ;;;只捕捉端点和节点
    (setq pt1 (getpoint "输入第一个点"))
    (setq pt2 (getpoint "输入第二个点" pt1))
    (setvar "osmode" 0)
    (setq b (getdist "输入与第一个点的距离" pt1))
    (setq a (getdist "输入与第二个点的距离" pt2))
    (setq c (distance pt1 pt2))
    (setq L (/ (+ (* b b) (* c c) (* a (- 0 a))) (* 2 c)))
    (setq h (sqrt (- (* b b) (* L L))))
    (setq x0 (car pt1) y0 (cadr pt1));;;运用直角坐标变换公式
    (setq theta (angle pt1 pt2))
    (setq x (+ (* (cos theta) L) (* (sin theta) (- 0 h)) x0))
    (setq y (+ (* (sin theta) L) (* (cos theta) h) y0)) 
    (command "point" (list x y))
    (setvar "osmode" osmode)
  )

5. 求某图层下lwpolyline的面积

    (defun c:areaPl()
      (setq lyr (getstring "输入图层名:\n"))
      (setq ss (ssget "x" (list (cons 8 lyr) (cons 0 "lw*"))))
      (setq len (sslength ss))
      (setq i 0)
      (if ss
        (progn
          (command "area" "a"　"o")
          (while (< i len)
            (setq ent (ssname ss i))
            (command ent)
            (setq i (1+ i)) 
          )
        )
      )
      (command "" "")
      (setq s (getvar "area"))
      (princ "面积:")
      (princ s)
      (princ)
    )