[原创]一个检查高程点高程和注记值是否相符的小程序

spp_wall

wmz 发表于 2014-7-4 08:58
(vl-load-com)

;;;测点高程值与高程注记匹配

在08怎么无法用呢

zhangxin0298

楼主，能分享下原代码吗？

zhangxin0298

支持楼主共享源码

zhangxin0298

请发个源码，楼主，急用，感谢QQ:597223788

jxy308

楼主辛苦，支持下

yoyoho

支持楼主分享源码!!!!

乡村小溪

感谢楼主分享源码

树櫴希德

2. ;|
   
3. 将程序以ggcys.lsp存盘，在CASS中有appload命令加载此程序，
   
4. 再一命令行中键入ggcys回车即可使用。输入颜色
   
5. 变颜色的GC200块中高程文本即达到要求。
   
6. |;
   
7. ;
   
8. (defun c:ggcys(  /  gcz zz 10zu)
   
9.     (vl-load-com)
   
10.     (setq cmd (getvar "cmdecho"))
    
11.     (setvar "cmdecho" 0)
    
12.     (command "_undo" "be")
    
13.     (if (setq col (getint "\n请输入颜色号[0～255]<0>:"))
    
14.     (if (<= 0 col 255)
    
15.         (if (setq ssa (ssget '((0 . "INSERT") (2 . "GC200") (-3 ("SOUTH" )))))
    
16.       (progn
    
17.          (setq  n  (sslength ssa)   i 0)
    
18.                      (repeat n
    
19.                         (setq ent (entnext (ssname ssa i))
    
20.                   号，选择要改      vob (vlax-ename->vla-object ent)
    
21.                         )
    
22.            (setq 10zu (assoc 10(entget(ssname ssa i) )))
    
23.                      (setq gcz (last 10zu ))
    
24.            (setq zz (read(cdr(assoc 1(entget ent))))      )
    
25.                      (if (equal gcz zz 0.0100) "YES! ! " (progn (vla-put-color vob col)
    
26.                         (vla-update vob)
    
27.         (entmake         (list  '(0 . "CIRCLE")       ; 图元形态
    
28.        '(8 . "ccgcd")
    
29. 
    
30.                        '(62 . 1)                    ; 颜色
    
31. 
    
32.                       10zu        ; 圆心
    
33. 
    
34.                       '(40 . 10)                  ; 半径
    
35. 
    
36.                        )
    
37. 
    
38.       )        
    
39.              )  ;;;;
    
40.            )
    
41.            
    
42.                         
    
43.                         (setq i (1+ i))
    
44.                      )
    
45.       )
    
46.         )
    
47.     )
    
48.     )
    
49.     (command "_undo" "e")
    
50.     (setvar "cmdecho" cmd)
    
51.     (princ)
    
52. )

;|<br /> 将程序以ggcys.lsp存盘，在CASS中有appload命令加载此程序，<br /> 再一命令行中键入ggcys回车即可使用。输入颜色<br /> 变颜色的GC200块中高程文本即达到要求。<br /> |;<br /> ;<br /> (defun c:ggcys(  /  gcz zz 10zu)<br />     (vl-load-com)<br />     (setq cmd (getvar "cmdecho"))<br />     (setvar "cmdecho" 0)<br />     (command "_undo" "be")<br />     (if (setq col (getint "\n请输入颜色号[0～255]<0>:"))<br />     (if (<= 0 col 255)<br />         (if (setq ssa (ssget '((0 . "INSERT") (2 . "GC200") (-3 ("SOUTH" )))))<br />       (progn<br />          (setq  n  (sslength ssa)   i 0)<br />                      (repeat n<br />                         (setq ent (entnext (ssname ssa i))<br />                   号，选择要改      vob (vlax-ename->vla-object ent)<br />                         )<br />            (setq 10zu (assoc 10(entget(ssname ssa i) )))<br />                      (setq gcz (last 10zu ))<br />            (setq zz (read(cdr(assoc 1(entget ent))))      )<br />                      (if (equal gcz zz 0.0100) "YES! ! " (progn (vla-put-color vob col)<br />                         (vla-update vob)<br />         (entmake         (list  '(0 . "CIRCLE")       ; 图元形态<br />        '(8 . "ccgcd")<br /> <br />                        '(62 . 1)                    ; 颜色<br /> <br />                       10zu        ; 圆心<br /> <br />                       '(40 . 10)                  ; 半径<br /> <br />                        )<br /> <br />       )        <br />              )  ;;;;<br />            )<br />            <br />                         <br />                         (setq i (1+ i))<br />                      )<br />       )<br />         )<br />     )<br />     )<br />     (command "_undo" "e")<br />     (setvar "cmdecho" cmd)<br />     (princ)<br /> )

gzxl

哦，测绘版块就你还在坚持。

gwar

非常感谢楼主