明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1579|回复: 4

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

[复制链接]
发表于 2018-5-6 14:44:57 | 显示全部楼层 |阅读模式
  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.      (setq e (ssname ss i))
  25.        (setq en (entget e '("*")))
  26.      
  27. (if  
  28.      (equal (cdr(assoc 40 (entget(entnext e) ) )) bm)
  29.   
  30.         (setq lst (append  lst (list e))  )
  31.          )
  32.      (setq  i  (1+ i))
  33.      
  34.      )
  35. (setq lstt (cx-ss2en lst))
  36. (sssetfirst nil lstt)
  37.   
  38. )

  39. ;(cdr(assoc 40 (entget(entnext(car(entsel))) ) ))

 楼主| 发表于 2018-5-7 21:50:56 | 显示全部楼层
  1. (cdr(assoc 7 (entget(entnext(car(entsel))) ) ))
  选择 字体
回复 支持 0 反对 1

使用道具 举报

 楼主| 发表于 2020-10-16 22:00:14 | 显示全部楼层
加上根据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. ; (rtos (LAST(ASSOC 10(ENTGET ENT))) 2 3 )

 楼主| 发表于 2022-1-4 19:28:30 | 显示全部楼层
查找南方高程点与高程注记不符

  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.                        '(62 . 1)                    ; 颜色

  29.                       10zu        ; 圆心

  30.                       '(40 . 10)                  ; 半径

  31.                        )

  32.       )        
  33.              )  ;;;;
  34.            )
  35.            
  36.                         
  37.                         (setq i (1+ i))
  38.                      )
  39.       )
  40.         )
  41.     )
  42.     )
  43.     (command "_undo" "e")
  44.     (setvar "cmdecho" cmd)
  45.     (princ)
  46. )

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-5 23:21 , Processed in 0.192594 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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