计算图幅号CAD小程序(lsp)
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
;公式,[]表示取整
;k1=[(x-8000)]/NOx
;k2=[(y-80000)]/NOy
;图号为：k2*100+k1
;对应于1/1000,1/2000,1/5000,1/10000,其中NOx分别为;500,1000,2000,4000,NOy为500,1000,3000,6000
;其中1/2000,1/5000,1/10000应在最前方分别加2,3,4，即分别加上;20000,30000,40000
(defun tfh (pt scale / pt NOx NOy tfhm)
(cond ((= scale 1000)(setq NOx 500 NOy 500))
((= scale 2000)(setq NOx 1000 NOy 1000))
((= scale 5000)(setq NOx 2000 NOy 3000))
((= scale 10000)(setq NOx 4000 NOy 6000))
);cond
(setq tfhm(rtos(+(*(fix(/(-(car pt)80000)NOy))100)(fix(/(-(cadr pt)8000)NOx)))2 0))
(cond ((= scale 1000)
(if (<(strlen tfhm) 5)(setq tfhm (strcat "0" tfhm))))
((= scale 2000)(setq tfhm (strcat "2" tfhm)))
((= scale 5000)(setq tfhm (strcat "3" tfhm)))
((= scale 10000)(if(=(strlen tfhm)3)(setq tfhm (strcat "40" tfhm))(setq tfhm(strcat "4" tfhm))))
);cond
(setq tfhm tfhm);最后加上这句以确保该函数返回值为tfhm
);defun
(defun c:tfh (/ pt scale1 NOx NOy tfhm pt1 pt2 pt3 pt4)
(prompt "本程序用于求龙岗区1:1000、1:2000、1:5000和1:10000的图幅号")
(if(or(not(numberp scale))(= scale 0)) (setq scale 1000))
(setq scale1 (getreal(strcat "\n请输入比例尺<1:" (rtos scale)">：1:")))
(if (and (/= scale1 0)(not(null scale1))) (setq scale scale1))
(cond ((= scale 1000)(setq NOx 500 NOy 500))
((= scale 2000)(setq NOx 1000 NOy 1000))
((= scale 5000)(setq NOx 2000 NOy 3000))
((= scale 10000)(setq NOx 4000 NOy 6000))
);cond
(setq pt (getpoint "\n请输入座标点："))
(while pt
(if (/= pt nil)(progn
(setq tfhm (tfh pt scale))
(prompt (strcat "[" tfhm "]"))
));progn,if
(setq pt1(list(+ 80000(* NOy(atof(if(= scale 1000)(substr tfhm 1 3)(substr tfhm 2 2)))))(+ 8000(* NOx(atof(substr tfhm 4 2)))))
pt2 (mapcar '+ pt1 (list NOy 0.0))
pt3 (mapcar '+ pt1 (list NOy NOx))
pt4 (mapcar '+ pt1 (list 0.0 NOx))
)
(grdraw pt1 pt2 7)
(grdraw pt2 pt3 7)
(grdraw pt3 pt4 7)
(grdraw pt4 pt1 7)
(setq pt (getpoint "\n请输入座标点："))
);while
(princ)
);defun