发一个移动房屋内注记至右上角的程序，欢迎大家提意见
本帖最后由 changyiran 于 2012-4-26 17:55 编辑做测绘内业的都一种体会，就是需要将房屋内注记（含房屋性质注记和层数注记）移到房屋右上角，很是费时间，鉴于此，本人开发了个小程序，欢迎大家提出宝贵意见。
在此，感谢G版在文本注记和坐标排序方面给予的热心帮助，再谢！！！
(vl-load-com)
(defun fjdb(en / x);返回轻量多段线的点表
(vl-remove-if'not
(mapcar'(lambda(x)(if(=(car x)10)(cdr x)))(entget en));mapcar返回的是一个表，lambda构造一个匿名函数
)
)
(defun pfx(zdzb el / HZJ JD JD1 JD2 QZJ XH);求多段线（直线段组成）任意转角的内角平分线
(setq xh(vl-position zdzb el));求得指定坐标在多段线点表中的序号
(cond((= 0 xh)(setq qzj(last el)hzj(cadr el)));分3种情况取得前转角和后转角坐标
((= (length el)(1+ xh))(setq qzj(nth (1- xh)el)hzj(car el)))
(t(setq qzj(nth (1- xh)el)hzj(nth (1+ xh)el)))
)
(setq jd1(angle zdzb qzj)jd2(angle zdzb hzj));获得指定坐标至前转角和后转角的角度
(setq jd(/ (+ jd1 jd2)2));获得角平分线的角度
)
(defun c:zjyd(/ DB DBJ EL1 EL2 EN FJ1 FJ2 FWZJEL FWZJEN J JJ NR NR1 NR2 SS SS1 SS2 X1 X2 Y1 Y2 ZJZB);房屋内注记性质移动
(command"undo""m")
(setq ss(ssget"x"'((0 . "lwpolyline")(8 . "jmd")(70 . 129)))j -1);建立房屋线选择集
(repeat (sslength ss)
(setq en(ssname ss(setq j(1+ j))))
(setq db(fjdb en))
(setq fj1(vl-sort-i db;按x从大到小排序
(function
(lambda (a b)
(setq x1 (car a)
y1 (cadr a)
x2 (car b)
y2 (cadr b)
)
(if (equal x1 x2 1);当横坐标相差在一米内时认为两者相等
(> y1 y2)
(> x1 x2)
)
)
)
)
fj2(vl-sort-i db;按y从大到小排序
(function
(lambda (a b)
(setq x1 (car a)
y1 (cadr a)
x2 (car b)
y2 (cadr b)
)
(if (equal y1 y2 1)
(> x1 x2)
(> y1 y2)
)
)
)
)
)
(setq fj1(nth (car fj1) db)fj2(nth (car fj2) db));获取可能的东北角（俩房角）坐标
(if (equal fj1 fj2)
(setq dbj fj1);为同一房角时
(progn
(setq jj(angle fj1 fj2));取得房角1、房角2夹角（弧度）
(if (and (> jj(* 0.75 pi))(< jj pi));获得东北角点坐标
(setq dbj fj1)
(setq dbj fj2)
)
)
)
(setq zjzb(polar dbj(pfx dbj db)3));获得注记坐标
(setq ss1(ssget"cp"db'((1 . "..")(8 . "jmd"))));获得可能的房屋性质
(setq ss2(ssget"cp"db'((1 . "~*[~.0-9]*")(8 . "jmd"))));获得可能的房屋层数
(if ss1;存在房屋注记
(progn
(setq fwxzen(ssname ss1 0))
(setq fwxzel(entget fwxzen))
(if ss2
(progn;存在房屋层数注记
(setq csen(ssname ss2 0))
(setq csel(entget csen))
;;;构造房屋性质和房屋层数图元表
(setq fwxzel(list'(0 . "text")(assoc 1 fwxzel)(assoc 7 fwxzel)(assoc 40 fwxzel)(assoc 41 fwxzel)'(8 . "jmd")'(10 1 2)(list 11 (car zjzb)(cadr zjzb))'(72 . 2)'(73 . 2)))
(setq csel(list'(0 . "text")(assoc 1 csel)(assoc 7 csel)(assoc 40 csel)(assoc 41 csel)'(8 . "jmd")'(10 1 2)(list 11 (car zjzb)(cadr zjzb))'(72 . 0)'(73 . 2)))
(entmake fwxzel)
(entmake csel)
(entdel fwxzen);删除原注记
(entdel csen)
)
(progn;房屋为1层即房屋内没有层数数字时
;;;构造房屋性质图元表
(setq fwxzel(list'(0 . "text")(assoc 1 fwxzel)(assoc 7 fwxzel)(assoc 40 fwxzel)(assoc 41 fwxzel)'(8 . "jmd")'(10 1 2)(list 11 (car zjzb)(cadr zjzb))'(72 . 1)'(73 . 2)))
(entmake fwxzel)
(entdel fwxzen)
)
)
)
)
)
(alert"运行完毕")
(princ)
)
真正的门外汉飘过…… langjs 发表于 2012-4-26 17:56 static/image/common/back.gif
真正的门外汉飘过……
大师严重了，涉及测绘的人比较少，故而大师对测绘不是很熟悉，但lisp方面还需要向大师学习。 取之于明用之于明，谢楼主分享 将房屋内注记（含房屋性质注记和层数注记）移到房屋右上角到底是为了什么啊？难道图面好看些吗 树櫴希德 发表于 2015-8-31 11:54
将房屋内注记（含房屋性质注记和层数注记）移到房屋右上角到底是为了什么啊？难道图面好看些吗
2007版图示好像是要求放右上角 测试了一下，只有一部分能成功。是不是对房屋和注记有什么特殊要求？ yuanziyou 发表于 2015-8-31 17:04 static/image/common/back.gif
2007版图示好像是要求放右上角
图式要求都是注记在中间,宅基地有的县要求与宗地信息避让时,结构层数注在房屋的左下,右下等. yuanziyou 发表于 2015-8-31 17:04 static/image/common/back.gif
2007版图示好像是要求放右上角
图式要求都是注记在中间,宅基地有的县要求与宗地信息避让时,结构层数注在房屋的左下,右下等. 你好，这个程序不太明白怎么使用，能麻烦您说明一下吗？不懂程序的人。
页:
[1]