★★★★★求高手完善下这个程序！提取完数据后再复制一遍★★★★★
本帖最后由 spp_wall 于 2013-9-28 19:28 编辑完善下面这个程序
1.现在点取距离没问题 但是有时候输入距离会出问题 是否能实现手输入距离和点取距离都不出现问题
2.每次提取完数据后自动复制一次数据
起止桩号中分带行车道附加车道硬路肩土路肩
起点0016.5000
终点107.977016.5000
起点107.977016.5000
终点137.977011.5000
3：如果能实现提取距离前提示那就更完美了提示上面的 中分带、行车道、附加车道、硬路肩、土路肩 然后再提取距离或者手工输入距离 如果是没有就手输入0记录下来
(vl-load-com)
(defun c:wid (/ 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 "2013-9-22vectra 待兔惠州路桥 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))
(get-distance "中分带" 'wid-dist1 'strout)
(get-distance "行车道" 'wid-dist2 'strout)
(get-distance "附加车道" 'wid-dist3 'strout)
(get-distance "硬路肩" 'wid-dist4 'strout)
(get-distance "土路肩" 'wid-dist5 'strout)
(write-line strout file)
(write-line strout file)
(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 get-distance (msg default buffer / dist)
(if (null (vl-symbol-value default))
(set default 0.0)
)
(setq dist (getdist (strcat "\n输入" msg "距离 <" (rtos (vl-symbol-value default) 2 2) ">:")))
(if (null dist)
(setq dist (vl-symbol-value default))
(set default dist)
)
(set buffer (strcat (vl-symbol-value buffer) "\t" (rtos dist 2 2)))
) "每次提取完数据后自动复制一次数据“这句话是什么意思？ 我试 了，上面的代码很好用啊，可以用来读钻孔里程及偏移 本帖最后由 spp_wall 于 2013-9-28 16:44 编辑
清风明月名字 发表于 2013-9-28 12:57 static/image/common/back.gif
"每次提取完数据后自动复制一次数据“这句话是什么意思？
现在的格式不太符合我需要的格式
我想把每次提取的桩号和距离 重复一次
比如
现在的桩号只是每一段道路的起点的桩号我的数据还需要每段的终点桩号
而这个终点桩号其实就是下一段道路的起点桩号
所以把每次提取的桩号和距离 重复一遍就可以完成了 vectra 发表于 2013-9-28 11:00 static/image/common/back.gif
谢谢！！！！！！
页:
[1]