修改块中文字属性值的程序 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第3页

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

bucuo

hao

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))     ) )

页: 1 2 [3] 4 5 6 7 8 9 10 11 12

明经CAD社区's Archiver

bucuo