明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 32022|回复: 31

道路桩号标注(批量标注、任意点标注)

  [复制链接]
发表于 2012-12-18 10:35 | 显示全部楼层 |阅读模式
本帖最后由 skg123 于 2014-8-26 20:35 编辑

   做公路的同行常常需要标注公路的中桩号,本人结合自己的需要在别人的程序上修改了标注程序。
批量标注,可以按照要求的间距标注,首尾保留小数。将中桩坐标写入文本

  1. ;By Zo Roo     CGGC 基础公司
  2. ;By zo roo 葛洲坝基础公司
  3. ;2010-5-9 修改了小数保留位数(保留0位)
  4. ;2011-6-15修改了尾桩号小数位数(保留3位);设置捕捉,标注线不乱连接,增加桩号步长设置。
  5. (terpri)
  6.    (If (= (Tblsearch "layer" "道路桩号") nil)
  7.        (Command "layer" "m" "道路桩号" "c" 7 "道路桩号" "")
  8.    )
  9. (If (= (Tblsearch "layer" "道路中心线") nil)
  10.     (Command "layer" "m" "道路中心线" "c" 1 "道路中心线" "")
  11. )
  12.    (setq dq 0.0)
  13.    (setq wf 1.0)
  14.    (setq fx 1.0)
  15.    (setq th 2.0)
  16.    (setq zk 0.67)
  17.    (Command "-style" "道路桩号" "仿宋_GB2312" "" zk ""  "n" "n")
  18.    (setq qszh 0.0)
  19.    (setq qz "")
  20.    (setq qmw 0)
  21. (vl-load-com)
  22. (prompt "\n批量标注桩号,加载命令:plbzzh,设置(SZ)。By 罗泽钢 葛洲坝基础公司")
  23. (defun c:plbzzh()
  24. (setvar "cmdecho" 0)
  25. (setq ff (open (getfiled "文件保存为" "c:/" "dat" 1) "a"))
  26. (bzzh)
  27. );修改于2012-01-11增加了将数据写入文本
  28. (defun bzzh()
  29.    (setvar "cmdecho" 0)
  30.    (setq os (getvar "osmode"))
  31.    (setq FltLst '((0 . "LWPOLYLINE,POLYLINE,LINE,ARC")))
  32.     (princ "\n\n\n\n     请先把预标注的曲线(多段线)连接在一起,如果已经连接好,回车跳过即可 ")
  33.    (setq SelSet (cond ((ssget "_I" FltLst)) ((ssget FltLst))))
  34.     (if (/= nil selset) (command "change" SelSet "" "p" "la" "道路中心线" ""))
  35.        (if (/= nil selset)
  36.        (if (> (sslength selset) 1)
  37.            (command "_.PEDIT" "_M" SelSet "" "_Y" "_J" "_J" "_B" "0" "")
  38.        )
  39.        )
  40.      (setq en (car (entsel "\n选择标注曲线:")))
  41.          (while (= nil en)
  42.          (setq en (car (entsel "\n选择标注曲线:")))
  43.        )
  44.    (if (vlax-curve-isClosed en)
  45.                (progn
  46.                     (print "曲线为环路!请先打开个缺口!")
  47.                     (exit)
  48.                )
  49.    )
  50.      (redraw en 3)
  51.    (command "change" en "" "p" "la" "道路中心线" "")
  52.    (setq qd (getpoint "\n选取已知点:"))
  53.    (while (not (vlax-curve-getDistAtPoint en qd))
  54.    (setq qd (getpoint "\n\n\n没有选在标注曲线上,重新选择:"))
  55.    )
  56.   (setq leng (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en) ))  ;;;道路总长
  57.     (if (= nil (setq qszh (getreal "\n请输入已知点桩号<0>:"))) (setq qszh 0))
  58.     (if (= nil (setq dist (getreal "\n请输入桩号间距<20>:"))) (setq dist 20))
  59.    (setq qszh (- qszh (* (vlax-curve-getDistAtPoint en qd) fx)))
  60.     (setvar "osmode" 0) ;关闭捕捉
  61.         (command "._erase" (ssget "x" (list (cons 8 "道路桩号"))) "")     (setq pzh (fix(/ qszh dist)))
  62.     (setq pzh (- qszh (* pzh dist)))
  63.      (if (= fx 1.0)
  64.      (setq pt1 (vlax-curve-getStartPoint en))
  65.      (setq pt1 (vlax-curve-getEndPoint en))
  66.       )
  67.    (if (= fx 1.0)
  68.     (setq zhz 0)
  69.     (setq zhz (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en)))
  70.      )
  71.      (setq zhz (+ zhz (* qszh fx)))
  72.    (setq zhz (* zhz fx))
  73.      (xrbz)
  74.      (setq nn 0)
  75.      (while
  76.      (setq pt1 (vlax-curve-getPointAtDist en (abs(- (* nn (* dist fx)) pzh))))
  77.      (setq zhz (* nn (* dist fx)))
  78.      (setq zhz (+ zhz (- qszh pzh)))
  79.      (xrbz)
  80.      (setq nn (1+ nn))
  81.      )
  82.      (if (= fx 1.0)
  83.          (setq pt1 (vlax-curve-getEndPoint en))
  84.          (setq pt1 (vlax-curve-getStartPoint en))
  85.      )
  86.    (if (= fx 1.0)
  87.     (setq zhz (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en)))
  88.     (setq zhz 0)
  89.      )
  90.     (setq zhz (+ zhz (* qszh fx)))
  91.       (setq zhz (* zhz fx))
  92.     (xrbz)
  93.    )
  94.   (defun xrbz(/)
  95.     (Command "layer" "s" "道路桩号"  "")
  96.     (if (< zhz 0.0) (setq fh "-") (setq fh "+"))
  97.      (setq nn1 (fix (/ zhz 1000.0)))
  98.      (setq nn2 (abs(- zhz (* 1000.0 nn1))))
  99.      (if  (= nn2 0.0) (setq str_1 (strcat fh "00" )))
  100.      (if  (and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "000" ) (rtos nn2 2 3))))
  101.      (if  (and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 0))))
  102.      (if  (>= nn2 100.0)  (setq str_1 (strcat fh (rtos nn2 2 0))))
  103. (if  (= zhz leng)  (setq str_1 (strcat fh (rtos nn2 2 3)))) ;;修改部分2011-06-14
  104.    (if (= qmw 0)
  105.      (if (=  (fix (/ nn2 100.0)) (/ nn2 100.0))
  106.        (progn
  107.          (setq str_1 (strcat "K" (rtos nn1 2 0)  str_1 ))
  108.          (setq str_1 (strcat qz str_1 ))
  109.        )
  110.      )
  111.      (progn
  112.      (setq str_1 (strcat (rtos nn1 2)  str_1 ))
  113.              (setq str_1 (strcat qz str_1 ))
  114.     )
  115.    )
  116.      (setq ang (a-get-Angle en pt1))
  117.      (setq pt2 (polar pt1 (+ ang (/ pi 2)) (* th 2.2)))
  118.      (setq pt3 (polar pt1 (+ ang (* pi 1.5)) (* th 1)))
  119.      (setq st1 (substr str_1 1 1))
  120.      (if (/=  st1 fh)
  121.        (progn
  122.        (if (= wf 1.0)
  123.            (setq pt4 (polar pt1 (+ (* pi 1.5) ang) (* th (* 1.65406 zk))))
  124.            (setq pt4 (polar pt1 (+ (* pi 0.5) ang) (* th (* 1.65406 zk))))
  125.        )
  126.        )
  127.        (progn
  128.        (if (= wf 1.0)
  129.            (setq pt4 (polar pt1 (+ (* pi 1.5) ang) (* th (* 1.3582 zk))))
  130.            (setq pt4 (polar pt1 (+ (* pi 0.5) ang) (* th (* 1.3582 zk))))
  131.        )
  132.        )
  133.      )
  134.      (command "line" pt3 pt2 "")
  135.      (if (= wf 1.0)
  136.      ;  (setq ang2 (angtos (angle pt1 pt2)0 4) )
  137.         (setq ang2 (angtos (angle pt2 pt1)0 4) )
  138.      )
  139.      (command "text" "bc"  pt1 th ang2 str_1 ) ;2014-08-26
  140.     (setq x01 (car pt1))
  141.     (setq y01 (cadr pt1))
  142.     (setq str_1 (strcat (rtos zhz 2 3)  ",," (rtos y01 2 3) "," (rtos x01 2 3)",0"))
  143.     (write-line str_1 ff);中桩写入文本(2012-01-10修改)
  144.    (write-line str_1 );显示中桩桩号坐标(2012-01-10修改)
  145.   (princ)
  146. )

  147.   (setvar "osmode" 703) ;恢复捕捉
  148. (defun a-get-Angle(ename point / p1 v1 pt-ang)
  149.   (setq v1 (vlax-curve-getfirstderiv ename (vlax-curve-getparamatpoint ename point))
  150.     p1 (mapcar '+ point v1)
  151.     pt-ang (angle point p1))
  152.         pt-ang
  153.   )

  154. (defun c:sz ()
  155.    (setq xz 1)
  156.    (while (/= xz "")
  157.    (setq xz (getstring "\n\n\n\n [回车退出/文字高度(H)/文字宽度比例(B)/桩号间距(J)/桩号标注方向(F)/文字方向(X)/前缀(Z)/千米位(Q)]:"))
  158.   (cond
  159.      ((= xz "H") "h")
  160.      ((= xz "B") "b")
  161.      ((eq xz "J") "j")
  162.      ((eq xz "F") "f")
  163.      ((eq xz "X") "x")
  164.      ((eq xz "Z") "z")
  165.      ((eq xz "Q") "q")
  166.      (T xz)
  167. )
  168.    (if (= xz nil) exit)
  169.    (if (= xz "h")
  170.      (progn
  171.    (setq str_2 (strcat "\n\n\n\n 文字高度<" (rtos (getvar "textsize") 2) ">:"))
  172.    (setq th (getreal str_2))
  173.     (if (= th nil) (setq th (getvar "textsize")))
  174.    )
  175.      )
  176.    (if (= xz "b")
  177.      (progn
  178.    (setq zk (getreal "\n\n\n\n\n [文字宽高比例]<0.67>:"))
  179.    (if (= zk nil)  (setq zk 0.67))
  180.    (Command "-style" "道路桩号" "仿宋_GB2312" "" zk ""  "n" "n")
  181.      )
  182. )
  183. (if (= xz "j")
  184.    (if (= nil (setq dist (getreal "\n\n\n\n\n [桩号间距]<20>:"))) (setq dist 20.0))
  185.   )
  186.    
  187.    (if (= xz "f")
  188.      (progn
  189.    (setq fxxz (getstring "\n\n\n\n\n [桩号标注方向[正(Z)/反(F)]<Z>:"))
  190.    (if (= fxxz nil) (setq fxxz "z"))
  191.    (if (= fxxz "z")
  192.        (setq fx 1.0)
  193.        (setq fx -1.0)
  194.     )
  195.      
  196.      (setq wf (* wf fx))
  197.     )
  198.      )
  199.       
  200. (if (= xz "x")
  201.   (progn
  202. (if (= nil (setq WZFX (getstring "\n\n\n\n\n 文字方向[前进(Q)/后退(H)]<Q>:"))) (setq WZFX "q"))
  203.       (if (= wzfx "q")
  204.        (setq wf 1.0)
  205.        (setq wf -1.0)
  206.     )
  207.   )
  208. )
  209. (if (= xz "z")
  210. (setq qz (getstring "\n\n\n\n\n 前缀(去除前缀请直接回车):"))
  211.   )
  212.       
  213. ;;;(initget 1 "1 0")
  214. (if (= xz "q")
  215. (if (= nil (setq qmw (getint "[整百桩位标注(0)/全部标注(1)]<0>:"))) (setq qmw 0))
  216. )
  217.       
  218.      )
  219.    )




任意点桩号标注
  1. (vl-load-com)
  2. (vl-load-com)
  3. (defun c:zhcx ();桩号查询
  4. (prompt "2010-07-27 zo roo  CGGC 武赤公路")
  5. (prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")
  6. (setq old_lay (getvar "clayer"))
  7. (if (=(tblobjname "LAYER" "桩号标注") nil)
  8.     (progn
  9.         (entmake (list
  10.                     '(0 . "LAYER")
  11.                     '(100 . "AcDbSymbolTableRecord")
  12.                     '(100 . "AcDbLayerTableRecord")
  13.                     '(6 . "CONTINUOUS")
  14.                     '(62 . 3)
  15.                     '(70 . 0)
  16.                     (cons 2 "桩号标注")
  17.                   )
  18.         )
  19.     )
  20. )
  21. (setvar "clayer" "桩号标注")
  22. (setq en  (entsel "\n选择道路中心线: ")
  23. a (getreal "\n请输入起点桩号:")
  24. e   (car en)
  25. pt  (cadr en)
  26. )
  27. (if (setq len (getreal "\n输入垂线长度(道路半幅宽):")) ;此处要加入非法输入的控制
  28.       (progn
  29. (setq OBJ (vlax-ename->vla-object (car en)))
  30. )
  31. )
  32. (while (setq pt0 (getPoint "\n选择查询点:"))
  33. ;画曲线的垂线
  34. (setq Perpt (vlax-curve-getClosestPointTo OBJ pt0 T)
  35.     LST   (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))
  36.     ANG   (atan (/ (cadr LST) (car LST)))
  37.     pt1   (polar Perpt (+ ANG (* 0.5 pi)) len)
  38.     pt2   (polar Perpt (- ANG (* 0.5 pi)) len)
  39.      ;此处就是你画出来的是水平线的原因,变量换个方向即可
  40.    )
  41. (setq ang2 (angtos (angle pt2 pt1)0 4) )
  42.    (command "pline" pt1 pt2 "")
  43. ;计算桩号
  44.   (setq leng (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
  45.   leng1 (+ a (vlax-curve-getDistAtPoint e Perpt))
  46.   leng2   (- leng leng1)
  47. )
  48. ;计算桩号
  49. (if (< leng1 0.0) (setq fh "-") (setq fh "+"))
  50. (setq nn1 (fix (/ leng1 1000.0 )))
  51. (setq nn2 (abs(- leng1 (* 1000.0 nn1 ))))
  52.      (if  (= nn2 0.0) (setq str_1 (strcat fh "00" )))
  53.      (if  (and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "00" ) (rtos nn2 2 3))))
  54.      (if  (and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 3))))
  55.      (if  (>= nn2 100.0)  (setq str_1 (strcat fh (rtos nn2 2 3))))
  56.    
  57.   (setq str_1 (strcat "K"(rtos nn1 2 0)"+" (rtos nn2 2 3) ))
  58.   (setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67))))
  59.   (command "text" "j" "MC" pt4 "0.3" ang2 str_1)
  60. (setq py (rtos (nth 0 pt0)));提取测量坐标系Y值
  61. (setq px (rtos (nth 1 pt0)));提取测量坐标洗X值
  62. (setq pxy (strcat str_1"中桩坐标:X="px",Y="py))
  63. (princ pxy)
  64. )
  65.   (princ)
  66. )



