请教个问题一直困扰着我

liu_159 · 发表于 2013-10-4 14:20:19

如题:在一个包括直线缓和曲线等多种元素的多义线上从一个已知点开始取一定的长度有没有什么小工具?就像线路软件里面标里程桩号那样的

spp_wall · 发表于 2013-10-4 17:31:55

看看这个是否有用？
(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)
)

ysq101 · 发表于 2013-10-5 16:47:29

好不好楼主发个话啊。。。别让热心凉一边去啊

liu_159 · 发表于 2013-10-14 15:41:45

ysq101 发表于 2013-10-5 16:47
好不好楼主发个话啊。。。别让热心凉一边去啊

不好意思哈出差了几天才来回复

liu_159 · 发表于 2013-10-14 15:43:02

spp_wall 发表于 2013-10-4 17:31
看看这个是否有用？
(vl-load-com)
(defun c:zhcx ();桩号查询

楼主这个是线路上用的我说的就是一个弯桥这个的比如我要分跨从一个已知点过去29.92m这样的能点取不呢？

liu_159 · 发表于 2013-10-14 15:45:11

本帖最后由 liu_159 于 2013-10-14 15:58 编辑

我的意思大概就像直线上的offset一样的那样不过是在曲线上的offset功能

xyp1964 · 发表于 2013-10-14 20:52:34

(defun c:tt (/ i ss s1 pt)
(setq dist (Udist 7 "" "距离<输入或鼠标直接量取>" dist nil))
(setq s1 (car (entsel "\n选择曲线: ")))
(while (setq p1 (getpoint "\n基点<退出>: "))
(setq pt (vlax-curve-getclosestpointto s1 p1))
(setq l1 (xyp-Get-LengthAtPoint s1 pt)
leng (xyp-get-CurveLength s1)
)
;|(if (>= (setq l2 (- l1 dist)) 0)
(progn
(setq p1 (xyp-Get-CurvePointAtDist s1 l2))
(xyp-Cross p1 200 1)
)
)|;
(if (<= (setq l2 (+ l1 dist)) leng)
(progn
(setq p1 (xyp-Get-CurvePointAtDist s1 l2))
(xyp-Cross p1 200 1)
)
)
)
(princ)
)

liu_159 · 发表于 2013-10-15 10:54:52

xyp1964 发表于 2013-10-14 20:52

运行提示错误为什么呢？

xyp1964 · 发表于 2013-10-15 22:57:44

liu_159 · 发表于 2013-10-16 13:11:18

liu_159 发表于 2013-10-15 10:54
运行提示错误为什么呢？

院长帮我搞定了谢谢

账号		自动登录	找回密码
密码			注册

[已解答] 请教个问题一直困扰着我

点评

本帖子中包含更多资源

[已解答] 请教个问题 一直困扰着我

点评

本帖子中包含更多资源

[已解答] 请教个问题一直困扰着我