- UID
- 343088
- 积分
- 237
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2005-10-28
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
这是一个根据图上宗地自动生成宗地图的LISP ,还有好多不完善的地方.
现在已经能做一部分工作了.就是不稳定.同样图形有时候能执行有时候就不能执行了总是提醒:参数错误:lselsetp nil
帮我检查检查!!!
程序如下:
(defun c:plzdt(/);批量生成宗地图8月1日17点解决了点号、边长、邻宗剪切问题后备份
(setq oce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "osnap" "end")
(setq plwj1 "d:\\hbxx\\zd\\plwj1.txt")
(setq plwj2 "d:\\hbxx\\zd\\plwj2.txt");顺序文件
(setq plwj21 "d:\\hbxx\\zd\\plwj21.txt")
(setq plwj3 "d:\\hbxx\\zd\\plwj3.txt");辅助文件
(setq plwj4 "d:\\hbxx\\zd\\plwj4.txt");辅助文件
(setq plwj5 "d:\\hbxx\\zd\\plwj5.txt")
(setq plwj6 "d:\\hbxx\\zd\\plwj6.txt");选择集范围
(setq plwj7 "d:\\hbxx\\zd\\plwj7.txt")
(setq plwj8 "d:\\hbxx\\zd\\plwj8.txt");剪切选择集
(setq plwj81 "d:\\hbxx\\zd\\plwj81.txt")
(setq plwj9 "d:\\hbxx\\zd\\plwj9.txt");剪切范围界线、移动后界址点号注记坐标文件
(setq plwj61 "d:\\hbxx\\zd\\plwj61.txt");界址点号注记坐标文件
(setq plwj62 "d:\\hbxx\\zd\\plwj62.txt");界址点号注记坐标文件
(setq plwj10 "d:\\hbxx\\zd\\plwj10.txt");邻宗地坐标文件。
(print "请选择需要生成宗地图的区域")
(setq xzj (ssget "x" ' ((0 . "LWPOLYLINE") (8 . "界址线"))))
(setq kdxzj xzj)
(setq xzjc (sslength xzj))
(print "请指定宗地图生成的位置")
(setq po1 (getpoint))
(setq ppo1 po1)
(setq jj 0)
(command "osnap" "off")
(repeat xzjc
(setq zdm (ssname xzj jj))
(setq a (entget zdm))
(setq n (length a))
;(setq po (cdr (assoc 10 a)))
(setq i 0)
(setq k 0)
(setq pl1 (open plwj1 "w"))
(setq pl2 (open plwj2 "w"))
(repeat n
(setq m (nth k a))
(if (= (car m) 10)
(progn
(setq i (+ i 1))
(setq x (nth 1 m))
;(setq x (rtos x 2 3))
(setq y (nth 2 m))
;(setq y (rtos y 2 3 ))
(setq point (list x y))
(setq lr point)
(setq lr (list i lr))
(princ point pl1)
(princ lr pl2)
(princ "\n" pl2)
(setq cp (list po point))
(setq po cp)
)
)
(setq k (+ k 1))
)
(close pl1)
(close pl2)
(setq pl1 (open plwj1 "r"))
(setq dd (read-line pl1))
(setq dq (strcat "(" dd ")"))
(setq d1 (read dq))
(close pl1)
(setq zdxzj (ssget "cp" d1));构造每宗地选择集。
(command "area" "o" zdm);计算宗地面积
;(command "area" d1)
(setq mj (atof (rtos (getvar "area") 2 1)));提取宗地面积
(setq mj1 mj)
(setq bl1 (/ 1 (sqrt(/ 7000 mj))) );绘图比例
(setq bl (atof (rtos bl1 2 1)))
(setq blz (rtos (* bl 1000) 2 5))
(setq d2 d1)
(setq kk i)
(setq ii i)
(setq pl2 (open plwj2 "r"))
(setq pl21 (open plwj21 "w"))
(setq dq (read-line pl2))
(while (/= dq nil)
(progn
(setq dq (read-line pl2))
(princ dq pl21)
(princ "\n" pl21)
)
)
(close pl2)
(setq pl2 (open plwj2 "r"))
(setq dq (read-line pl2))
(princ dq pl21)
(close pl2)
(close pl21)
(setq pl21 (open plwj21 "r"))
(setq pl3 (open plwj3 "w"))
(setq i (+ kk 1))
(repeat i
(setq dq (read-line pl21))
(setq a (strlen dq))
(if (/= a 3)
(progn
(princ dq pl3)
(princ "\n" pl3)
)
)
)
(close pl3)
(close pl21)
(setq pl2 (open plwj2 "r"))
(setq pl4 (open plwj4 "w"))
(setq n 0)
(setq lr (read-line pl2))
(while (/= lr nil)
(progn
(setq n (+ n 1))
(if (= n kk)
(progn
(princ lr pl4)
;(princ "\n" pl4)
)
)
(setq lr (read-line pl2))
)
)
(close pl2)
(close pl4)
(setq pl2 (open plwj2 "r"))
(setq pl4 (open plwj4 "a"))
(setq n 0)
(setq lr (read-line pl2))
(while (/= lr nil)
(progn
(setq n (+ n 1))
(if (< n kk)
(progn
(princ "\n" pl4)
(princ lr pl4)
)
)
(setq lr (read-line pl2))
)
)
(close pl2)
(close pl4)
;////标注界址点
(setq h (* bl 1.6))
(setq pl2 (open plwj2 "r"))
(setq pl3 (open plwj3 "r"))
(setq pl4 (open plwj4 "r"))
(setq pl6 (open plwj6 "w"))
(setq pl5 (open plwj5 "w"))
(setq pl61 (open plwj61 "w"))
(repeat ii
(setq dq (read-line pl2))
(setq dd1 (cadr (read (read-line pl4))))
(setq dd2 (cadr (read (read-line pl3))))
(setq dq (read dq))
;(setq n (strlen dq ))
(setq dh (car dq));提取点号
;(SETQ DH (+ dh qq))
(setq zb (cadr dq));提取坐标
(setq ag1 (angle zb dd1))
(setq ag2 (angle zb dd2))
(setq pp1 (polar zb ag1 5))
(setq pp2 (polar zb ag2 5))
(setq ppp (polar pp1 (angle pp1 pp2) (/ (distance pp1 pp2) 2)))
(setq ag (angle zb ppp ))
;(setq s1 (distance zb bb))
;(setq s2 (distance ppp bb))
(setq ag11 (/ (abs (- ag2 ag1))2 ))
(if (< ag1 ag2 )
(progn
(setq ag (- (+ ag1 (/ (abs (- ag2 ag1)) 2)) 3.14))
)
(progn
(setq ag (- ag1 ag11))
)
)
;(if (< s2 s1) (setq ag (+ ag 3.14)))
;(if (and (< ag1 1.75) (> ag2 4.71))
(setq hh (* h 1.7))
(setq fwjx(* hh 2))
(setq dzb (polar zb ag hh))
(setq fwdzb (polar zb ag fwjx))
;(setq x (+ (car zb) h))
; (setq y (+ (cadr zb) h))
;(setq dzb (list x y));偏移
(setq dh (itoa dh))
(setq x1 (rtos (car zb) 2 3 ))
(setq y1 (rtos (cadr zb) 2 3 ))
;(setq c (strcat dh " , " y1 " , " x1 " , " "解算"))
;(write-line c zw)
;(princ "\n" zw)
;(setq dh (strcat "j" dh))
;(command "layer" "m" "界址点注记" "c" "white" "" "")
;(command "_osnap" "off")
;(command ".text" "m" dzb h 0 dh);注记点号
(princ fwdzb pl5)
(princ fwdzb pl6)
(princ "\n" pl6)
(princ dzb pl61)
(princ "\n" pl61)
(setq bj (/ h 3.2));界址圈大小
(command "layer" "m" "界址圈" "c" "white" "" "")
(command "_circle" zb bj)
)
(close pl2)
(close pl4)
(close pl3)
(close pl5)
(close pl6)
(close pl61)
;////标注界址点。
;////确定新界限范围。
(setq pl5 (open plwj5 "r"))
(setq dd (read-line pl5))
(setq dq (strcat "(" dd ")"))
(setq d1 (read dq))
(close pl5)
;//////确定新界限范围。
;/////以下注记边长。
(setq pl2 (open plwj2 "r"))
(setq pl3 (open plwj3 "r"))
;(setq pl7 (open plwj7 "w"))
(repeat ii
(setq poo1 (read (read-line pl2)))
(setq poo2 (read (read-line pl3)))
(setq j1 (itoa (car poo1)))
(setq j2 (itoa (car poo2)))
(setq p1 (cadr poo1))
(setq p2 (cadr poo2))
(setq bc (distance p1 p2));计算边长
(setq h1 (rtos bc 2 2));将边长变成字符型
(setq h2 h1)
(setq jd (angle p1 p2))
(setq ang2 (* (/ jd pi) 180))
(setq b (/ bc 2))
(setq bczb (polar p1 jd b));边上中点坐标
(command "osnap" "off")
;(setq zxb 5)
(if (> bc 0)
(progn
(command "layer" "m" "界址边注记" "c" "white" "" "")
(if (< jd 1.57)
(progn
(setq ang (+ jd 1.57))
(setq bczj (polar bczb ang h));边长注记处坐标
(command "layer" "m" "界址边注记" "c" "white" "" "")
(command ".text" "m" bczj h ang2 h1)
)
(progn
(if (and (> jd 2.35619445) (< jd 4.7123889))
(progn
(setq ang2 (+ ang2 180))
(setq ang (- jd 4.71))
(setq bczj (polar bczb ang h))
(command ".text" "m" bczj h ang2 h1)
)
(progn
(if (and (= > jd 4.7123889) (< jd 5.49778705))
(progn
(setq ang (+ jd 4.71))
(setq bczj (polar bczb ang h))
(command ".text" "m" bczj h ang2 h1)
)
(progn
(setq ang (+ jd 1.57) )
(setq bczj (polar bczb ang h))
(if (> ang2 270)
(progn
(command ".text" "m" bczj h ang2 h1)
)
(progn
(setq ang3 (- ang2 180))
(command ".text" "m" bczj h ang3 h1)
)
)
)
)
)
)
)
)
)
(progn
;(setq j1 (itoa(car (read(read-line pl2)))))
;(setq j2 (itoa(car (read(read-line pl3)))))
;(setq pp (strcat "j" j2 "-" "j" j1 ":" " " h1))
;(write-line pp pl7)
;(princ "\n" pl7)
)
)
;(setq bczb (polar bczb jd1 h));注记边长坐标
;(command ".text" "m" bczb 5 jd h1)
)
(close pl2)
(close pl3)
;(close pl7)
;(setq pl7 (open wenjian7 "r"))
;(print "请确定注记位置")
;(setq poin (getpoint))
;(setq s (read-line pl7))
;(setq hh2 (* h 1.3))
;(while (/= s nil)
;(progn
;(command "layer" "m" "界址边注记" "c" "white" "" "")
;(command ".text" poin h 0 s)
;(setq poin (list (car poin) (+ (cadr poin) hh2)))
;(setq s (read-line pl7))
;)
;)
;(setq zw (open zbwj "a"))
;(princ "\n" zw)
;(close zw)
;////以上注记界址边长。
(setq qcbc (ssget "wp" d2 '((0 . "TEXT") (8 . "界址边注记"))))
(setq zdxzj (ssget "wp" d1));重新构造包括边长、点号的选择集。
(setq zdxzjx(ssget "cp" d1))
(setq zdxzj1(ssget "wp" d1))
;//以下去处邻宗单位注记
(setq lzsm (sslength zdxzj1))
(setq lz 0)
(repeat lzsm
(setq lzst (ssname zdxzj1 lz))
(setq zdxzjx (ssdel lzst zdxzjx))
(setq lz (+ lz 1))
)
;//以上选择邻宗单范围
(setq g (sslength zdxzjx))
(setq gg 0)
(setq pl10 (open plwj10 "w"))
(repeat g
(setq aaa (entget (ssname zdxzjx gg)))
(setq nn (length aaa))
(setq lk 0)
(repeat nn
(setq mm (nth lk aaa))
(if (= (car mm) 10)
(progn
(setq poin (cdr mm))
(princ poin pl10)
)
)
(setq lk (+ lk 1))
)
(princ "\n" pl10)
(setq gg (+ gg 1))
)
(close pl10)
;//以上提取邻宗坐标存放到文件10中
;//以下构建邻宗四至选择集并将其加入到zdxzj中
; (setq pl10 (open plwj10 "r"))
; (setq dd (read-line pl0))
;(if (/= dd nil)
;(progn
;
;(setq dd (read-line pl0))
;(cond
; ((= g 1) (setq dq (strcat "(" dd ")")) (setq d1 (read dq)))
;(setq dq (strcat "(" dd ")"))
;(setq d1 (read dq))
; )
;)
;)
;(close pl10)
;//以下构建邻宗四至选择集并将其加入到zdxzj中
(setq zxzj (ssget "wp" d1 '((0 . "MTEXT") (8 . "单位注记"))))
(setq zb (cdr ( assoc 10 ( entget (ssname zxzj 0)) )));宗地内一点坐标
(setq dx (- (car po1) (car zb)))
(setq dy (- (cadr po1) (cadr zb)))
(setq pl6 (open plwj6 "r"))
(setq pl61 (open plwj61 "r"))
(setq pl8 (open plwj8 "w"))
(setq pl81(open plwj81 "w"))
(setq pl9 (open plwj9 "w"))
(setq pxp(read-line pl6))
(setq xp (read-line pl61))
(setq m 1)
(while (/= xp nil)
(progn
(setq ppxp (read pxp))
(setq pxx (+ dx (car ppxp)))
(setq pxy (+ dy (cadr ppxp)))
(setq xxp (read xp))
(setq xxxp (cadr xxp))
(setq xx (+ dx (car xxp)))
(setq xy (+ dy (cadr xxp)))
(setq ppoint (list pxx pxy))
(setq xpoint (list xx xy))
(princ ppoint pl81)
(princ "\n" pl81)
(princ ppoint pl8)
(setq v (list m xpoint))
(princ v pl9)
(princ "\n" pl9)
(setq m (+ m 1))
(setq xp (read-line pl61))
(setq pxp (read-line pl6))
)
)
(close pl61)
(close pl8)
(close pl9)
(close pl6)
(close pl81)
(setq pl8 (open plwj8 "r"))
(setq dd (read-line pl8))
(setq dq (strcat "(" dd ")"))
(setq dd8 (read dq))
(close pl8)
;将邻宗边长注记去处
(if qcbc;判断邻宗是否有边长注记。
(progn
(setq hb1 (sslength qcbc))
(setq hb2 0)
(repeat hb1
(setq hb3 (ssname qcbc hb2))
(setq zdxzj (ssdel hb3 zdxzj))
(setq hb2 (+ hb2 1))
)
)
)
;将邻宗边长注记去处
;(princ "aa")
(command "copy" zdxzj "" zb po1 "");复制宗地。
(setq jqxzj (ssget "cp" dd8));剪切选择集。
(setq jqxzj2(ssget "wp" dd8))
;////用大的选择集减去小的选择集。
(setq cc (sslength jqxzj2))
(setq ll 0)
(repeat cc
(setq sh (ssname jqxzj2 ll))
(setq jqxzj (ssdel sh jqxzj))
(setq ll (+ ll 1))
)
;////用大的选择集减去小的选择集。
;(setq jqxzj3 (ssdel (ssname jqxzj2 1) jqxzj))
(setq blzb (polar (polar po1 4.70795 (* 115.36 bl)) 3.13716 (* 6.12 bl)));比例插入点坐标
(setq blz (rtos (* bl 1000) 2 5));确定比例
(setq blsj (strcat "1:" blz))
(command "osnap" "off")
(command ".text" "m" blzb (* 3 bl) 0 blsj);标注比例
(command "insert" "sa4" po1 bl bl "0")
(setq cf (ssget "l"))
(command "explode" cf)
(setq zz (ssget "l"))
(setq mj 0)
;以下在宗地图位置注记点号。
(setq pl9 (open plwj9 "r"))
(setq llr (read-line pl9))
(while (/= llr nil)
(progn
(setq ddh (car (read llr)))
(setq ddh (strcat "j" (itoa ddh)));点号
(setq wz (cadr (read llr)))
(command "layer" "m" "界址点注记" "c" "white" "" "")
(command "_osnap" "off")
(command ".text" "m" wz h 0 ddh);注记点号
(setq llr (read-line pl9))
)
)
(close pl9)
(setq rqzb (polar (polar po1 4.70795 (* 123.64 bl)) 6.27875 (* 50 bl)));日期插入点座标
(setq rq (rtos (getvar "cdate") 2 0))
(setq nf (substr rq 3 2))
(setq yf (substr rq 5 2))
(setq rz (substr rq 7 2))
(setq xrq (strcat "日期:"nf "-" yf "-" rz))
(command ".text" "m" rqzb (* 3 bl) 0 xrq);标注日期
(setq htzb (polar (polar po1 4.70795 (* 123.64 bl)) 3.13875 (* 70 bl)));绘图员插入点座标
(setq hty (strcat "绘图员:黄 斌"))
(command ".text" "m" htzb (* 3 bl) 0 hty);标注绘图员
(setq po1 (polar po1 0 (* 300 bl)));确定下一宗地位置。
;以上插入图框和计算宗地图比例、标注绘图日期、绘图员。
;(command "trim" zz "" jqxzj "")
;7月30日未解决问题:邻宗界址线剪切问题、邻宗界址点注记显示问题、邻宗单位注记不显示问题。待后序解决。
;(print "ddd")
(setq jj (+ jj 1))
(load "zdpl")
(c:zdpl)
(setq xc (ssget "l"))
;(if (/= (sslength jqxzj) 0)
; (command "trim" xc "" jqxzj "")
; )
(command "erase" xc "")
);控制单个宗地。
;(command "copy" zdm "" pp1 po1)
(print jj)
(setvar "cmdecho" oce)
(princ)
) |
|