修改大神代码，横断面图转成高程点并导出
:D;;;by Gu_xl(defun gxl-cs:gcd (inspt height scale / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)
(setvar "CMDECHO" 0)
(command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" """")
(if height
(setq height (rtos height 2 3));3为高程注记位数
(setq height "")
)
(regapp "SOUTH")
;;;检查字体 "HZ" 是否存在
(if (not (tblobjname "style" "HZ"))
(command "style" "HZ" "rs.shx,hztxt.shx" 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)
(list -3 '("SOUTH" (1000 . "202101")))
)
)
;;;插入属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))
(cons 40 (* 2.0 scale))
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
(cons 1 height)
(cons 7 "HZ")
(cons 62 1)
(cons 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 700)
(cons 74 2)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
;;;;;;;;;;;;;;;;;;;;
(defun c:tqdmsj()
(vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP
(setq blc (getint "\n请输入比例尺1:<500>"))
(if (= blc nil)(setq blc 500))
(setvar 'userr1 blc);设置比例尺
(setq scale (* 0.001 blc));缩放比例
(setq qszhxh (getint "\n请输入起始桩号-1后的序号：\n"))
(srcs_data)
(sjdc_data)
(princ (strcat "\n文件写至" ffn))
(prin1)
)
(defun srcs_data()
(setq ffn (getfiled "选取/建立数据导出文件" "" "hdm" 1))
(setq ff (open ffn "w"))
(close ff)
(setq hxbl (getint "\n请输入断面横向比例 1 :"))
(setq zxbl (getint "\n请输入断面纵向比例 1 :"))
)
(defun sjdc_data()
(alert "请选择需要导出数据的断面线")
(setq ss (ssget))
(setq ii 0)
(setq gcz 0.00)
(repeat (sslength ss)
(setq ssn (ssname ss ii))
(setq endata (entget ssn))
(setq zh (getstring (strcat "\n请输入第" (rtos (1+ ii) 2 3) "个断面的桩号:")))
(if (= zh "") (setq zh (1+ ii)))
(setq qd (getpoint "\n请输入该断面中桩点的位置:"))
(setq qdx (car qd)) (setq qdy (cadr qd))
(setq bak gcz)
(setq gcz (getreal (strcat "\n请输入中桩点的高程:<" (rtos bak 2 3) ">")))
(if (= gcz nil) (setq gcz bak))
(setq tmqd (getpoint "\n请输入该断面<平面图中>中桩点的位置:"))
(setq tmycfx (angle tmqd (getpoint "\n请输入该断面线<平面图中>右侧一点:") ))
(setq ff (open ffn "a"))
(princ "begin," ff) (princ zh ff) (princ ":" ff) (princ (rtos (1+ qszhxh) 2 3) ff) (princ "\n" ff) (close ff)
(tqzb_data)
(setq ii (1+ ii)) (setq qszhxh (1+ qszhxh))
)
(prin1)
)
(defun tqzb_data()
(setq nn 0)
(repeat (length endata)
(setq pp (nth nn endata))
(setq key (car pp))
(if (= key 10)
(progn
(setq xx (cadr pp)) (setq yy (caddr pp))
(setq dx (/ (- xx qdx) (/ 1000.000 hxbl)))
(setq dy (+ (/ (- yy qdy) (/ 1000.000 zxbl)) gcz) )
(setq xinzb (polar tmqd tmycfx dx))
(setq zxinzb (list (car xinzb) (cadr xinzb)dy))
(gxl-cs:gcdzxinzb dy scale)
(setq ff (open ffn "a"))
(princ (rtos dx 2 3) ff) (princ "," ff) (princ (rtos dy 2 3) ff) (princ "\n" ff)
(close ff)
)
)
(setq nn (1+ nn))
)
(prin1)
)
(prompt "提示：用<tqdmsj>命令来运行本程序")
本帖最后由 wdjy808 于 2019-3-28 12:00 编辑
大神，我对你的这个插件进行了点简化，您输入的步骤有点多，现在只需要在C盘目录下，放一个文件（横断转点.dat）空白文件。不用去管横纵比例。
希望大神指正。
希望您加入批量转化功能
本帖最后由 skg123 于 2019-3-6 13:38 编辑
看了演示，没有测试。
建议：程序设计成不用在中线上指定位置绘图，应该设计出成 选好中线，后面的只要选择横断面线并输入横断面的里程，程序就自动在对应的中线上添加高程点，理由是点击中线上的位置，容易捕捉出错，对不是整桩的断面，找对应的位置很难，这个应该由程序推算精确的位置。免去往返中线与断面图这个动作，可提供效率。
这个6了，gxl-cs:gcd这个被你用烂了:lol 厉害 能批量把hdm的地面线数据导出么！ spp_wall 发表于 2017-9-21 08:30
厉害 能批量把hdm的地面线数据导出么！
你试试吧 应该可以 不错，很不错的程序， 很不错，谢谢！！！！ 树櫴希德 发表于 2017-9-21 19:28
你试试吧 应该可以
怎么显示字符串错误呢老兄 gxl-cs:gcd这个函数插入的高程点位Z值为0怎么破，高程值是正确的