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

njcknfy

文字消隐不能使用是因为你的CAD没有安装EXpress工具集，CADR14的版本和CADR2000的版本在安装时只要选择完全安装，一般EXpress的工具集都被安装，自CADR2002开始，这个工具要另外安装，你可到明经通道的网上下载，我在前一段时间在论坛里贴的多义线自动精简结点的LISP程序就可以实现和等值线滤波同样的功能，只是运行的速度不如CASS中的快，凑合着也能用。

xgr

朋友：你的情况可用另一方法：展点完后，利用CASS的“实体添加属性”命令给实体“GC200”加上属性，编码是“202101”，即可利用所展点生成TIN网。我也是搞测绘的，展点程序是自己编写的，其中的块“GC200”也没有添加实体属性，我是用这一方法来实现TIN网的生成。

njcknfy

我试了一下，利用给实体添加扩展属性的命令确实可以给GC200的块添加202101的扩展属性，就可以建三角网了。

xgr

你的这个程序我下载试用了，其中好象没有考虑到坐标系的问题,如果图形是自定义坐标系的话，精减后的等高线会位移，另外，如果能够提高精减速度的话,将是一个很好的程序,是否能把其中的COMMAND用ENTMAKE涵数代替，这样也许速度要更快一些。仅供参考。


另外，本人还有一事相求，CASS的等高线的自动生成，如果选择用二次拟和线，则生成的等高线不经过高程点。不知有什么方法解决。

0-baby

楼主好强哦。。佩服。。收益较多。。

xgr

批量展点程序，运行于CASS5.1，可以利用展的点，用CASS中的命令生成等高线。先建一文本，格式为 X Y Z 点号 X Y Z 保存为.TXT，运行程序提示选择数据时，选择该文本即可。 代码如下： defun dstbm ()
(setq mm (entlast))
(setq pb (entget mm))
(regapp "SOUTH")
(setq
xb
(append
pb
(list
(list '-3
(list "SOUTH" (cons 1000 stbmx))
)
)
)
)
(entmod xb)
(princ)
) ;;;批量展测量点
(defun c:zdtxt (/ l wzcl wzch l3 oldcmd oldblip oldsnap tckz newlayer fle fn pt dm zb xyz h lscale xyz1 xyz2)
(setq l (getvar "ltscale"))
(setq wzcl (* l 2))
(setq wzch (* l 2))
(setq l3 (angle (getvar "ucsorg")
(getvar "ucsxdir")
)
)
(setq oldcmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq oldblip (getvar "blipmode"))
(setvar "blipmode" 0)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(setvar "angdir" 1)
(setq fle (getfiled "请选择数据文件"
"*"
"txt;dat;*"
2
)
)
(if (= (tblobjname "layer" "GCD") nil)
(progn
(command "layer" "n" "zd" "C" "1" "GCD" "")
)
)
(setq fn (open fle "r"))
(read-line fn)
(setq n 0)
(while (setq pt (read-line fn))
(setq dm (vl-princ-to-string (read pt)))
(setq zb (substr pt (+ (strlen dm) 1)))
(setq
xyz (trans (read (strcat "(" zb ")"))
1
0
)
)
(setq h (rtos (last xyz) 2 1))
(setq lscale (* l 1))
(entmake
(list (cons 0 "INSERT")
(cons 100 "AcDbEntity")
(cons 8 "GCD")
(cons 100 "AcDbBlockReference")
(cons 10 xyz)
(cons 41 lscale)
(cons 42 lscale)
(cons 43 lscale)
(cons 410 "model")
(cons 2 "gc200")
)
) ;"gc200"为块名
(setq stbmx (itoa 202101))
(dstbm)
(setq xyz1
(polar xyz (/ pi 2) (* l 2))
)
(setq xyz2
(polar xyz (* (/ pi 2) 3) (* l 2))
)
(entmake (list (cons 0 "Text")
(cons 100 "AcDbEntity")
(cons 8 "GCD")
(cons 100 "AcDbText")
(cons 7 "standard")
(cons 1 dm)
(cons 40 wzcl)
(cons 41 0.8)
(cons 410 "model")
(cons 71 0)
(cons 72 4)
(cons 73 0)
(cons 10 xyz1)
(cons 11 xyz1)
)
)
(setq stbmx (itoa 202111))
(dstbm)
(entmake (list (cons 0 "Text")
(cons 100 "AcDbEntity")
(cons 8 "GCD")
(cons 100 "AcDbText")
(cons 7 "hz")
(cons 1 h)
(cons 40 wzch)
(cons 41 0.8)
(cons 410 "model")
(cons 71 0)
(cons 72 4)
(cons 73 0)
(cons 10 xyz2)
(cons 11 xyz2)
)
)
(setq stbmx (itoa 202111))
(dstbm)
(setq n (+ n 1))
)
(if (= pt nil)
(progn
(alert (strcat "*--*展点结束，共展"
(itoa n)
"个点*--*!。"
)
)
(setvar "cmdecho" oldcmd)
(setvar "blipmode" oldblip)
(setvar "osmode" oldsnap)
(setvar "angdir" 1)
(setvar "clayer" "0")
)
)
(close fn)
(command "zoom" "E")
(princ)
)

njcknfy

试了一下，使用entmake的方法，运行的速度确实提高了不少，其实扩展数据项也可以一起写到实体里去，我试过了

njcknfy

发一个地下管线探查数据录入的Access数据库模板供大家参考,希望对大家有帮助,谢谢!

LONGXIN

楼主有没在CAD下用VBA开发access数据库的示例，比如把所有控制点的成表放在一个图幅里，可以用数据库存管理。当在cad下移动一个控制点的位置后其在数据库中的坐标值可以连动更改。

njcknfy

我比较喜欢用文本文件作为中间交换的文件,让LISP把文本文件导入到CAD中建一个表,只要点号没有重复,操作起来也很方便,修改完的文本文件再导回到数据库中,方法比较简单,对VB水平不太高的人很适用