AtuoCAD压箱底技巧 潜水
  • 1发帖数
  • 1主题数
  • 0关注数
  • 0粉丝
开启左侧

绘制纵断面地面线的步伐(源码)

[复制链接]
AtuoCAD压箱底技巧 发表于 2021-10-31 05:30:00 | 显示全部楼层 |阅读模式 打印 上一主题 下一主题
;jyzdm.lsp
;阐明----1.使用本程序前,请先建扬名为“HZ”的字型;
; 2.使用本程序前,请先确定原点位置。
; 3.本程序所用命令名为JYZDM。
; 编写人:段悟哲 1999-5-30
(defun c:jyzdm()
;赋全局变量默认值
(if (= #ql nil) (setq #ql 0.0))
(if (= #qg nil) (setq #qg 0.0))
(if (= #zg nil) (setq #zg 3.0))
(if (= #hb nil) (setq #hb 5000.0))
(if (= #vb nil) (setq #vb 500.0))
(if (= #gp nil) (setq #gp 1.0))
(if (= #x nil) (setq #x 0.0))
(if (= #y nil) (setq #y 0.0))
(initget "Yes No")
(setq YorN(getkword "重新定义基础数据?(Yes or No):"))
(if (= YorN nil)
(progn
;---输入本图基础数据
(setq #ql(getreal "\n本图起始里程:")
#qg(getreal "\n本图起始高程:")
#zg(getreal "\n字体高度:")
#hb(getreal "\n纵断面横向比例:")
#vb(getreal "\n纵断面纵向比例:")
#x(getreal "\n地面线起始点里程:")
#y(getreal "\n地面线起始点高程:")
#lc(getreal "\n里程书写位置:")
#gc(getreal "\n地面高程书写位置:")
#x(/ (- #x #ql) (/ #hb 1000))
#y(/ (- #y #qg) (/ #vb 1000))
);setq
(setq px0 #x)
);progn
);if
;---由地面线起始点里程计算公里标所在位置
;---输入中桩里程及其对应的地面高程并按比例计算地面点所在位置
(setq fi(getfiled "选择地面高程数据文件" "\\r13" "txt"4))
(setq fp (open fi "r"))
(while(setq po(read-line fp))
(setq po(read po))
(setq #zl(car po)
#dg(car (cdr po)))
(cond
((/= #zl nil)
(setq zls(- #zl (* (fix (/ #zl 100)) 100))
px(/ (- #zl #ql) (/ #hb 1000))
py(/ (- #dg #qg) (/ #vb 1000))

);setq
;---写出中桩里程(不含百米及以上数字)
(if (> (- px px0) (* #zg 1.5))
(progn
(cond
((/= zls 0.0)
(command "line" (list px (+ 5 #lc)) (list px (- #lc 5)) nil)
(command "text" "s" "hz" "mc" (list (- px #zg) #lc) #zg "90" (rtos zls 2 2) nil))
);cond
(command "line" (list px (+ #gc 5)) (list px (- #gc 5)) nil)
(command "text" "s" "hz" "mc" (list (- px (+ (/ #zg 2) 1)) #gc) #zg "90" (rtos #dg 2 2) nil);command
(setq px0 px)))
;---毗连地面线
(command "line" (list #x #y) (list px py) nil)
;---更换地面高程点所用全局变量值
(setq #x px)
(setq #y py)
)))
(close fp)
);defun
(print "已成功装载,输入“JYZDM”开始!")
;---结束
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

猜你喜欢
在线客服邮箱
wxcy#wkgb.net

邮箱地址#换为@

Powered by 创意电子 ©2018-现在 专注资源实战分享源码下载站联盟商城