修改块中文字属性值的程序

QUAN2518 · 发表于 2007-11-23 23:22:00

看了下表达式

（IF ****）

当条件成立时执行操作“T”条件外时执行操作

但是我要求在条件成立时不执行任何操作。

当条件不成立时才有操作要求。

找了下没找到关于条件不成立的比较式。那个来提示一下谢谢了先。

etom999 · 发表于 2008-1-25 11:03:00

多谢版主！

狂刀无痕 · 发表于 2008-1-25 18:40:00

;| xattd = 属性块实体属性显示&隐藏开关---ok!-----by 梁雄啸.2005.10
相关: attdisp 命令,只能全局打开或关闭属性.本程序可局部控制选中的带属性块的属性显示.
|;
(defun c:xattd (/ k kk ss vss)
(setq *doc (vla-get-activedocument(vlax-get-acad-object))) ;全局.
(initget 0 "V X")
(setq k (getkword "\n 块属性: v-显示 / x-关闭 / <自动切换>"))
(cond
((= k "V")(setq k ':vlax-true))
((= k "X")(setq k ':vlax-false))
)
(while (setq ss (ssget '((0 . "INSERT")(66 . 1)))) ;; 循环选择.
(vla-delete (vla-item (vla-get-selectionsets *doc) 0)) ;;排除bug.
(setq vss(vla-get-activeselectionset *doc))
(vlax-map-collection
vss
'(lambda (x)
(mapcar '(lambda (y)
(if k
(vla-put-Visible y k)
(progn
(if (eq :vlax-false (vla-get-Visible y))
(setq kk ':vlax-true)
(setq kk ':vlax-false)
)
(vla-put-Visible y kk)
)
)
)
(vlax-invoke x 'GetAttributes)
)
)
)
)
(princ)
)

etom999 · 发表于 2008-1-30 11:03:00

23楼在CAD2002不能运行,
;48--- 关闭属性显示 ---
(DEFUN C:OFFATT()
(IF(AND(PRINC "\\n选择带属性图块 :")
         (SETQ SS (SSGET '((0 . "INSERT")(66 . 1))))
     )
     (PROGN
       (SETQ I -1)
       (REPEAT(SSLENGTH SS)
         (SETQ ENT (ENTGET(SSNAME SS (SETQ I (1+ I))))
               ENT1 ENT
         )
         (WHILE(=(CDR(ASSOC 0 (SETQ ENT1 (ENTGET(ENTNEXT(CDR(ASSOC -1 ENT1))))))) "ATTRIB")
           (IF(=(CDR(ASSOC 70 ENT1)) 0)
             (PROGN(SETQ ENT1 (SUBST '(70 . 5)(ASSOC 70 ENT1) ENT1))
               (ENTMOD ENT1)(ENTMOD ENT)
             )
          )
        )
      )
    )
)
(PRINC)
)

;49--- 打开属性显示 ---
(DEFUN C:ONATT()
(IF(AND(PRINC "\\n选择带属性图块 :")
         (SETQ SS (SSGET '((0 . "INSERT")(66 . 1))))
     )
     (PROGN
       (SETQ I -1)
       (REPEAT(SSLENGTH SS)
         (SETQ ENT (ENTGET(SSNAME SS (SETQ I (1+ I))))
               ENT1 ENT
         )
         (WHILE(=(CDR (ASSOC 0 (SETQ ENT1 (ENTGET(ENTNEXT(CDR(ASSOC -1 ENT1))))))) "ATTRIB")
           (IF(=(CDR(ASSOC 70 ENT1)) 5)
             (PROGN(SETQ ENT1 (SUBST '(70 . 0)(ASSOC 70 ENT1) ENT1))
               (ENTMOD ENT1)(ENTMOD ENT)
             )
           )
         )
      )
    )
)
(PRINC)
)

;50--- 属性显示转换 ---
(DEFUN C:ONFATT()
(IF(AND(PRINC "\\n选择带属性图块 :")
         (SETQ SS (SSGET '((0 . "INSERT")(66 . 1))))
     )
     (PROGN
       (SETQ I -1)
       (REPEAT(SSLENGTH SS)
         (SETQ ENT (ENTGET(SSNAME SS (SETQ I (1+ I))))
               ENT1 ENT
         )
         (WHILE(=(CDR (ASSOC 0 (SETQ ENT1 (ENTGET(ENTNEXT(CDR(ASSOC -1 ENT1))))))) "ATTRIB")
           (IF(=(CDR(ASSOC 70 ENT1)) 5)
             (PROGN(SETQ ENT1 (SUBST '(70 . 0)(ASSOC 70 ENT1) ENT1))
               (ENTMOD ENT1)(ENTMOD ENT)
             )
             (PROGN(SETQ ENT1 (SUBST '(70 . 5)(ASSOC 70 ENT1) ENT1))
               (ENTMOD ENT1)(ENTMOD ENT)
             )
           )
         )
      )
    )
)
(PRINC)
)

qing6688 · 发表于 2008-1-30 11:52:00

还用那么麻烦，用文字替代的方法，用"find"标准命令，用"A"代替"B". "B"也可以为空。

bluewall · 发表于 2008-1-31 16:33:00

zheng209 · 发表于 2008-2-13 02:53:00

如何用lisp程序提取块的属性值

hhhccc666 · 发表于 2008-2-17 18:34:00

呵呵学习学习偷窥一下下

pcdcglwb · 发表于 2008-2-27 23:09:00

nbvnbvnvbnbvnbvnvb

brainstorm · 发表于 2008-2-28 11:58:00

(defun c:test (/ ss en)
    (Defun put-visible (bn visible / bl) ;
(If (Assoc 66 (EntGet bn))
     (Progn (SetQ bn (EntNext bn)
    bl (EntGet bn)
     )
     (While (= "ATTRIB" (Cdr (Assoc 0 bl)))
         (setq bl (subst (cons 70
          (if visible
       0
       1
          )
           )
           (assoc 70 bl)
           bl
    )
         )
         (entmod bl)
         (entupd bn)
         (SetQ bl (EntGet (SetQ bn (EntNext bn))))
     )
     )
)
    )

    (setq ss (ssget '((66 . 1))))
    (setq n 0)
    (repeat (sslength ss)
(setq en (ssname ss n))
(put-visible en t);可见
;(put-visible en nil)不可见
(setq n (1+ n))
    )
)

账号		自动登录	找回密码
密码			注册

修改块中文字属性值的程序

bucuo