求修改个程序 读取曲线桩号后生成以下格式的txt格式

spp_wall

   如题   有没什么软件能实现？

   现在纬地的标注只能标注 固定的桩号！ 如果要标注任意点的桩号 还是比较繁琐  比如市政道路的路幅宽度 渐变段太多 现在的方法改路幅宽度很麻烦，找了很多地方都没有找到修改纬地路幅宽度的好办法，不知道有没同行有更好的办法呢？

下面这个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 roo  CGGC 武赤公路")
(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)
)

vectra

1. (vl-load-com)
   
2. 
   
3. (defun c:zhcx (/ a ang ang2 e en fh file len leng leng1        leng2 lst nn1 nn2 obj old_lay perpt pt pt0
   
4.                pt1 pt2 pt4 px pxy py str_1) ;桩号查询
   
5.   (prompt "2010-07-27 zo roo  CGGC 武赤公路")
   
6.   (prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")
   
7.   (setq old_lay (getvar "clayer"))
   
8.   (if (= (tblobjname "LAYER" "桩号标注") nil)
   
9.     (progn
   
10.       (entmake (list
    
11.                  '(0 . "LAYER")
    
12.                  '(100 . "AcDbSymbolTableRecord")
    
13.                  '(100 . "AcDbLayerTableRecord")
    
14.                  '(6 . "CONTINUOUS")
    
15.                  '(62 . 3)
    
16.                  '(70 . 0)
    
17.                  (cons 2 "桩号标注")
    
18.                )
    
19.       )
    
20.     )
    
21.   )
    
22.   (setvar "clayer" "桩号标注")
    
23.   (setq        en (entsel "\n选择道路中心线: ")
    
24.         a  (getreal "\n请输入起点桩号:")
    
25.         e  (car en)
    
26.         pt (cadr en)
    
27.   )
    
28.   (if (setq len (getreal "\n输入垂线长度(道路半幅宽):")) ;此处要加入非法输入的控制
    
29.     (progn
    
30.       (setq obj (vlax-ename->vla-object (car en)))
    
31.     )
    
32.   )
    
33. 
    
34.   ;; A1 追加方式打开保存文件
    
35.   (if (null filename)
    
36.     (setq filename (getfiled
    
37.                      "保存到文件"
    
38.                      (strcat (getvar "dwgprefix")
    
39.                              (vl-filename-base (getvar "dwgname"))
    
40.                      )
    
41.                      "txt"
    
42.                      1
    
43.                    )
    
44.     )
    
45.   )
    
46.   (setq file (open filename "a"))
    
47.   (setvar "DIMZIN" 0)
    
48. 
    
49. 
    
50. 
    
51.   (while (setq pt0 (getpoint "\n选择查询点："))
    
52.                                         ;画曲线的垂线
    
53.     (setq perpt        (vlax-curve-getclosestpointto obj pt0 t)
    
54.           lst        (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj perpt))
    
55.           ang        (atan (/ (cadr lst) (car lst)))
    
56.           pt1        (polar perpt (+ ang (* 0.5 pi)) len)
    
57.           pt2        (polar perpt (- ang (* 0.5 pi)) len)
    
58.                                         ;此处就是你画出来的是水平线的原因，变量换个方向即可
    
59.     )
    
60.     (setq ang2 (angtos (angle pt2 pt1) 0 4))
    
61.     (command "pline" pt1 pt2 "")
    
62.                                         ;计算桩号
    
63.     (setq leng        (vlax-curve-getdistatparam e (vlax-curve-getendparam e))
    
64.           leng1        (+ a (vlax-curve-getdistatpoint e perpt))
    
65.           leng2        (- leng leng1)
    
66.     )
    
67.                                         ;计算桩号
    
68.     (if        (< leng1 0.0)
    
69.       (setq fh "-")
    
70.       (setq fh "+")
    
71.     )
    
72.     (setq nn1 (fix (/ leng1 1000.0)))
    
73.     (setq nn2 (abs (- leng1 (* 1000.0 nn1))))
    
74.     (if        (= nn2 0.0)
    
75.       (setq str_1 (strcat fh "00"))
    
76.     )
    
77.     (if        (and (> nn2 0) (< nn2 10.0))
    
78.       (setq str_1 (strcat (strcat fh "00") (rtos nn2 2 3)))
    
79.     )
    
80.     (if        (and (> nn2 10.0) (< nn2 100.0))
    
81.       (setq str_1 (strcat (strcat fh "0") (rtos nn2 2 3)))
    
82.     )
    
83.     (if        (>= nn2 100.0)
    
84.       (setq str_1 (strcat fh (rtos nn2 2 3)))
    
85.     )
    
86. 
    
87.     (setq str_1 (strcat "K" (rtos nn1 2 0) "+" (rtos nn2 2 3)))
    
88.     (setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67))))
    