本帖被以下淘专辑推荐:

 楼主| 发表于 2014-8-26 20:47 | 显示全部楼层
本帖最后由 skg123 于 2014-8-29 09:36 编辑
  1. ;By luozegang 葛洲坝基础公司
  2. ;2010-5-9 修改了小数保留位数(保留0位)
  3. ;2011-6-15修改了尾桩号小数位数(保留3位);设置捕捉,标注线不乱连接,增加桩号步长设置。
  4. (terpri)
  5.    (If (= (Tblsearch "layer" "道路桩号") nil)
  6.        (Command "layer" "m" "道路桩号" "c" 1 "道路桩号" "")
  7.    )
  8. (If (= (Tblsearch "layer" "道路中心线") nil)
  9.     (Command "layer" "m" "道路中心线" "c" 1 "道路中心线" "")
  10. )
  11.    (setq dq 0.0)
  12.    (setq wf 1.0)
  13.    (setq fx 1.0)
  14.    (setq th 2.0)
  15.    (setq zk 0.67)
  16.    (Command "-style" "道路桩号" "仿宋_GB2312" "" zk ""  "n" "n")
  17.    (setq qszh 0.0)
  18.    (setq qz "")
  19.    (setq qmw 0)
  20. (vl-load-com)
  21. (prompt "\n批量标注桩号,加载命令:plbzzh,设置(SZ)。By luozegang 葛洲坝基础公司")
  22. (defun c:plbzzh()
  23. (setvar "cmdecho" 0)
  24. (setq ff (open (getfiled "文件保存为" "c:/" "dat" 1) "a"))
  25. (bzzh)
  26. );修改于2012-01-11增加了将数据写入文本
  27. (defun bzzh()
  28.    (setvar "osmode" 703) ;恢复捕捉
  29.    (setvar "cmdecho" 0)
  30.    (setq os (getvar "osmode"))
  31.    (setq FltLst '((0 . "LWPOLYLINE,POLYLINE,LINE,ARC")))
  32.     (princ "\n\n\n\n     请先把预标注的曲线(多段线)连接在一起,如果已经连接好,回车跳过即可 ")
  33.    (setq SelSet (cond ((ssget "_I" FltLst)) ((ssget FltLst))))
  34.     (if (/= nil selset) (command "change" SelSet "" "p" "la" "道路中心线" ""))
  35.        (if (/= nil selset)
  36.        (if (> (sslength selset) 1)
  37.            (command "_.PEDIT" "_M" SelSet "" "_Y" "_J" "_J" "_B" "0" "")
  38.        )
  39.        )
  40.      (setq en (car (entsel "\n选择标注曲线:")))
  41.          (while (= nil en)
  42.          (setq en (car (entsel "\n选择标注曲线:")))
  43.        )
  44.    (if (vlax-curve-isClosed en)
  45.                (progn
  46.                     (print "曲线为环路!请先打开个缺口!")
  47.                     (exit)
  48.                )
  49.    )
  50.      (redraw en 3)
  51.    (command "change" en "" "p" "la" "道路中心线" "")
  52.    (setq qd (getpoint "\n选取已知点:"))
  53.    (while (not (vlax-curve-getDistAtPoint en qd))
  54.    (setq qd (getpoint "\n\n\n没有选在标注曲线上,重新选择:"))
  55.    )
  56.   (setq leng (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en) ))  ;;;道路总长
  57.     (if (= nil (setq qszh (getreal "\n请输入已知点桩号<0>:"))) (setq qszh 0))
  58.     (if (= nil (setq dist (getreal "\n请输入桩号间距<20>:"))) (setq dist 20))
  59.    (setq qszh (- qszh (* (vlax-curve-getDistAtPoint en qd) fx)))
  60.     (setvar "osmode" 0) ;关闭捕捉
  61. ; (command "._erase" (ssget "x" (list (cons 8 "道路桩号"))) "")   ;删除这段代码,可以实现(分次)多条线段标注,不删除只能一个图标注一次
  62.     (setq pzh (fix(/ qszh dist)))
  63.     (setq pzh (- qszh (* pzh dist)))
  64.      (if (= fx 1.0)
  65.      (setq pt1 (vlax-curve-getStartPoint en))
  66.      (setq pt1 (vlax-curve-getEndPoint en))
  67.       )
  68.    (if (= fx 1.0)
  69.     (setq zhz 0)
  70.     (setq zhz (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en)))
  71.      )
  72.      (setq zhz (+ zhz (* qszh fx)))
  73.    (setq zhz (* zhz fx))
  74.      (xrbz)
  75.      (setq nn 0)
  76.      (while
  77.      (setq pt1 (vlax-curve-getPointAtDist en (abs(- (* nn (* dist fx)) pzh))))
  78.      (setq zhz (* nn (* dist fx)))
  79.      (setq zhz (+ zhz (- qszh pzh)))
  80.      (xrbz)
  81.      (setq nn (1+ nn))
  82.      )
  83.      (if (= fx 1.0)
  84.          (setq pt1 (vlax-curve-getEndPoint en))
  85.          (setq pt1 (vlax-curve-getStartPoint en))
  86.      )
  87.    (if (= fx 1.0)
  88.     (setq zhz (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en)))
  89.     (setq zhz 0)
  90.      )
  91.     (setq zhz (+ zhz (* qszh fx)))
  92.       (setq zhz (* zhz fx))
  93.     (xrbz)
  94.    )
  95.   (defun xrbz(/)
  96.     (Command "layer" "s" "道路桩号"  "")
  97.     (if (< zhz 0.0) (setq fh "-") (setq fh "+"))
  98.      (setq nn1 (fix (/ zhz 1000.0)))
  99.      (setq nn2 (abs(- zhz (* 1000.0 nn1))))
  100.      (if  (= nn2 0.0) (setq str_1 (strcat fh "00" )))
  101.      (if  (and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "000" ) (rtos nn2 2 3))))
  102.      (if  (and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 0))))
  103.      (if  (>= nn2 100.0)  (setq str_1 (strcat fh (rtos nn2 2 0))))
  104. (if  (= zhz leng)  (setq str_1 (strcat fh (rtos nn2 2 3)))) ;;修改部分2011-06-14
  105.    (if (= qmw 0)
  106.      (if (=  (fix (/ nn2 100.0)) (/ nn2 100.0))
  107.        (progn
  108.          (setq str_1 (strcat "K" (rtos nn1 2 0)  str_1 ))
  109.          (setq str_1 (strcat qz str_1 ))
  110.        )
  111.      )
  112.      (progn
  113.      (setq str_1 (strcat  (rtos nn1 2)  str_1 )) ;
  114.              (setq str_1 (strcat qz str_1 ))
  115.     )
  116.    )
  117.      (setq ang (a-get-Angle en pt1))
  118.      (setq pt2 (polar pt1 (+ ang (/ pi 2)) (* th 1))) ;垂线的左边点
  119.      (setq pt3 (polar pt1 (+ ang (* pi 1.5)) (* th 1))) ;垂线的右边点(文字中心点)
  120.      (setq st1 (substr str_1 1 1))
  121.      (if (/=  st1 fh)
  122.        (progn
  123.        (if (= wf 1.0)
  124.            (setq pt4 (polar pt1 (+ (* pi 1.5) ang) (* th (* 1.65406 zk))))
  125.            (setq pt4 (polar pt1 (+ (* pi 0.5) ang) (* th (* 1.65406 zk))))
  126.        )
  127.        )
  128.        (progn
  129.        (if (= wf 1.0)
  130.            (setq pt4 (polar pt1 (+ (* pi 1.5) ang) (* th (* 1.3582 zk))))
  131.            (setq pt4 (polar pt1 (+ (* pi 0.5) ang) (* th (* 1.3582 zk))))
  132.        )
  133.        )
  134.      )
  135.      (command "line" pt1 pt2 "")
  136.      (if (= wf 1.0)
  137.      (setq ang2 (angtos (+ (angle pt2 pt1) (/ pi 2))0 4) )   ;桩号文字角度  2014-08-26
  138.      )

  139.      (command "text" "bc" pt2 th  ang2 str_1 ) ;文字“中下”对中
  140.     (setq x01 (car pt1))
  141.     (setq y01 (cadr pt1))
  142.     (setq str_1 (strcat (rtos zhz 2 3)  ",," (rtos y01 2 3) "," (rtos x01 2 3)",0"))
  143.     (write-line str_1 ff);中桩写入文本(2012-01-10修改)
  144.    (write-line str_1 );显示中桩桩号坐标(2012-01-10修改)
  145.   (princ)
  146. )


  147. (defun a-get-Angle(ename point / p1 v1 pt-ang)
  148.   (setq v1 (vlax-curve-getfirstderiv ename (vlax-curve-getparamatpoint ename point))
  149.     p1 (mapcar '+ point v1)
  150.     pt-ang (angle point p1))
  151.         pt-ang
  152.   )

  153. (defun c:sz ()
  154.    (setq xz 1)
  155.    (while (/= xz "")
  156.    (setq xz (getstring "\n\n\n\n [回车退出/文字高度(H)/文字宽度比例(B)/桩号间距(J)/桩号标注方向(F)/文字方向(X)/前缀(Z)/千米位(Q)]:"))
  157.   (cond
  158.      ((= xz "H") "h")
  159.      ((= xz "B") "b")
  160.      ((eq xz "J") "j")
  161.      ((eq xz "F") "f")
  162.      ((eq xz "X") "x")
  163.      ((eq xz "Z") "z")
  164.      ((eq xz "Q") "q")
  165.      (T xz)
  166. )
  167.    (if (= xz nil) exit)
  168.    (if (= xz "h")
  169.      (progn
  170.    (setq str_2 (strcat "\n\n\n\n 文字高度<" (rtos (getvar "textsize") 2) ">:"))
  171.    (setq th (getreal str_2))
  172.     (if (= th nil) (setq th (getvar "textsize")))
  173.    )
  174.      )
  175.    (if (= xz "b")
  176.      (progn
  177.    (setq zk (getreal "\n\n\n\n\n [文字宽高比例]<0.67>:"))
  178.    (if (= zk nil)  (setq zk 0.67))
  179.    (Command "-style" "道路桩号" "仿宋_GB2312" "" zk ""  "n" "n")
  180.      )
  181. )
  182. (if (= xz "j")
  183.    (if (= nil (setq dist (getreal "\n\n\n\n\n [桩号间距]<20>:"))) (setq dist 20.0))
  184.   )
  185.    
  186.    (if (= xz "f")
  187.      (progn
  188.    (setq fxxz (getstring "\n\n\n\n\n [桩号标注方向[正(Z)/反(F)]<Z>:"))
  189.    (if (= fxxz nil) (setq fxxz "z"))
  190.    (if (= fxxz "z")
  191.        (setq fx 1.0)
  192.        (setq fx -1.0)
  193.     )
  194.      
  195.      (setq wf (* wf fx))
  196.     )
  197.      )
  198.       
  199. (if (= xz "x")
  200.   (progn
  201. (if (= nil (setq WZFX (getstring "\n\n\n\n\n 文字方向[前进(Q)/后退(H)]<Q>:"))) (setq WZFX "q"))
  202.       (if (= wzfx "q")
  203.        (setq wf 1.0)
  204.        (setq wf -1.0)
  205.     )
  206.   )
  207. )
  208. (if (= xz "z")
  209. (setq qz (getstring "\n\n\n\n\n 前缀(去除前缀请直接回车):"))
  210.   )
  211.       
  212. ;;;(initget 1 "1 0")
  213. (if (= xz "q")
  214. (if (= nil (setq qmw (getint "[整百桩位标注(0)/全部标注(1)]<0>:"))) (setq qmw 0))
  215. )
  216.       
  217.      )
  218.    )

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复 支持 1 反对 0

使用道具 举报

发表于 2014-9-4 23:53 | 显示全部楼层
感谢楼主程序,如果能加上特征点:如直园 圆缓 缓园 曲中 共切点 直缓 缓直点等等 ZY ZH HY HZ QZ HY YH
回复 支持 1 反对 0

使用道具 举报

发表于 2015-5-9 18:48 | 显示全部楼层
楼主你好,请问代码怎么修改可以使每个中桩标注不省略'Ki',比如K2+240,而不是+240
回复 支持 0 反对 1

使用道具 举报

发表于 2012-12-18 11:38 | 显示全部楼层
楼主的分享精神值得肯定
 楼主| 发表于 2012-12-18 11:42 | 显示全部楼层
zyhandw 发表于 2012-12-18 11:38
楼主的分享精神值得肯定

在 明经论坛 里学了很多东西,也得到 论坛会员的帮助。
分享我的东西是对明经的支持
发表于 2012-12-18 13:29 | 显示全部楼层
skg123 发表于 2012-12-18 11:42
在 明经论坛 里学了很多东西,也得到 论坛会员的帮助。
分享我的东西是对明经的支持

发表于 2013-9-22 15:10 | 显示全部楼层
不知道LZ还不能能更新下去

把任意点桩号继续完善  能生成纬地的WID格式?
发表于 2013-12-7 17:22 | 显示全部楼层
任意点桩号标注中,为什么桩号标注出来是K0+9,而不是K0+009,要怎么改一下才可以在前面自动加0
发表于 2013-12-22 17:39 | 显示全部楼层

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2014-3-19 22:20 | 显示全部楼层
谢谢楼主。。。。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 18:56 , Processed in 0.309993 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表