根据南方高程点字体大小选择高程点
;选择集与对象名表互转(defun cx-ss2en
(ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
((='ename(type ss))
(ssadd ss)
)
)
)
(defun c:xzwt ( / bm ss i lst e en lstt);输入南方CASS编码批量选择物体
;(setq bm(cons 1000 (rtos(getreal "请输入高程点字高 \n" )2 0)) )
(setq bm (getreal "请输入高程点字高 \n" ))
(setq ss (ssget "x"'((0 . "INSERT")(2 . "GC200") ) ))
(setq i 0)
(setq lst '())
(repeat (sslength ss)
(setq e (ssname ss i))
(setq en (entget e '("*")))
(if
(equal (cdr(assoc 40 (entget(entnext e) ) )) bm)
(setq lst (appendlst (list e)))
)
(setqi(1+ i))
)
(setq lstt (cx-ss2en lst))
(sssetfirst nil lstt)
)
;(cdr(assoc 40 (entget(entnext(car(entsel))) ) ))
(cdr(assoc 7 (entget(entnext(car(entsel))) ) ))选择 字体 谢谢分享 加上根据Z值修改高程文字内容
;|
将程序以ggcys.lsp存盘，在CASS中有appload命令加载此程序，
再一命令行中键入ggcys回车即可使用。输入颜色号，选择要改
变颜色的GC200块中高程文本即达到要求。
|;
;批量改变GC200块中高程文本的颜色
(defun c:ggcys()
(vl-load-com)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_undo" "be")
(if (setq col (getint "\n请输入颜色号<0>:"))
(if (<= 0 col 255)
(if (setq ssa (ssget '((0 . "INSERT") (2 . "GC200") (-3 ("SOUTH" )))))
(progn
(setqn(sslength ssa) i 0)
(repeat n
(setq ent (entnext (ssname ssa i))
vob (vlax-ename->vla-object ent)
)
(vla-put-TextString vob (rtos (LAST(ASSOC 10(ENTGET ENT))) 2 3 ) )
(vla-put-color vob col)
(vla-update vob)
(setq i (1+ i))
)
)
)
)
)
(command "_undo" "e")
(setvar "cmdecho" cmd)
(princ)
)
; (rtos (LAST(ASSOC 10(ENTGET ENT))) 2 3 )
查找南方高程点与高程注记不符
;|
将程序以ggcys.lsp存盘，在CASS中有appload命令加载此程序，
再一命令行中键入ggcys回车即可使用。输入颜色号，选择要改
变颜色的GC200块中高程文本即达到要求。
|;
;批量改变GC200块中高程文本的颜色
(defun c:ggcys(/gcz zz 10zu)
(vl-load-com)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_undo" "be")
(if (setq col (getint "\n请输入颜色号<0>:"))
(if (<= 0 col 255)
(if (setq ssa (ssget '((0 . "INSERT") (2 . "GC200") (-3 ("SOUTH" )))))
(progn
(setqn(sslength ssa) i 0)
(repeat n
(setq ent (entnext (ssname ssa i))
vob (vlax-ename->vla-object ent)
)
(setq 10zu (assoc 10(entget(ssname ssa i) )))
(setq gcz (last 10zu ))
(setq zz (read(cdr(assoc 1(entget ent)))) )
(if (equal gcz zz 0.0100) "YES! ! " (progn (vla-put-color vob col)
(vla-update vob)
(entmake (list'(0 . "CIRCLE") ; 图元形态
'(8 . "ccgcd")
'(62 . 1) ; 颜色
10zu ; 圆心
'(40 . 10) ; 半径
)
)
);;;;
)
(setq i (1+ i))
)
)
)
)
)
(command "_undo" "e")
(setvar "cmdecho" cmd)
(princ)
)
页:
[1]