两个高程点或两条等高线内插高程
本帖最后由 Gu_xl 于 2013-6-21 16:30 编辑;;内插高程
(defun c:zgx()
(bl_c)
(co_lt)
(setq osvar (getvar "osmode"))
(cond ((= pz nil) (setvar "osmode" 512))
((= pz 1) (setvar "osmode" 8))
((= pz 2) (setvar "osmode" 4))
);cond
(initget 128)
(setq p1 (getpoint "\nN 捕捉模式/<选择一条等高线>: "))(PRINT)
(while (and (/= p1 nil) (/= (type (list 0 0)) (type p1)))
(if (or (= p1 "n") (= p1 "N")) (setq pz (getint "1 节点/2 圆心/<最近点>:")))
(cond ((= pz 1) (setvar "osmode" 8))
((= pz 2) (setvar "osmode" 4))
((= pz nil) (setvar "osmode" 512))
);cod
(initget 128)
(setq p1 (getpoint "\nN 捕捉模式/<选择一条等高线>: "))(PRINT)
);while
(setq p2 (getpoint "\n选择另一条等高线: "))(PRINT)
(setvar "osmode" 0)
(setq p3 (getpoint "\n选择选择高程注记点: "))(PRINT)
(setq h1 (caddr p1))
(setq h2 (caddr p2))
(setq d (distance (list (car p1) (cadr p1)) (list (car p2) (cadr p2))))
(setq d1 (distance (list (car p1) (cadr p1)) (list (car p3) (cadr p3))))
(setq h (- h2 h1))
(setq h (* h d1))
(setq h (/ h d))
(setq h (+ h1 h))
(setq p3 (list (car p3) (cadr p3) h))
(setq h (rtos h 2 1))
(if (tblsearch "layer" "gcd")
(setvar "clayer" "GCD")
(command "layer" "m" "GCD" "c" 1 "" "")
);if
(command "insert" "gc200" p3 "xyz" (/ blc 1000.0) (/ blc 1000.0) (/ blc 1000.0) 0)
(setq ent1 (entlast))
(setq ent (entget ent1))
(b_m "202101")
(command "text" (list (+ (car p3) 2.2) (- (cadr p3) 2) (caddr p3)) (* 2 (/ blc 1000.0)) "0"h)
(setq ent2 (entlast))
(setq ent (entget ent2))
(b_m "202111")
(command "RESUMEGCD" ent1 ent2 "")
(setvar "clayer" "0")
(setvar "osmode" osvar)
(princ)
);defun
;;------------------------------------------------------------------------------------
;;比例尺函数
(defun bl_c()
(if (<= (setq blc (getvar "userr1")) 0)
(progn
(setq blc (getint"\n图形比例尺1:<500>:"))
(if (= blc nil) (setq blc 500.0) (setq blc (* 1.0 blc)))
(setvar "userr1" blc )
(setvar "ltscale" (/ blc 1000.0))
);progn
);if
);defun
;;;-------------------------------------------------------------------
;颜色线型设置函数
(defun co_lt()
;;关闭编组选择
(if (/= (getvar "PICKSTYLE") 0) (setvar "PICKSTYLE" 0))
;;设定新对象的颜色为缺省颜色
(if (/= (getvar "cecolor") "BYLAYER") (setvar "cecolor" "BYLAYER"))
;;设定新对象的线型为连续
(if (/= (getvar "celtype") "CONTINUOUS") (setvar "celtype" "CONTINUOUS"))
);defun
;;-----------------------------------------------------------------------------
;;设置编码函数
(defun b_m(bm)
(setq app_x
(list
(list -3
(list "SOUTH"
(cons 1000 bm)
);list
);list
);list
);setq
(setq ent (append ent app_x))
(entmod ent)
);defun
lioun4105 发表于 2017-9-4 20:46
这个最好用，还有更好的吗，点出高程不用按空格就好了
你可以修改一下就能实现了
这个最好用，还有更好的吗，点出高程不用按空格就好了 这个好用，谢谢 (command "insert" "gc200" 什么意思？ q3_2006 发表于 2013-6-21 17:26 static/image/common/back.gif
(command "insert" "gc200" 什么意思？
插入名为gc200的块 g版这么快就给源码了，，， 谢谢楼主的分享！
004 发表于 2013-6-21 17:58 static/image/common/back.gif
插入名为gc200的块
gc200块是在南方CASS里高程相对位置的一个点位块 q3_2006 发表于 2013-6-21 17:26 static/image/common/back.gif
(command "insert" "gc200" 什么意思？
gc200块是在南方CASS里高程相对位置的一个点位块 思路清晰，功能实用，感谢楼主分享！ 谢谢楼主的分享！收藏备用。就是没有gc200.dwg块文件，所以无法测试