找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 990|回复: 6

[原创]:地形测量中好用“LISP快速展点程序”

[复制链接]

已领礼包: 111个

财富等级: 日进斗金

发表于 2005-6-14 16:04:59 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

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

×
地形测量中好用“LISP快速展点程序”
;地形测量中好用“LISP展点程序”
;展1000点:在HP(AMD Athlon64  3000+  256MB)电胶上仅耗时0.142秒;
:展257272点:在HP(AMD Athlon64  3000+  256MB)电胶上仅耗时94秒;

;                    在金利(Geleron(R) CPU 2.40GHz 256MB)电胶上耗时0.882秒
;数据文件格式为:每一点的数据(点号、X、Y、H)为一行,用逗号或空格作为分隔符,即
;点号1  X1  Y1 H1   或者 点号1,  X1,  Y1, H1
;点号2  X2  Y2 H2   或者 点号2,  X2,  Y2, H2
;点号3  X3  Y3 H3   或者 点号3,  X3,  Y3, H3
;......
;点号n  Xn  Yn Hn   或者 点号n,  Xn,  Yn, Hn1
(defun c:kszd()
    (setq  ff (open (getfiled "请选择要展点的数据文件" "" "txt" 2) "r")
              fhb nil  t0 (getvar "cdate")
      cm (getvar "cmdecho") os (getvar "osmode")
             tcm1 "高程注记"   tcm2 "点记"
    )
    (setvar "cmdecho" 0)(setvar "osmode" 0)
    (if (= (tblsearch "layer" tcm1) nil) (command "layer" "n" tcm1 ""))
    (if (= (tblsearch "layer" tcm2) nil) (command "layer" "n"  tcm2 ""))
    (while (setq zb (read-line ff))
        (while (vl-string-search "," zb) (setq zb (vl-string-subst " " "," zb)))
(setq zb  (read (strcat "(" zb ")"))
                 zb  (list (list (nth 2 zb) (nth 1 zb)) (vl-princ-to-string  (last zb)));注记高程
                ;zb  (list (list (nth 2 zb) (nth 1 zb)) (vl-princ-to-string  (car zb)));提示:注记点号请用该行
          fhb (append fhb (list zb))
        )
    )
    (setq t1 (getvar "cdate"))
    (close ff)
    (setq zb (vl-sort fhb '(lambda (e1 e2) (< (car (car e1)) (car (car e2)))))
   x0 (car (car (car zb)))  x1 (car (car (last zb)))
   zb (vl-sort fhb '(lambda (e1 e2) (< (cadr (car e1)) (cadr (car e2)))))
   y0 (cadr (car (car zb)))  y1 (cadr (car (last zb)))
    )
    (command "zoom" "w" (list x0 y0) (list x1 y1))
    (setq t2 (getvar "cdate"))
    (foreach zb fhb
        (setq zfc (last zb)
       pt  (mapcar '+ (car zb) '(1.5 -1.25))
)
        (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
         '(62 . 1) '(40 . 2.5) '(50 . 0.0)
          (cons 8 tcm1)   (cons 1 zfc)  (cons 10 pt)
      
                 )
        )
        (entmake (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint")
         '(62 . 2)
          (cons 8 tcm2)  (cons 10 pt)
                      )
   )
     )
    (setq t3 (getvar "cdate")
   dt1 (* 1000000 (- t1 t0))
   dt2 (* 1000000 (- t3 t2))
    )
    (princ (strcat "
读入数据共耗时:" (rtos dt1 2 3) "秒   展点共耗时" (rtos dt2 2 3) "秒"
     "
展点数:" (itoa (length fhb)) "个  每展一点耗时:" (rtos (/ dt2 (length fhb)) 2 10) "秒"
    )
    )
    (setvar "cmdecho" cm)(setvar "osmode" os)(princ)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2005-6-14 16:13:02 | 显示全部楼层
太专业了,如何能更清楚的了解一下子它的用途?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2005-6-14 17:12:38 | 显示全部楼层
是不是已知直线座标和标高,通过LISP直接绘制图形?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 111个

财富等级: 日进斗金

 楼主| 发表于 2005-7-2 09:45:52 | 显示全部楼层
将地形测量中所得的每一个地形特征点及高程展绘于图中(用点表示点位、高程字符串表示高程值),用于构建数字地面高程模型、计算土方数量等。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-8-10 15:40:09 | 显示全部楼层
过来学习一下!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-8-11 13:50:46 | 显示全部楼层
谢谢楼主的分享!很有用啊!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2016-4-18 21:16:06 | 显示全部楼层
展点后,点不带高程,如何建模?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-9-24 10:25 , Processed in 0.344804 second(s), 43 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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