路基填土分层资料？
;;;;;;;;;;;;;;;;;;;(defun zxzb (pts / len pt )
(setq len (length pts))
(setq pt (mapcar
'(lambda(x)
(/ x len)
)
(apply
'mapcar
(cons '+ pts)
)
)
)pt)
;;;;;;;;;;;;;;
(defun Plinexy(e / p a b n ob q et d d1 en et)
(setq a(entget e)ob(vlax-ename->vla-object e)et(cdr(assoc 0 a))n 0 p nil d nil)
(cond((="LWPOLYLINE"et)
(repeat(length a)(setq b (nth n a) n (+ n 1))
(if (= 10 (car b))(progn
(setq q(list (cadr b) (caddr b))d1(vlax-curve-getDistAtPoint ob q))
(if p (if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))
(setq p (list q)))))))
((="POLYLINE"et)
(SETQ EN (ENTGET (SETQ E (ENTNEXT E))))
(WHILE (/= (CDR (ASSOC 0 EN)) "SEQEND")
(SETQ q (CDR (ASSOC 10 EN))d1(vlax-curve-getDistAtPoint ob q)q(reverse(cdr(reverse q))))
(if p(if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))(setq p(list q)))
(SETQ EN (ENTGET (SETQ E (ENTNEXT E)))))
(setq p(reverse p))))P)
;;;;;;;;;;;;;
(defun cx-ss2en
(ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
((='ename(type ss))
(ssadd ss)
)
)
)
;;;;;;;;;;;;;
(defun mkgcd (inspt height height-1 scale/ ptpt1 blkdef obj)
(gc)(vl-load-com)
(setvar "CMDECHO" 0)
(command "layer" "m" "检查高程点" "c" "1" "" "L" "CONTINUOUS" """")
(cond ((= (type height) REAL) (setq height (rtos height 2 3)))
((= (type height) STR) (setq height height))
((= (type height-1) REAL) (setq height-1 (rtos height-1 2 3)))
((= (type height-1) STR) (setq height-1 height-1))
)
;;;;-------------
; (if height (setq height (rtos height 2 3)) (setq height"") )
;(if height-1 (setq height-1 (rtos height-1 2 3)) (setq height-1 "") )
;;;;-------------
(regapp "SOUTH")
;;;检查字体 "HZ" 是否存在
(if (not (tblobjname "style" "HZ"))
(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
)
(if (not (tblobjname "style" "宋体"))
(command "-style" "宋体" "宋体" 0 1 0 "" "" "")
)
;;;检查是否存在高程点图块定义
(if (not (tblobjname "block" "GC200"))
(progn
(setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
(setq obj
(vla-AddPolyline
blkdef
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 5))
'(-0.2 0 0 0.2 0 0)
)
)
)
)
(vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
(vla-put-Closed obj :vlax-true)
(vla-put-ConstantWidth obj 0.4)
)
)
;;;插入块
(entmake (list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1);;;属性跟随标志,1跟随，0不跟随
(cons 2 "GC200")
(cons 10 inspt)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
'(-3 ("SOUTH" (1000 . "84848412")))
)
)
;;;插入属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (setq pt (polar inspt (* -0.5 PI) (* 1.8 scale))))
(cons 40 (* 2.0 scale))
(cons 50 0)
(cons 62 3)
(cons 41 0.8)
(cons 51 0)
(cons 1 height)
(cons 7 "宋体")
(cons 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 700)
(cons 74 2)
)
)
;;;;;;;;;;;;;;;;;;;;;;;
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (setq pt1 (polar inspt (* 0.5 PI) (* 1.8 scale))))
(cons 40 (* 2.0 scale))
(cons 50 0)
(cons 62 3)
(cons 41 0.8)
(cons 51 0)
(cons 1 height-1)
(cons 7 "宋体")
(cons 72 0)
(cons 11 pt1)
'(100 . "AcDbAttribute")
(cons 2 "height-1")
(cons 700)
(cons 74 2)
)
)
;;;插入属性
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
;;;;;;;;;;;
(defun c:dmbz ( / osmode_bak scale scale1 zh hxbl zxbl midxy midx midy ssa s h i f) ;;;;断面标注
(vl-load-com) (gc)
(setvar "cmdecho" 0)
(setq osmode_bak(getvar "osmode"))
(setvar "osmode" 1)
(command "layer" "M" "dmbz" "C" "7" "" "LT" "CONTINUOUS" "" "")
(princ "标注比例尺:<1:")
(princ scale)
(princ ">")
(setq scale1 (getreal))
(if (not (null scale1)) (setq scale scale1))
(setq zh (/ (* 1.5 scale) 1000))
(setq f(open(getfiled "打开(或建立)数据文件" "C:\\" "csv" 36)"a"))
(setq hxbl (getint "\n请输入断面横向比例 1 :"))
(setq zxbl (getint "\n请输入断面纵向比例 1 :"))
(setvar "luprec" 1)
(setq midxy(getpoint "\n请选择断面的中点:"))
(setq midx(nth 0 midxy))
(setq midy(nth 1 midxy))
(setq midgc(getreal "\n请输入断面的中点高程:"))
(setq ssa (ssget '( (0 . "*polyline")(8 . "tk") (62 . 3) ) ) )
(setq i 1)
(foreach x (cx-ss2en ssa)
(write-line (strcat "第"(vl-prin1-to-stringi)"层填土标高偏距" "," "===") f)
;(entmake (list '(0 . "TEXT") (cons 1 (vl-prin1-to-stringi)) (cons 10 (zxzb (plinexy x))) (cons 40 zh)))
(setq i (1+ i))
(foreach y (plinexy x)
(setq bzx(nth 0 y))
(setq bzy(nth 1 y))
(setq s(strcat "偏距：" (rtos (* (- bzx midx ) (/ hxbl 1000.000)) 2 3)))
(setq h(strcat "高程：" (rtos (+ midgc(*(- bzy midy) (/ zxbl 1000.000) ) ) 2 3)))
(write-line (strcat s "," h) f)
(mkgcd y s h zh)
)
)
;(setq pt1(getpoint "\n请选择标注断面的点:"))
(close f)
(setvar "osmode" osmode_bak)
(princ)
)
(vl-load-com)
(vl-load-com)
(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);桩号查询
(prompt "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)))
)
)
(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 pt1 pt2 )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 pt0 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67))))
(command "text" "j" "MC" pt1 "0.3" ang2 str_1)(command "donut" 0.05 0.1 pt0 "")
(command "text" "j" "MC" pt4 "0.3" ang2 (rtos (distance pt0 Perpt) 2 3))
(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)
) 其实路基分层应该从上而下分，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
;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))) 填土分层资料？
我这里连断面图都没有用不了 专业化的，最好有个样图 zml-84大湿的标注横断面坡度 小小改了下
层数之上而下 每层标注层数 选择分层线时选择不了，问一下，是什么原因？？
页:
[1]
2