89.     (command "text" "j" "MC" pt4 "0.3" ang2 str_1)
    
90. 
    
91.     ;; A2 保存数据
    
92.     (setq strout (rtos leng1 2 3))
    
93.     (write-distance pt0 file strout)
    
94. 
    
95. 
    
96.     (setq py (rtos (nth 0 pt0)))        ;提取测量坐标系Y值
    
97.     (setq px (rtos (nth 1 pt0)))        ;提取测量坐标洗X值
    
98.     (setq pxy (strcat str_1 "中桩坐标：X=" px ",Y=" py))
    
99.     (princ pxy)
    
100.   )
     
101. 
     
102.   ;; A3 关闭文件
     
103.   (close file)
     
104.   (princ)
     
105. )
     
106. 
     
107. (defun write-distance (p file str /)
     
108.   (princ "\n输出各点距离，回车退出")
     
109. 
     
110.   (while (setq p2 (getpoint p "指定下一点:"))
     
111.     (setq str (strcat str "\t" (rtos (distance p2 p) 2 2))
     
112.           p   p2
     
113.     )
     
114.   )
     
115.   (write-line str file)
     
116. )

(vl-load-com)<br /> <br /> (defun c:zhcx (/ a ang ang2 e en fh file len leng leng1        leng2 lst nn1 nn2 obj old_lay perpt pt pt0<br />                pt1 pt2 pt4 px pxy py str_1) ;桩号查询<br />   (prompt "2010-07-27 zo roo  CGGC 武赤公路")<br />   (prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")<br />   (setq old_lay (getvar "clayer"))<br />   (if (= (tblobjname "LAYER" "桩号标注") nil)<br />     (progn<br />       (entmake (list<br />                  '(0 . "LAYER")<br />                  '(100 . "AcDbSymbolTableRecord")<br />                  '(100 . "AcDbLayerTableRecord")<br />                  '(6 . "CONTINUOUS")<br />                  '(62 . 3)<br />                  '(70 . 0)<br />                  (cons 2 "桩号标注")<br />                )<br />       )<br />     )<br />   )<br />   (setvar "clayer" "桩号标注")<br />   (setq        en (entsel "\n选择道路中心线: ")<br />         a  (getreal "\n请输入起点桩号:")<br />         e  (car en)<br />         pt (cadr en)<br />   )<br />   (if (setq len (getreal "\n输入垂线长度(道路半幅宽):")) ;此处要加入非法输入的控制<br />     (progn<br />       (setq obj (vlax-ename->vla-object (car en)))<br />     )<br />   )<br /> <br />   ;; A1 追加方式打开保存文件<br />   (if (null filename)<br />     (setq filename (getfiled<br />                      "保存到文件"<br />                      (strcat (getvar "dwgprefix")<br />                              (vl-filename-base (getvar "dwgname"))<br />                      )<br />                      "txt"<br />                      1<br />                    )<br />     )<br />   )<br />   (setq file (open filename "a"))<br />   (setvar "DIMZIN" 0)<br /> <br /> <br /> <br />   (while (setq pt0 (getpoint "\n选择查询点："))<br />                                         ;画曲线的垂线<br />     (setq perpt        (vlax-curve-getclosestpointto obj pt0 t)<br />           lst        (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj perpt))<br />           ang        (atan (/ (cadr lst) (car lst)))<br />           pt1        (polar perpt (+ ang (* 0.5 pi)) len)<br />           pt2        (polar perpt (- ang (* 0.5 pi)) len)<br />                                         ;此处就是你画出来的是水平线的原因，变量换个方向即可<br />     )<br />     (setq ang2 (angtos (angle pt2 pt1) 0 4))<br />     (command "pline" pt1 pt2 "")<br />                                         ;计算桩号<br />     (setq leng        (vlax-curve-getdistatparam e (vlax-curve-getendparam e))<br />           leng1        (+ a (vlax-curve-getdistatpoint e perpt))<br />           leng2        (- leng leng1)<br />     )<br />                                         ;计算桩号<br />     (if        (< leng1 0.0)<br />       (setq fh "-")<br />       (setq fh "+")<br />     )<br />     (setq nn1 (fix (/ leng1 1000.0)))<br />     (setq nn2 (abs (- leng1 (* 1000.0 nn1))))<br />     (if        (= nn2 0.0)<br />       (setq str_1 (strcat fh "00"))<br />     )<br />     (if        (and (> nn2 0) (< nn2 10.0))<br />       (setq str_1 (strcat (strcat fh "00") (rtos nn2 2 3)))<br />     )<br />     (if        (and (> nn2 10.0) (< nn2 100.0))<br />       (setq str_1 (strcat (strcat fh "0") (rtos nn2 2 3)))<br />     )<br />     (if        (>= nn2 100.0)<br />       (setq str_1 (strcat fh (rtos nn2 2 3)))<br />     )<br /> <br />     (setq str_1 (strcat "K" (rtos nn1 2 0) "+" (rtos nn2 2 3)))<br />     (setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67))))<br />     (command "text" "j" "MC" pt4 "0.3" ang2 str_1)<br /> <br />     ;; A2 保存数据<br />     (setq strout (rtos leng1 2 3))<br />     (write-distance pt0 file strout)<br /> <br /> <br />     (setq py (rtos (nth 0 pt0)))        ;提取测量坐标系Y值<br />     (setq px (rtos (nth 1 pt0)))        ;提取测量坐标洗X值<br />     (setq pxy (strcat str_1 "中桩坐标：X=" px ",Y=" py))<br />     (princ pxy)<br />   )<br /> <br />   ;; A3 关闭文件<br />   (close file)<br />   (princ)<br /> )<br /> <br /> (defun write-distance (p file str /)<br />   (princ "\n输出各点距离，回车退出")<br /> <br />   (while (setq p2 (getpoint p "指定下一点:"))<br />     (setq str (strcat str "\t" (rtos (distance p2 p) 2 2))<br />           p   p2<br />     )<br />   )<br />   (write-line str file)<br /> )

spp_wall

如果能实现下面说的功能  还可以追加明经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

scream2658

能附个DWG格式的测试图吗？

清风明月名字

期待高手能帮助解决

spp_wall

scream2658 发表于 2013-9-22 19:56
能附个DWG格式的测试图吗？

已经添加了测试文件  希望能帮帮忙！

scream2658

楼主，你说的功能用LISP都能实现，可能是你这个东西专业性太强了吧。我一直没明白你说的距离是什么意思？ 是基于某个已知桩号，然后求人为指定点与这个已知桩的距离吗？还有你给的示例DWG图还是不太清晰。看了你的图几遍，真不知道你要求的是什么。麻烦你再说的具体点。因为写LISP的，不一定都是你这个行业的，所谓隔行如隔山。你要别人能帮你，你可能先要花点时间跟大家解释明白你要实现的目的。专业方面的东西最好也能讲讲，这样大家也好帮助你。

spp_wall

scream2658 发表于 2013-9-23 14:39
楼主，你说的功能用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了

spp_wall

scream2658 发表于 2013-9-23 14:39
楼主，你说的功能用LISP都能实现，可能是你这个东西专业性太强了吧。我一直没明白你说的距离是什么意思？ 是 ...

放上了数据形成的录像  你看看有用么！

scream2658

能问下，这个距离是两点沿曲线的距离？还是点到点之间的最近距离？