根据南方高程点字体大小选择高程点

树櫴希德

1. ;选择集与对象名表互转
   
2. (defun cx-ss2en
   
3.   (ss / enlst)
   
4.   (cond
   
5.     ((= (type ss) 'PICKSET)
   
6.       (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
   
7.     )
   
8.     ((= (type ss) 'LIST)
   
9.       (setq enlst (ssadd))
   
10.       (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
    
11.     )
    
12.     ((='ename(type ss))
    
13.       (ssadd ss)
    
14.     )
    
15.   )
    
16. )
    
17. (defun c:xzwt ( / bm ss i lst e en lstt);输入南方CASS编码批量选择物体
    
18. ;(setq bm(cons 1000 (rtos(getreal "请输入高程点字高 \n" )2 0)) )
    
19. (setq bm (getreal "请输入高程点字高 \n" ))
    
20. (setq ss (ssget "x"'((0 . "INSERT")(2 . "GC200") )   ))
    
21. (setq i 0)
    
22. (setq lst '())
    
23.    (repeat (sslength ss)
    
24. 
    
25.      (setq e (ssname ss i))
    
26.        (setq en (entget e '("*")))
    
27.      
    
28. (if  
    
29.      (equal (cdr(assoc 40 (entget(entnext e) ) )) bm)
    
30.   
    
31.         (setq lst (append  lst (list e))  )
    
32.          )
    
33.      (setq  i  (1+ i))
    
34.      
    
35.      )
    
36. (setq lstt (cx-ss2en lst))
    
37. (sssetfirst nil lstt)
    
38.   
    
39. )
    
40. 
    
41. ;(cdr(assoc 40 (entget(entnext(car(entsel))) ) ))
    

;选择集与对象名表互转<br /> (defun cx-ss2en<br />   (ss / enlst)<br />   (cond<br />     ((= (type ss) 'PICKSET)<br />       (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))<br />     )<br />     ((= (type ss) 'LIST)<br />       (setq enlst (ssadd))<br />       (last (mapcar '(lambda (x) (ssadd x enlst)) ss))<br />     )<br />     ((='ename(type ss))<br />       (ssadd ss)<br />     )<br />   )<br /> )<br /> (defun c:xzwt ( / bm ss i lst e en lstt);输入南方CASS编码批量选择物体<br /> ;(setq bm(cons 1000 (rtos(getreal "请输入高程点字高 \n" )2 0)) )<br /> (setq bm (getreal "请输入高程点字高 \n" ))<br /> (setq ss (ssget "x"'((0 . "INSERT")(2 . "GC200") )   ))<br /> (setq i 0)<br /> (setq lst '())<br />    (repeat (sslength ss)<br /> <br />      (setq e (ssname ss i))<br />        (setq en (entget e '("*")))<br />      <br /> (if  <br />      (equal (cdr(assoc 40 (entget(entnext e) ) )) bm)<br />   <br />         (setq lst (append  lst (list e))  )<br />          )<br />      (setq  i  (1+ i))<br />      <br />      )<br /> (setq lstt (cx-ss2en lst))<br /> (sssetfirst nil lstt)<br />   <br /> )<br /> <br /> ;(cdr(assoc 40 (entget(entnext(car(entsel))) ) ))<br />

gzxl

谢谢分享

树櫴希德

1. (cdr(assoc 7 (entget(entnext(car(entsel))) ) ))

(cdr(assoc 7 (entget(entnext(car(entsel))) ) ))

  选择 字体

树櫴希德

加上根据Z值修改高程文字内容

1. ;|
   
2. 将程序以ggcys.lsp存盘，在CASS中有appload命令加载此程序，
   
3. 再一命令行中键入ggcys回车即可使用。输入颜色号，选择要改
   
4. 变颜色的GC200块中高程文本即达到要求。
   
5. |;
   
6. ;批量改变GC200块中高程文本的颜色
   
7. (defun c:ggcys()
   
8.     (vl-load-com)
   
9.     (setq cmd (getvar "cmdecho"))
   
10.     (setvar "cmdecho" 0)
    
11.     (command "_undo" "be")
    
12.     (if (setq col (getint "\n请输入颜色号[0～255]<0>:"))
    
13.     (if (<= 0 col 255)
    
14.         (if (setq ssa (ssget '((0 . "INSERT") (2 . "GC200") (-3 ("SOUTH" )))))
    
15.       (progn
    
16.          (setq  n  (sslength ssa)   i 0)
    
17.                      (repeat n
    
18.                         (setq ent (entnext (ssname ssa i))
    
19.                         vob (vlax-ename->vla-object ent)
    
20.                         )
    
21.            
    
22.            (vla-put-TextString vob (rtos (LAST(ASSOC 10(ENTGET ENT))) 2 3 )   )
    
23.            
    
24.                         (vla-put-color vob col)
    
25.            
    
26.                         (vla-update vob)
    
27.                         (setq i (1+ i))
    
28.                      )
    
29.       )
    
30.         )
    
31.     )
    
32.     )
    
33.     (command "_undo" "e")
    
34.     (setvar "cmdecho" cmd)
    
35.     (princ)
    
36. )
    
37. 
    
38. ; (rtos (LAST(ASSOC 10(ENTGET ENT))) 2 3 )

;|<br /> 将程序以ggcys.lsp存盘，在CASS中有appload命令加载此程序，<br /> 再一命令行中键入ggcys回车即可使用。输入颜色号，选择要改<br /> 变颜色的GC200块中高程文本即达到要求。<br /> |;<br /> ;批量改变GC200块中高程文本的颜色<br /> (defun c:ggcys()<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 />            <br />            (vla-put-TextString vob (rtos (LAST(ASSOC 10(ENTGET ENT))) 2 3 )   )<br />            <br />                         (vla-put-color vob col)<br />            <br />                         (vla-update vob)<br />                         (setq i (1+ i))<br />                      )<br />       )<br />         )<br />     )<br />     )<br />     (command "_undo" "e")<br />     (setvar "cmdecho" cmd)<br />     (princ)<br /> )<br /> <br /> ; (rtos (LAST(ASSOC 10(ENTGET ENT))) 2 3 )

树櫴希德

查找南方高程点与高程注记不符

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

;|<br /> 将程序以ggcys.lsp存盘，在CASS中有appload命令加载此程序，<br /> 再一命令行中键入ggcys回车即可使用。输入颜色号，选择要改<br /> 变颜色的GC200块中高程文本即达到要求。<br /> |;<br /> ;批量改变GC200块中高程文本的颜色<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 /> )