好的东西要加限制才能看的哦
好的东西 要权限
Gu_xl 发表于 2012-9-27 10:19 static/image/common/back.gif
可以生成高程点，但是好像cass不能使用这个高程点，难道哈cass自己生成的高程点不一样？
生成的38.40点不能连成网。
级别低，看不到啊
我也想知道这个，学习学习
没权限啊！新手想哭
本帖最后由 wmz 于 2014-10-5 09:36 编辑
zhaiyake 发表于 2014-10-4 22:05 static/image/common/back.gif
没权限啊！新手想哭这个不要权限！
;;;;;南方CASS的地形点是用的属性块，他有打散和合并功能，不知是如何实现的(主要指算法)
;;;;;我现在用LISP写了有此功能的程序，展点，打散，合并等，经改动并与南方cass比较，
;;;;;运行速度几乎不相上下！现贴出来与大家交流探讨！
;;;;;以下是我的代码：
(vl-load-com)
;;;地形展点主程序
(defun c:ZGCD(/ bl fname blxs blc bl sw f pp pt JD y x h ha hb h1 h2 m)
(defun DSJ(PB)
(setqPB (vl-string-translate "," " " PB))
(setqPB (read (strcat "(" PB ")")))
)
(command "insert" "c:/cass80/blocks/gc200.dwg" (list 0 0 0) 1 1 0) ;;;在CASS环境下此句可不要
(command "erase" (entlast) "") ;;;在CASS环境下此句可不要
(regapp "SOUTH") ;;;在CASS环境下此句可不要
(command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" """")
(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
(setvar "userr1" 1000.0)
(setq blc (getvar "userr1") blxs (/ blc 1000.0))
(setqbl (* blxs 0.2))
; (setq name (getfiled "输入文件名:" "" "DAT;TXT;*" 8))
(setq fname "F:/lsyy/dxd.dat")
; (setq sw (getreal "输入水位:"))
; (setq JD (getreal "输入水下点高文字旋转角:"))
(setq sw 34.58 jd (/ (* 35 pi) 180.0))
; (setq JD (/ (* JD pi) 180.0))
(setq pp nil)
(setq f (open fname "r"))
(while
(setq pp (read-line f))
(if pp (progn
(setq pp (cdr(DSJ pp)))
(setqy (car pp)x (cadr pp) h (last pp))
(setq pt (list y x h))
(setq ha (rtos h 2 2) hb (rtos h 2 1))
(setqm (vl-string-search "." hb))
(if (= m nil)(progn(setq hb (strcat hb ".0") m (vl-string-search "." hb))));;;在CASS环境下此句可不要
(cond ((>= h sw)(MINSERTA pt bl ha))
((<h sw)(setq h1 (substr hb 1 m) h2 (substr hb (+ m 2) 1))
(MINSERTS pt bl JD h1 h2)
)
)
))
)
(close f)
(command "zoom" "e")
)
;;;打散
(defun c:DSKY (/ bl blc blxs ZG s n s0 s1 d1 m k jd b)
(setq blc (getvar "userr1") blxs (/ blc 1000.0))
(setqbl (* blxs 0.4) ZG (* 2.0 blxs))
(setq s (ssget))
(setq n (sslength s) m 0)
(repeat n
(setq s0 (ssname s m) m (+ m 1) k 0)
(setq s1 (entget s0 (list "SOUTH")))
(setq d1 (cdr(assoc 10 s1)))
(setq JD (cdr(assoc 50 s1)))
(setqb (cdadr (cadr (assoc -3 s1))))
(setqb (vl-princ-to-string b))
(setqb (vl-string-translate "" "" B))
(cond ((= b "202101")(setq height (last d1))
(MKINSERT d1 bl bl bl JD "202101")
(MKTEXTA d1 ZG JD (rtos height 2 2) "202111")
)
((= b "186400")(setq H (rtos (last d1) 2 1))
(setq k (vl-string-search "." h))
(setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))
(MKINSERT d1 bl bl bl JD "186400")
(MKTEXTB d1 ZG JD h1 "186411")
(MKTEXTC d1 ZG JD h2 "186412")
)
)
)
(command "_.erase" s "")
)
;;;合并
(defun c:HBKY (/ bl blc blxs ZG lay s n s0 s1 d1 m k jd b STIME ETIME)
(command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" """")
(setq blc (getvar "userr1") blxs (/ blc 1000.0))
(setqbl (* blxs 0.2) ZG (* 2.0 blxs))
(setq s (ssget))
(setq STIME (getvar "date"))
(setq n (sslength s) m 0)
(repeat n
(setqs0 (ssname s m) m (+ m 1) k 0)
(setqs1 (entget s0 (list "SOUTH")))
(setq lay (cdr(assoc 8 s1)))
(setq e (cdr(assoc 0 s1)))
(if (and(= e "INSERT")(= lay "GCD"))(progn
(setq d1 (cdr(assoc 10 s1)))
(setq JD (cdr(assoc 50 s1)))
(setqb (cdadr (cadr (assoc -3 s1))))
(setqb (vl-princ-to-string b))
(setqb (vl-string-translate "" "" B))
(cond ((= b "202101")(setq height (rtos (last d1) 2 2))
(MINSERTA d1 bl height)
)
((= b "186400")(setq H (rtos (last d1) 2 1))
(setq k (vl-string-search "." h))
(setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))
(MINSERTS d1 bl JD h1 h2)
)
)
))
)
(command "_.erase" s "")
(setq ETIME (getvar "date"))
(prompt
(strcat
"\n程式共耗用时间: "
(rtos (* 86400.0 (- (- ETIME STIME) (fix (- ETIME STIME)))) 2 3)
"秒"
)
)
)
;;;调用南方CASS命令合并
(defun c:CASShb(/ s STIME)
(setq s (ssget))
(setq STIME (getvar "date"))
(command "resumegcd" s "");;;这个就是南方的合并命令,explodegcd 就是打散命令
(setq ETIME (getvar "date"))
(prompt
(strcat
"\n程式共耗用时间: "
(rtos (* 86400.0 (- (- ETIME STIME) (fix (- ETIME STIME)))) 2 3)
"秒"
)
)
)
;;插入块打散后用
(defun MKINSERT (PT SX SY SSZ ZJ DATA)
(entmake (list '(0 . "INSERT")
'(100 . "AcDbBlockReference")
(cons 2 "GC200")
(cons 8 "GCD")
(cons 10 PT)
(cons 41 SX)
(cons 42 SY)
(cons 43 SSZ)
(cons 50 ZJ)
(list -3 (list "SOUTH" (cons 1000 DATA)))
)
)
)
;;;写文字岸上点打散后用
(defun MKTEXTA (PT HEI ANG STR DATA / PTX TOBJ)
(setq pty (polar pt ANG 0.5))
(entmake (list '(0 . "TEXT")
(cons 7 "HZ")
(cons 8 "GCD")
(cons 10 PT)
(cons 40 HEI) ;;字高
(cons 41 0.8)
(cons 50 ANG)
(cons 1 STR)
(cons 72 0);;左对齐
(cons 73 2)
(cons 11 pty)
(list -3 (list "SOUTH" (cons 1000 DATA)))
)
)
)
;;;写文字水下点左打散后用
(defun MKTEXTB (PT HEI ANG STR DATA / PTz TOBJ)
(setq ptz (polar pt ANG -0.8))
(entmake (list '(0 . "TEXT")
(cons 7 "HZ")
(cons 8 "GCD")
(cons 10 PT)
(cons 40 HEI) ;;字高
(cons 41 0.8)
(cons 50 ANG)
(cons 1 STR)
(cons 11 ptz)
(cons 72 2);;右对齐
(cons 73 0)
(list -3 (list "SOUTH" (cons 1000 DATA)))
)
)
)
;;;写文字水下点右打散后用
(defun MKTEXTC (PT HEI ANG STR DATA / PTy TOBJ)
(setq pty (polar pt ANG 0.6))
(entmake (list '(0 . "TEXT")
(cons 7 "HZ")
(cons 8 "GCD")
(cons 10 PTy)
(cons 40 HEI) ;;字高
(cons 41 0.8)
(cons 50 ANG)
(cons 1 STR)
(cons 11 pty)
(cons 72 0);;左对齐
(cons 73 0)
(list -3 (list "SOUTH" (cons 1000 DATA)))
)
)
)
;;;插入块(岸上点)
(defun MINSERTA (inspt scale height / pt)
(setq pt (polar inspt 0 (* 1.2 scale)))
(entmake (list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1)
(cons 2 "GC200")
(cons 10 inspt)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
'(-3 ("SOUTH" (1000 . "202101")))
)
)
;;;插入属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 pt)
(cons 40 (* 10.0 scale))
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
(cons 1 height)
(cons 7 "HZ")
(cons 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 70 0)
(cons 74 2)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
;;;插入块(水下点)
(defun MINSERTS (inspt scale JD integer decimal / pt ptz pty)
(setq pt (polar inspt 0 (* 1.2 scale)))
(setq ptz (polar pt jd -0.8))
(setq pty (polar pt jd 0.5))
(entmake (list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1)
(cons 2 "GC200")
(cons 10 inspt)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
(cons 50 JD)
'(-3 ("SOUTH" (1000 . "186400")))
)
)
;;;插入属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 pt)
(cons 40 (* 10.0 scale))
(cons 50 JD)
(cons 41 0.8)
(cons 51 0)
(cons 1 integer)
(cons 7 "HZ")
(cons 72 2);;右对齐
(cons 11 ptz)
'(100 . "AcDbAttribute")
(cons 2 "integer")
(cons 70 0)
(cons 73 2)
(cons 74 1)
)
)
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 pt)
(cons 40 (* 10.0 scale))
(cons 50 JD)
(cons 41 0.8)
(cons 51 0)
(cons 1 decimal)
(cons 7 "HZ")
(cons 72 0) ;;左对齐
(cons 11 pty)
'(100 . "AcDbAttribute")
(cons 2 "decimal")
(cons 70 0)
(cons 73 2)
(cons 74 1)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
很想学习学习
发帖多于是10.。。。