明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 516|回复: 11

路基填土分层资料?

[复制链接]
发表于 2019-5-27 22:21 | 显示全部楼层 |阅读模式
  1. ;;;;;;;;;;;;;;;;;;;
  2. (defun zxzb (pts / len pt )
  3.   (setq len (length pts))
  4. (setq pt (mapcar
  5.   '(lambda(x)
  6.     (/ x len)
  7.   )
  8.   (apply
  9.     'mapcar
  10.     (cons '+ pts)
  11.   )
  12. )
  13. )  pt)
  14. ;;;;;;;;;;;;;;
  15. (defun Plinexy(e / p a b n ob q et d d1 en et)
  16.     (setq a(entget e)ob(vlax-ename->vla-object e)et(cdr(assoc 0 a))n 0 p nil d nil)
  17.     (cond((="LWPOLYLINE"et)
  18.     (repeat(length a)(setq b (nth n a) n (+ n 1))
  19.       (if (= 10 (car b))(progn
  20.         (setq q(list (cadr b) (caddr b))d1(vlax-curve-getDistAtPoint ob q))
  21.         (if p (if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))
  22.           (setq p (list q)))))))
  23.    ((="POLYLINE"et)
  24.     (SETQ EN (ENTGET (SETQ E (ENTNEXT E))))
  25.     (WHILE (/= (CDR (ASSOC 0 EN)) "SEQEND")
  26.       (SETQ q (CDR (ASSOC 10 EN))d1(vlax-curve-getDistAtPoint ob q)q(reverse(cdr(reverse q))))
  27.       (if p(if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))(setq p(list q)))
  28.       (SETQ EN (ENTGET (SETQ E (ENTNEXT E)))))
  29.     (setq p(reverse p))))P)
  30. ;;;;;;;;;;;;;
  31. (defun cx-ss2en
  32.   (ss / enlst)
  33.   (cond
  34.     ((= (type ss) 'PICKSET)
  35.       (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
  36.     )
  37.     ((= (type ss) 'LIST)
  38.       (setq enlst (ssadd))
  39.       (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
  40.     )
  41.     ((='ename(type ss))
  42.       (ssadd ss)
  43.     )
  44.   )
  45. )
  46. ;;;;;;;;;;;;;
  47. (defun mkgcd (inspt height height-1 scale  / pt  pt1 blkdef obj)
  48. (gc)  (vl-load-com)
  49.   (setvar "CMDECHO" 0)
  50.   (command "layer" "m" "检查高程点" "c" "1" "" "L" "CONTINUOUS" ""  "")
  51. (cond ((= (type height) REAL) (setq height (rtos height 2 3))  )
  52.      ((= (type height) STR) (setq height height)  )

  53. ((= (type height-1) REAL) (setq height-1 (rtos height-1 2 3))  )
  54.      ((= (type height-1) STR) (setq height-1 height-1)  )
  55.       
  56.   )
  57.   ;;;;-------------
  58. ; (if height     (setq height (rtos height 2 3))      (setq height  "")   )
  59. ;(if height-1     (setq height-1 (rtos height-1 2 3))     (setq height-1 "")   )
  60.   ;;;;-------------
  61.   (regapp "SOUTH")
  62.   ;;;检查字体 "HZ" 是否存在
  63.   (if (not (tblobjname "style" "HZ"))
  64.     (command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
  65.   )
  66. (if (not (tblobjname "style" "宋体"))
  67.     (command "-style" "宋体" "宋体" 0 1 0 "" "" "")
  68.   )

  69.   
  70.   ;;;检查是否存在高程点图块定义
  71.   (if (not (tblobjname "block" "GC200"))
  72.     (progn
  73.       (setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
  74.       (setq obj
  75.         (vla-AddPolyline
  76.            blkdef
  77.            (vlax-make-variant
  78.               (vlax-safearray-fill
  79.                  (vlax-make-safearray vlax-vbdouble (cons 0 5))
  80.                  '(-0.2 0 0 0.2 0 0)
  81.               )
  82.            )
  83.         )
  84.       )
  85.       (vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
  86.       (vla-put-Closed obj :vlax-true)
  87.       (vla-put-ConstantWidth obj 0.4)
  88.     )
  89.   )
  90.   ;;;插入块
  91.   (entmake (list
  92.              '(0 . "INSERT")
  93.              '(100 . "AcDbEntity")
  94.              '(100 . "AcDbBlockReference")
  95.              '(66 . 1);;;属性跟随标志,1跟随,0不跟随
  96.               (cons 2 "GC200")
  97.               (cons 10 inspt)
  98.               (cons 41 scale)
  99.               (cons 42 scale)
  100.               (cons 43 scale)
  101.               '(-3 ("SOUTH" (1000 . "84848412")))
  102.            )
  103.   )
  104.   ;;;插入属性
  105.   (entmake (list
  106.              '(0 . "ATTRIB")
  107.              '(100 . "AcDbEntity")
  108.              '(100 . "AcDbText")
  109.               (cons 10 (setq pt (polar inspt (* -0.5 PI) (* 1.8 scale))))
  110.               (cons 40 (* 2.0 scale))
  111.               (cons 50 0)
  112.                (cons 62 3)
  113.               (cons 41 0.8)
  114.               (cons 51 0)
  115.               (cons 1 height)
  116.               (cons 7 "宋体")
  117.               (cons 72 0)
  118.               (cons 11 pt)
  119.               '(100 . "AcDbAttribute")
  120.               (cons 2 "height")
  121.               (cons 70  0)
  122.               (cons 74 2)
  123.            )
  124.    )
  125. ;;;;;;;;;;;;;;;;;;;;;;;
  126.   (entmake (list
  127.              '(0 . "ATTRIB")
  128.              '(100 . "AcDbEntity")
  129.              '(100 . "AcDbText")
  130.               (cons 10 (setq pt1 (polar inspt (* 0.5 PI) (* 1.8 scale))))
  131.               (cons 40 (* 2.0 scale))
  132.               (cons 50 0)
  133.                (cons 62 3)
  134.               (cons 41 0.8)
  135.               (cons 51 0)
  136.               (cons 1 height-1)
  137.               (cons 7 "宋体")
  138.               (cons 72 0)
  139.               (cons 11 pt1)
  140.               '(100 . "AcDbAttribute")
  141.               (cons 2 "height-1")
  142.               (cons 70  0)
  143.               (cons 74 2)
  144.            )
  145.    )
  146. ;;;插入属性
  147.   
  148.   
  149.    ;;;结束标志
  150.    (entmake '((0 . "SEQEND")))
  151.    (princ)
  152. )
  153. ;;;;;;;;;;;
  154. (defun c:dmbz ( / osmode_bak scale scale1 zh hxbl zxbl midxy midx midy ssa s h i f) ;;;;断面标注

  155. (vl-load-com) (gc)
  156. (setvar "cmdecho" 0)
  157.      (setq osmode_bak(getvar "osmode"))
  158.      (setvar "osmode" 1)
  159.      (command "layer" "M" "dmbz" "C" "7" "" "LT" "CONTINUOUS" "" "")
  160.      (princ "标注比例尺:<1:")
  161.      (princ scale)
  162.      (princ ">")
  163.      (setq scale1 (getreal))
  164.      (if (not (null scale1)) (setq scale scale1))
  165.      (setq zh (/ (* 1.5 scale) 1000))

  166.    (setq f(open(getfiled "打开(或建立)数据文件" "C:\\" "csv" 36)"a"))
  167.   (setq hxbl (getint "\n请输入断面横向比例 1 :"))
  168.   (setq zxbl (getint "\n请输入断面纵向比例 1 :"))
  169.      (setvar "luprec" 1)  
  170.        (setq midxy(getpoint "\n请选择断面的中点:"))
  171.        (setq midx(nth 0 midxy))
  172.        (setq midy(nth 1 midxy))
  173.        (setq midgc(getreal "\n请输入断面的中点高程:"))

  174.    (setq ssa (ssget '( (0 . "*polyline")  (8 . "tk") (62 . 3) ) ) )
  175.   (setq i 1)
  176. (foreach x (cx-ss2en ssa)
  177.    (write-line (strcat "第"(vl-prin1-to-string  i)"层填土标高偏距" "," "===")    f)
  178.   ;(entmake (list '(0 . "TEXT") (cons 1 (vl-prin1-to-string  i)) (cons 10 (zxzb (plinexy x))) (cons 40 zh)))
  179.   (setq i (1+ i))
  180. (foreach y (plinexy x)
  181.    
  182. (setq bzx(nth 0 y))
  183.               (setq bzy(nth 1 y))
  184.               (setq s(strcat "偏距:" (rtos    (* (- bzx midx ) (/ hxbl 1000.000))      2 3)))
  185.               (setq h(strcat "高程:" (rtos (+ midgc  (*(- bzy midy) (/ zxbl 1000.000) )   ) 2 3)))
  186. (write-line (strcat s "," h)    f)
  187.    (mkgcd y s h zh)
  188.    )

  189.   )

  190.   ;(setq pt1(getpoint "\n请选择标注断面的点:"))
  191.                   

  192. (close f)

  193. (setvar "osmode" osmode_bak)
  194. (princ)
  195.       )

本帖子中包含更多资源

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

x
 楼主| 发表于 2019-5-27 22:24 | 显示全部楼层
填土分层资料?

本帖子中包含更多资源

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

x
发表于 2019-5-27 23:04 | 显示全部楼层
我这里连断面图都没有用不了
 楼主| 发表于 2019-5-28 11:39 | 显示全部楼层
其实路基分层应该从上而下分,1楼效果反了,导出的TXT增加了坐标。


第1层填土标高偏距,===
偏距:6.057,高程:0.739,588.7291,-1039.3281
偏距:0,高程:0.86,587.0757,-1033.5012
偏距:-6.057,高程:0.739,585.4223,-1027.6743
第2层填土标高偏距,===
偏距:6.444,高程:0.481,588.8347,-1039.7001
偏距:0,高程:0.61,587.0757,-1033.5012
偏距:-6.444,高程:0.481,585.3168,-1027.3024
第3层填土标高偏距,===
偏距:6.83,高程:0.223,588.9402,-1040.072
偏距:0,高程:0.36,587.0757,-1033.5012
偏距:-6.83,高程:0.223,585.2112,-1026.9305
第4层填土标高偏距,===
偏距:7.217,高程:-0.034,589.0457,-1040.4439
偏距:0,高程:0.11,587.0757,-1033.5012
偏距:-7.217,高程:-0.034,585.1057,-1026.5586
第5层填土标高偏距,===
偏距:7.603,高程:-0.292,589.1513,-1040.8158
偏距:0,高程:-0.14,587.0757,-1033.5012
偏距:-7.603,高程:-0.292,585.0002,-1026.1867
第6层填土标高偏距,===
偏距:7.99,高程:-0.55,589.2568,-1041.1877
偏距:0,高程:-0.39,587.0757,-1033.5012
偏距:-7.99,高程:-0.55,584.8946,-1025.8148
第7层填土标高偏距,===
偏距:8.377,高程:-0.808,589.3623,-1041.5596
偏距:0,高程:-0.64,587.0757,-1033.5012
偏距:-8.377,高程:-0.808,584.7891,-1025.4428
第8层填土标高偏距,===
偏距:8.763,高程:-1.065,589.4679,-1041.9315
偏距:0,高程:-0.89,587.0757,-1033.5012
偏距:-8.763,高程:-1.065,584.6836,-1025.0709
第9层填土标高偏距,===
偏距:9.15,高程:-1.323,589.5734,-1042.3035
偏距:0,高程:-1.14,587.0757,-1033.5012
偏距:-9.15,高程:-1.323,584.578,-1024.699

本帖子中包含更多资源

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

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

本帖子中包含更多资源

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

x
 楼主| 发表于 2019-6-3 15:28 | 显示全部楼层
[code="lisp] ;13、entmake生成普通块
(defun emkblk (   / i ss pt name)
(entmake (list '(0 . "SOLID") (cons 10 '(-0.476 0 0.0))  (cons 11 '(0.476 -0 0.0)) (cons 12 '(0.0 -0.825 0.0)) (cons 13 '(-0.476 0 0.0))))
(setq ss (ssadd (entlast)))
  (setq name "biaogao")
  (setq pt '(0 0 0))
  (entmake (list '(0 . "block") (cons 2 name) '(70 . 0) (cons 10 pt)))
  (repeat (setq i (sslength ss))    (entmake (cdr (entget (ssname ss (setq i (1- i))))))  )
  (entmake '((0 . "ENDBLK")))
  (command "_.erase" ss "")
  (entmake (list '(0 . "INSERT") (cons 2 name) (cons 10 pt)))
)
  
;14、entmake插入普通块
  ;(entmake (list '(0 . "INSERT") (cons 2 name) (cons 10 pt)))[/code]
 楼主| 发表于 2019-6-3 16:28 | 显示全部楼层
层数之上而下 每层标注层数

本帖子中包含更多资源

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

x
发表于 2019-6-11 23:05 | 显示全部楼层
选择分层线时选择不了,问一下,是什么原因??
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2019-12-12 19:20 , Processed in 0.155577 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

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