自己动手,改进CASS中欠缺的功能

树櫴希德

(defun c:gcdg()     
(command "undo" "be")
(command "zoom" "e")
(setvar "lwdisplay" 1)
(setq blc (getvar "userr1"))
(setq scmde (getvar "osmode"))
(setvar "osmode" 0)
(setq lay_name (getstring "\n  检查高程点与等高线间点线矛盾   请输高程点所在图层<GCD>:"))
(if (= lay_name "") (setq lay_name "GCD"))
(setq pts0 (ssget (list (cons 0 "INSERT")(cons 8 lay_name))))
(command "layer" "off" "*" "y" "on" "DGX" "")
(setq count 0)
(while (< count (sslength pts0))
(setq pts (ssname pts0 count))
(setq pts1 (entget pts))
(while pts1
(if (= (caar pts1) 10)(setq pt (cdar pts1)))
(setq pts1 (cdr pts1))
);while
(setq h (nth 2 pt) xx (nth 0 pt) yy (nth 1 pt))
(setq xx0 (- xx 2) xx1 (+ xx 2)  yy0 (- yy 2) yy1 (+ yy 2))
(setq p1 (list xx yy) ppt0 (list xx0 yy0) ppt1 (list xx1 yy0) ppt2 (list xx1 yy1) ppt3 (list xx0 yy1))
(setq LW (list ppt0 ppt1  ppt2  ppt3))
(setq gg nil)
(setq ggdgx (ssget "cp" LW '((8 . "DGX") (-4 . "<or")(0 . "POLYLINE")(0 . "LWPOLYLINE")(-4 . "or>"))))
(if (/= ggdgx nil)
(progn
(setq h1 0.0 h2 0.0)  
(setq pt2 (osnap p1 "_nea"))
(setq h1 (nth 2 pt2))
(setq pt21 (polar p1 (angle pt2 p1) 2));如等高线太稀将2改大（如4）
(setq pt22 (osnap pt21 "_nea"))
(if pt22 (setq h2 (nth 2 pt22)))
(if (and (/= h1 h2) (< (abs (- h1 h2)) 5.1))
(progn
(if (> h1 h2) (setq hjh h2 h2 h1 h1 hjh))
(command "lweight" "2")
(if (or (< h h1) (> h h2)) (command "circle" pt "5"))
))));;;end of if
(setq count (1+ count))
);while
(command "clayer" "0")
(setvar "osmode" scmde)
(command "layer" "on" "*" "")
(command "undo" "e")
(command "lweight" "bylayer")
(princ)
);defun

wkq004

树櫴希德 发表于 2013-11-30 12:13
(defun c:gcdg()     
(command "undo" "be")
(command "zoom" "e")

顶一下，自己写的？

杜阳

高人的帖子  能学习  能交流     一定要顶   我是测绘人   希望能交流

fglfa

有很久一段时间没有来明经了到这里来顶一下。在此还要特别感谢版主的帮助！！

薰衣草-花语

水清平 发表于 2010-7-22 08:31
如果电子地形图上的高程点没有高程属性，即只有X\Y值，没有Z值，也就是Z值是在图面上用文本表示的，那怎样将 ...

根据文字数字赋值到高程点

lwz0103

hao hao hao hao hao

树櫴希德

CASS三角网法改进，谁能编个程序？

杜阳

初学者   单个标注角度的 望改正成为批量标注  
(defun C:jb2()
(setvar "cmdecho" 0)
(setq p1(getpoint"\n 第1点："))
(setq p2(getpoint"\n 第2点："))
(setq p3(getpoint"\n 第3点："))
(setq pz(getpoint"\n 方向："))
(setq A(command "DIMANGULAR" "" p2 p1 p3 pz))
)

zzyong00

树櫴希德 发表于 2014-4-1 22:06
CASS三角网法改进，谁能编个程序？

编出这个程序倒也不难，问题是，论文中的“”设计高程为 H0”，好像设计高程就是一个值，设计地面是水平的，可是实际不可能是这个的，设计高程也能生成的一个三角网，这种情况如何整合两个（设计和自然）三角网？

杜阳

每天都关注这个帖子   怎么楼主不来光顾了   等高线局部替换 不增加节点的lisp程序   能给学习一下吗  真希望能把cass中的一些程序重新写一些  都学习学习   持续关注本帖  祝福楼主