设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › cass中的高程点块参照对象是如何制作的
12345下一页
返回列表 发新帖
楼主: changyiran

cass中的高程点块参照对象是如何制作的

  [复制链接]
nic
发表于 2013-2-28 21:55 | 显示全部楼层
好的东西要加限制才能看的哦
回复 支持 反对

使用道具 举报

nic
发表于 2013-3-7 13:20 | 显示全部楼层
好的东西 要权限[em0]
回复 支持 反对

使用道具 举报

linshiyin2
发表于 2013-3-27 09:17 | 显示全部楼层
Gu_xl 发表于 2012-9-27 10:19
[/post]

可以生成高程点，但是好像cass不能使用这个高程点，难道哈cass自己生成的高程点不一样？
回复 支持 反对

使用道具 举报

linshiyin2
发表于 2013-3-27 09:19 | 显示全部楼层
生成的38.40点不能连成网。

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

ydkliut
发表于 2014-8-12 15:42 | 显示全部楼层
级别低，看不到啊
回复 支持 反对

使用道具 举报

蛮小熊
发表于 2014-8-18 18:05 | 显示全部楼层
我也想知道这个，学习学习
回复 支持 反对

使用道具 举报

zhaiyake
发表于 2014-10-4 22:05 | 显示全部楼层
没权限啊！新手想哭
回复 支持 反对

使用道具 举报

