求修改个程序 读取曲线桩号后生成以下格式的txt格式
本帖最后由 spp_wall 于 2013-9-24 21:40 编辑如题 有没什么软件能实现？
现在纬地的标注只能标注 固定的桩号！ 如果要标注任意点的桩号 还是比较繁琐比如市政道路的路幅宽度 渐变段太多 现在的方法改路幅宽度很麻烦，找了很多地方都没有找到修改纬地路幅宽度的好办法，不知道有没同行有更好的办法呢？
下面这个lsp能实现标注任意点桩号但是 没有生成文本格式
如果可以 谁有能力希望能完善成下面的格式就是纬地的wid格式
点取主线一点 输出这个点的桩号然后点取下一点 输出距离 点下个点输出距离
格式如下：
ZZZZZZZ （左幅）
桩号 距离1 距离2 距离3 距离4 距离5
0.000 1.00 17.00 0.00 0.00 0.00 0
280.000 1.00 17.00 0.00 0.00 0.00 0
280.000 1.00 11.50 0.00 0.00 0.00 0
1612.586 1.00 11.50 0.00 0.00 0.00 0
(vl-load-com)
(vl-load-com)
(defun c:zhcx ();桩号查询
(prompt "2010-07-27 zo rooCGGC 武赤公路")
(prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")
(setq old_lay (getvar "clayer"))
(if (=(tblobjname "LAYER" "桩号标注") nil)
(progn
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(6 . "CONTINUOUS")
'(62 . 3)
'(70 . 0)
(cons 2 "桩号标注")
)
)
)
)
(setvar "clayer" "桩号标注")
(setq en(entsel "\n选择道路中心线: ")
a (getreal "\n请输入起点桩号:")
e (car en)
pt(cadr en)
)
(if (setq len (getreal "\n输入垂线长度(道路半幅宽):")) ;此处要加入非法输入的控制
(progn
(setq OBJ (vlax-ename->vla-object (car en)))
)
)
(while (setq pt0 (getPoint "\n选择查询点："))
;画曲线的垂线
(setq Perpt (vlax-curve-getClosestPointTo OBJ pt0 T)
LST (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))
ANG (atan (/ (cadr LST) (car LST)))
pt1 (polar Perpt (+ ANG (* 0.5 pi)) len)
pt2 (polar Perpt (- ANG (* 0.5 pi)) len)
;此处就是你画出来的是水平线的原因，变量换个方向即可
)
(setq ang2 (angtos (angle pt2 pt1)0 4) )
(command "pline" pt1 pt2 "")
;计算桩号
(setq leng (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
leng1 (+ a (vlax-curve-getDistAtPoint e Perpt))
leng2 (- leng leng1)
)
;计算桩号
(if (< leng1 0.0) (setq fh "-") (setq fh "+"))
(setq nn1 (fix (/ leng1 1000.0 )))
(setq nn2 (abs(- leng1 (* 1000.0 nn1 ))))
(if(= nn2 0.0) (setq str_1 (strcat fh "00" )))
(if(and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "00" ) (rtos nn2 2 3))))
(if(and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 3))))
(if(>= nn2 100.0)(setq str_1 (strcat fh (rtos nn2 2 3))))
(setq str_1 (strcat "K"(rtos nn1 2 0)"+" (rtos nn2 2 3) ))
(setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67))))
(command "text" "j" "MC" pt4 "0.3" ang2 str_1)
(setq py (rtos (nth 0 pt0)));提取测量坐标系Y值
(setq px (rtos (nth 1 pt0)));提取测量坐标洗X值
(setq pxy (strcat str_1"中桩坐标：X="px",Y="py))
(princ pxy)
)
(princ)
)
(vl-load-com)
(defun c:zhcx (/ a ang ang2 e en fh file len leng leng1 leng2 lst nn1 nn2 obj old_lay perpt pt pt0
pt1 pt2 pt4 px pxy py str_1) ;桩号查询
(prompt "2010-07-27 zo rooCGGC 武赤公路")
(prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")
(setq old_lay (getvar "clayer"))
(if (= (tblobjname "LAYER" "桩号标注") nil)
(progn
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(6 . "CONTINUOUS")
'(62 . 3)
'(70 . 0)
(cons 2 "桩号标注")
)
)
)
)
(setvar "clayer" "桩号标注")
(setq en (entsel "\n选择道路中心线: ")
a(getreal "\n请输入起点桩号:")
e(car en)
pt (cadr en)
)
(if (setq len (getreal "\n输入垂线长度(道路半幅宽):")) ;此处要加入非法输入的控制
(progn
(setq obj (vlax-ename->vla-object (car en)))
)
)
;; A1 追加方式打开保存文件
(if (null filename)
(setq filename (getfiled
"保存到文件"
(strcat (getvar "dwgprefix")
(vl-filename-base (getvar "dwgname"))
)
"txt"
1
)
)
)
(setq file (open filename "a"))
(setvar "DIMZIN" 0)
(while (setq pt0 (getpoint "\n选择查询点："))
;画曲线的垂线
(setq perpt (vlax-curve-getclosestpointto obj pt0 t)
lst (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj perpt))
ang (atan (/ (cadr lst) (car lst)))
pt1 (polar perpt (+ ang (* 0.5 pi)) len)
pt2 (polar perpt (- ang (* 0.5 pi)) len)
;此处就是你画出来的是水平线的原因，变量换个方向即可
)
(setq ang2 (angtos (angle pt2 pt1) 0 4))
(command "pline" pt1 pt2 "")
;计算桩号
(setq leng (vlax-curve-getdistatparam e (vlax-curve-getendparam e))
leng1 (+ a (vlax-curve-getdistatpoint e perpt))
leng2 (- leng leng1)
)
;计算桩号
(if (< leng1 0.0)
(setq fh "-")
(setq fh "+")
)
(setq nn1 (fix (/ leng1 1000.0)))
(setq nn2 (abs (- leng1 (* 1000.0 nn1))))
(if (= nn2 0.0)
(setq str_1 (strcat fh "00"))
)
(if (and (> nn2 0) (< nn2 10.0))
(setq str_1 (strcat (strcat fh "00") (rtos nn2 2 3)))
)
(if (and (> nn2 10.0) (< nn2 100.0))
(setq str_1 (strcat (strcat fh "0") (rtos nn2 2 3)))
)
(if (>= nn2 100.0)
(setq str_1 (strcat fh (rtos nn2 2 3)))
)
(setq str_1 (strcat "K" (rtos nn1 2 0) "+" (rtos nn2 2 3)))
(setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67))))
(command "text" "j" "MC" pt4 "0.3" ang2 str_1)
;; A2 保存数据
(setq strout (rtos leng1 2 3))
(write-distance pt0 file strout)
(setq py (rtos (nth 0 pt0))) ;提取测量坐标系Y值
(setq px (rtos (nth 1 pt0))) ;提取测量坐标洗X值
(setq pxy (strcat str_1 "中桩坐标：X=" px ",Y=" py))
(princ pxy)
)
;; A3 关闭文件
(close file)
(princ)
)
(defun write-distance (p file str /)
(princ "\n输出各点距离，回车退出")
(while (setq p2 (getpoint p "指定下一点:"))
(setq str (strcat str "\t" (rtos (distance p2 p) 2 2))
p p2
)
)
(write-line str file)
) 本帖最后由 spp_wall 于 2013-9-22 11:53 编辑
如果能实现下面说的功能还可以追加明经B
点取主线一点 输出这个点的桩号然后点取下一点 输出距离 点下个点输出距离
格式如下：
ZZZZZZZ （左幅）
桩号 距离1 距离2 距离3 距离4 距离5
0.000 1.00 17.00 0.00 0.00 0.00 0
280.000 1.00 17.00 0.00 0.00 0.00 0
280.000 1.00 11.50 0.00 0.00 0.00 0
1612.586 1.00 11.50 0.00 0.00 0.00 0
能附个DWG格式的测试图吗？ 期待高手能帮助解决 scream2658 发表于 2013-9-22 19:56 static/image/common/back.gif
能附个DWG格式的测试图吗？
已经添加了测试文件希望能帮帮忙！ 楼主，你说的功能用LISP都能实现，可能是你这个东西专业性太强了吧。我一直没明白你说的距离是什么意思？ 是基于某个已知桩号，然后求人为指定点与这个已知桩的距离吗？还有你给的示例DWG图还是不太清晰。看了你的图几遍，真不知道你要求的是什么。麻烦你再说的具体点。因为写LISP的，不一定都是你这个行业的，所谓隔行如隔山。你要别人能帮你，你可能先要花点时间跟大家解释明白你要实现的目的。专业方面的东西最好也能讲讲，这样大家也好帮助你。 本帖最后由 spp_wall 于 2013-9-23 15:11 编辑
scream2658 发表于 2013-9-23 14:39 static/image/common/back.gif
楼主，你说的功能用LISP都能实现，可能是你这个东西专业性太强了吧。我一直没明白你说的距离是什么意思？ 是 ...
应该不会吧
上面的lsp 实现了在曲线上标注中心桩号 其实也就是曲线长度 接下来要实现的就是下面的内容
1：把提取的中心桩号 提取到文本比如你点一下曲线上的点 出现280 把这个数字提取出来 就是我的回复里面的格式中的桩号下的280.这时候的点称点1 是曲线上的点 这个曲线就是道路的中心线 一般道路分左右两侧
2：由于道路分两侧 所以回复中格式有ZZZZ(左幅) 这样来区分左边很右边道路
3：再点一个点 这里称点2 这个点与开始曲线上点的距离就是回复中格式下的距离1
4：继续点一点 就是点三距离3就是点2与点3的距离
5：以此类推 距离四就是点3与点4的距离了
6：距离点完后重新拾取一个曲线上的点也就是道路中心上的一个点循环前面的1-5条要求
7：继续点曲线上的点 循环前面的1-5条要求
后面的都是循环了把循环的桩号和距离按回复中的那样 生成txt格式就OK了 scream2658 发表于 2013-9-23 14:39 static/image/common/back.gif
楼主，你说的功能用LISP都能实现，可能是你这个东西专业性太强了吧。我一直没明白你说的距离是什么意思？ 是 ...
放上了数据形成的录像你看看有用么！ 能问下，这个距离是两点沿曲线的距离？还是点到点之间的最近距离？
页:
[1]
2