wmz
发表于 2014-10-5 09:28 | 显示全部楼层
本帖最后由 wmz 于 2014-10-5 09:36 编辑
zhaiyake 发表于 2014-10-4 22:05
没权限啊！新手想哭
  2. 这个不要权限！
  3. ;;;;;南方CASS的地形点是用的属性块，他有打散和合并功能，不知是如何实现的(主要指算法)
  4. ;;;;;我现在用LISP写了有此功能的程序，展点，打散，合并等，经改动并与南方cass比较，
  5. ;;;;;运行速度几乎不相上下！现贴出来与大家交流探讨！
  6. ;;;;;以下是我的代码：
  7. (vl-load-com)
  8. ;;;地形展点主程序
  9. (defun c:ZGCD(/ bl fname blxs blc bl sw f pp pt JD y x h ha hb h1 h2 m)
  10.      (defun DSJ(PB)
  11.         (setq  PB (vl-string-translate "," " " PB))
  12.         (setq  PB (read (strcat "(" PB ")")))
  13.      )
  14.   (command "insert" "c:/cass80/blocks/gc200.dwg" (list 0 0 0) 1 1 0) ;;;在CASS环境下此句可不要
  15.   (command "erase" (entlast) "") ;;;在CASS环境下此句可不要
  16.   (regapp "SOUTH") ;;;在CASS环境下此句可不要
  17.   (command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" ""  "")
  18.   (command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
  19.   (setvar "userr1" 1000.0)
  20.   (setq blc (getvar "userr1") blxs (/ blc 1000.0))
  21.   (setq  bl (* blxs 0.2))
  22.   ; (setq name (getfiled "输入文件名:" "" "DAT;TXT;*" 8))
  23.   (setq fname "F:/lsyy/dxd.dat")
  24. ; (setq sw (getreal "输入水位:"))
  25. ; (setq JD (getreal "输入水下点高文字旋转角:"))
  26.   (setq sw 34.58 jd (/ (* 35 pi) 180.0))
  27. ; (setq JD (/ (* JD pi) 180.0))
  28.   (setq pp nil)
  29.   (setq   f (open fname "r"))
  30.   (while
  31.     (setq pp (read-line f))
  32.     (if pp (progn
  33.        (setq pp (cdr(DSJ pp)))
  34.        (setq  y (car pp)  x (cadr pp) h (last pp))
  35.        (setq pt (list y x h))
  36.        (setq ha (rtos h 2 2) hb (rtos h 2 1))
  37.        (setq  m (vl-string-search "." hb))
  38.        (if (= m nil)(progn(setq hb (strcat hb ".0") m (vl-string-search "." hb))));;;在CASS环境下此句可不要
  39.        (cond ((>= h sw)(MINSERTA pt bl ha))
  40.              ((<  h sw)(setq h1 (substr hb 1 m) h2 (substr hb (+ m 2) 1))
  41.                        (MINSERTS pt bl JD h1 h2)
  42.              )
  43.        )     
  44.      ))  
  45.    )
  46.      (close f)
  47.      (command "zoom" "e")
  48. )
  49. ;;;打散
  50. (defun c:DSKY (/ bl blc blxs ZG s n s0 s1 d1 m k jd b)
  51.   (setq blc (getvar "userr1") blxs (/ blc 1000.0))
  52.   (setq  bl (* blxs 0.4) ZG (* 2.0 blxs))
  53.   (setq s (ssget))
  54.   (setq n (sslength s) m 0)
  55.   (repeat n
  56.     (setq s0 (ssname s m) m (+ m 1) k 0)
  57.     (setq s1 (entget s0 (list "SOUTH")))
  58.     (setq d1 (cdr(assoc 10 s1)))
  59.     (setq JD (cdr(assoc 50 s1)))
  60.     (setq  b (cdadr (cadr (assoc -3 s1))))
  61.     (setq  b (vl-princ-to-string b))
  62.     (setq  b (vl-string-translate "" "" B))
  63.     (cond ((= b "202101")(setq height (last d1))
  64.      (MKINSERT d1 bl bl bl JD "202101")
  65.      (MKTEXTA d1 ZG JD (rtos height 2 2) "202111")
  66.     )
  67.     ((= b "186400")(setq H (rtos (last d1) 2 1))
  68.      (setq k (vl-string-search "." h))
  69.      (setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))
  70.      (MKINSERT d1 bl bl bl JD "186400")
  71.      (MKTEXTB d1 ZG JD h1 "186411")
  72.      (MKTEXTC d1 ZG JD h2 "186412")
  73.     )
  74.     )
  75.   )
  76.           (command "_.erase" s "")
  77. )
  78. ;;;合并
  79. (defun c:HBKY (/ bl blc blxs ZG lay s n s0 s1 d1 m k jd b STIME ETIME)
  80.   (command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" ""  "")
  81.   (setq blc (getvar "userr1") blxs (/ blc 1000.0))
  82.   (setq  bl (* blxs 0.2) ZG (* 2.0 blxs))
  83.   (setq s (ssget))
  84.   (setq STIME (getvar "date"))
  85.   (setq n (sslength s) m 0)
  86.   (repeat n
  87.     (setq  s0 (ssname s m) m (+ m 1) k 0)
  88.     (setq  s1 (entget s0 (list "SOUTH")))
  89.     (setq lay (cdr(assoc 8 s1)))
  90.     (setq   e (cdr(assoc 0 s1)))
  91.     (if (and(= e "INSERT")(= lay "GCD"))(progn
  92.        (setq d1 (cdr(assoc 10 s1)))
  93.        (setq JD (cdr(assoc 50 s1)))
  94.        (setq  b (cdadr (cadr (assoc -3 s1))))
  95.        (setq  b (vl-princ-to-string b))
  96.        (setq  b (vl-string-translate "" "" B))
  97.        (cond ((= b "202101")(setq height (rtos (last d1) 2 2))
  98.         (MINSERTA d1 bl height)
  99.        )
  100.        ((= b "186400")(setq H (rtos (last d1) 2 1))
  101.         (setq k (vl-string-search "." h))
  102.         (setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))
  103.         (MINSERTS d1 bl JD h1 h2)
  104.        )
  105.        )
  106.      ))
  107.   )
  108.        (command "_.erase" s "")
  109.   (setq ETIME (getvar "date"))
  110.   (prompt
  111.     (strcat
  112.       "\n程式共耗用时间: "
  113.       (rtos (* 86400.0 (- (- ETIME STIME) (fix (- ETIME STIME)))) 2 3)
  114.       "秒"
  115.     )
  116.   )
  117. )
  118. ;;;调用南方CASS命令合并
  119. (defun c:CASShb(/ s STIME)
  120.   (setq s (ssget))
  121.   (setq STIME (getvar "date"))
  122.   (command "resumegcd" s "");;;这个就是南方的合并命令,explodegcd 就是打散命令
  123.   (setq ETIME (getvar "date"))
  124.   (prompt
  125.     (strcat
  126.       "\n程式共耗用时间: "
  127.       (rtos (* 86400.0 (- (- ETIME STIME) (fix (- ETIME STIME)))) 2 3)
  128.       "秒"
  129.     )
  130.   )
  131. )  
  132.   
  133. ;;插入块打散后用
  134. (defun MKINSERT (PT SX SY SSZ ZJ DATA)
  135.   (entmake (list '(0 . "INSERT")
  136.                  '(100 . "AcDbBlockReference")
  137.                  (cons 2 "GC200")
  138.                  (cons 8 "GCD")
  139.                  (cons 10 PT)
  140.                  (cons 41 SX)
  141.                  (cons 42 SY)
  142.                  (cons 43 SSZ)
  143.                  (cons 50 ZJ)
  144.                  (list -3 (list "SOUTH" (cons 1000 DATA)))
  145.             )
  146.   )
  147. )
  148. ;;;写文字岸上点打散后用
  149. (defun MKTEXTA (PT HEI ANG STR DATA / PTX TOBJ)
  150.     (setq pty (polar pt ANG 0.5))
  151.     (entmake (list '(0 . "TEXT")
  152.                    (cons 7 "HZ")
  153.                    (cons 8 "GCD")      
  154.                    (cons 10 PT)
  155.                    (cons 40 HEI) ;;字高
  156.                    (cons 41 0.8)      
  157.                    (cons 50 ANG)
  158.                    (cons 1 STR)
  159.                    (cons 72 0)  ;;左对齐
  160.                    (cons 73 2)
  161.                    (cons 11 pty)
  162.                    (list -3 (list "SOUTH" (cons 1000 DATA)))
  163.               )
  164.     )
  165. )
  166. ;;;写文字水下点左打散后用
  167. (defun MKTEXTB (PT HEI ANG STR DATA / PTz TOBJ)
  168.     (setq ptz (polar pt ANG -0.8))
  169.     (entmake (list '(0 . "TEXT")
  170.                    (cons 7 "HZ")
  171.                    (cons 8 "GCD")      
  172.                    (cons 10 PT)
  173.                    (cons 40 HEI) ;;字高
  174.                    (cons 41 0.8)      
  175.                    (cons 50 ANG)
  176.                    (cons 1 STR)
  177.                    (cons 11 ptz)
  178.                    (cons 72 2)  ;;右对齐
  179.                    (cons 73 0)
  180.                    (list -3 (list "SOUTH" (cons 1000 DATA)))
  181.               )
  182.     )
  183. )
  184. ;;;写文字水下点右打散后用
  185. (defun MKTEXTC (PT HEI ANG STR DATA / PTy TOBJ)
  186.     (setq pty (polar pt ANG 0.6))
  187.     (entmake (list '(0 . "TEXT")
  188.                    (cons 7 "HZ")
  189.                    (cons 8 "GCD")      
  190.                    (cons 10 PTy)
  191.                    (cons 40 HEI) ;;字高
  192.                    (cons 41 0.8)      
  193.                    (cons 50 ANG)
  194.                    (cons 1 STR)
  195.                    (cons 11 pty)
  196.                    (cons 72 0)  ;;左对齐
  197.                    (cons 73 0)
  198.                    (list -3 (list "SOUTH" (cons 1000 DATA)))
  199.               )
  200.     )
  201. )
  202. ;;;插入块(岸上点)
  203. (defun MINSERTA (inspt scale height / pt)
  204.   (setq pt (polar inspt 0 (* 1.2 scale)))
  205.   (entmake (list
  206.              '(0 . "INSERT")
  207.              '(100 . "AcDbEntity")
  208.              '(100 . "AcDbBlockReference")
  209.              '(66 . 1)
  210.              (cons 2 "GC200")
  211.              (cons 10 inspt)
  212.              (cons 41 scale)
  213.              (cons 42 scale)
  214.              (cons 43 scale)
  215.              '(-3 ("SOUTH" (1000 . "202101")))
  216.            )
  217.   )
  218.   ;;;插入属性
  219.     (entmake (list
  220.             '(0 . "ATTRIB")
  221.             '(100 . "AcDbEntity")
  222.             '(100 . "AcDbText")
  223.             (cons 10 pt)
  224.             (cons 40 (* 10.0 scale))
  225.             (cons 50 0)
  226.             (cons 41 0.8)
  227.             (cons 51 0)
  228.             (cons 1 height)
  229.             (cons 7 "HZ")
  230.             (cons 72 0)
  231.             (cons 11 pt)
  232.             '(100 . "AcDbAttribute")
  233.             (cons 2 "height")
  234.             (cons 70 0)
  235.             (cons 74 2)
  236.            )
  237.     )
  238.            ;;;结束标志
  239.           (entmake '((0 . "SEQEND")))
  240.            (princ)
  241.   )
  242. ;;;插入块(水下点)
  243. (defun MINSERTS (inspt scale JD integer decimal / pt ptz pty)
  244.   (setq pt (polar inspt 0 (* 1.2 scale)))
  245.   (setq ptz (polar pt jd -0.8))
  246.   (setq pty (polar pt jd 0.5))
  247.   (entmake (list
  248.              '(0 . "INSERT")
  249.              '(100 . "AcDbEntity")
  250.              '(100 . "AcDbBlockReference")
  251.              '(66 . 1)
  252.              (cons 2 "GC200")
  253.              (cons 10 inspt)
  254.              (cons 41 scale)
  255.              (cons 42 scale)
  256.              (cons 43 scale)
  257.              (cons 50 JD)
  258.              '(-3 ("SOUTH" (1000 . "186400")))
  259.            )
  260.   )
  261.   ;;;插入属性
  262.     (entmake (list
  263.             '(0 . "ATTRIB")
  264.             '(100 . "AcDbEntity")
  265.             '(100 . "AcDbText")
  266.             (cons 10 pt)
  267.             (cons 40 (* 10.0 scale))
  268.             (cons 50 JD)
  269.             (cons 41 0.8)
  270.             (cons 51 0)
  271.             (cons 1 integer)
  272.             (cons 7 "HZ")
  273.             (cons 72 2)  ;;右对齐
  274.             (cons 11 ptz)
  275.             '(100 . "AcDbAttribute")
  276.             (cons 2 "integer")
  277.             (cons 70 0)
  278.             (cons 73 2)
  279.             (cons 74 1)
  280.            )
  281.     )
  282.     (entmake (list
  283.             '(0 . "ATTRIB")
  284.             '(100 . "AcDbEntity")
  285.             '(100 . "AcDbText")
  286.             (cons 10 pt)
  287.             (cons 40 (* 10.0 scale))
  288.             (cons 50 JD)
  289.             (cons 41 0.8)
  290.             (cons 51 0)
  291.             (cons 1 decimal)
  292.             (cons 7 "HZ")
  293.             (cons 72 0) ;;左对齐
  294.             (cons 11 pty)
  295.             '(100 . "AcDbAttribute")
  296.             (cons 2 "decimal")
  297.             (cons 70 0)
  298.             (cons 73 2)
  299.             (cons 74 1)
  300.            )
  301.     )
  302.            ;;;结束标志
  303.           (entmake '((0 . "SEQEND")))
  304.            (princ)
  305.   )
回复 支持 反对

使用道具 举报

aliang1994
发表于 2015-3-18 08:37 | 显示全部楼层
很想学习学习
回复 支持 反对

使用道具 举报

夜海繁星
发表于 2015-8-5 06:39 | 显示全部楼层
发帖多于是10.。。。
回复 支持 反对

使用道具 举报

12345下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-4-25 18:31 , Processed in 0.669197 second(s), 19 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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