[LISP程序]：[原创]对块追加属性

eachy · 发表于 2003-5-19 10:07:57

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

2003.05.20 修改

;|
功能：对块追加属性;
说明： e 块引用实体;
pt 属性插入点;
high 属性字高;
tag 属性标签;
pro 提示;
val 默认值;
mode 属性模式;
1 不可见，系统变量 attdisp 将覆盖不可见属性;
2 预置属性;
3 校验;
4 默认;
|;
(defun block-addattribute (e pt high tag pro
val mode / obj insertpt
blkdef attdef blkref attref tf
blk_attref !last xscale yscale
zscale rotation pinblk
)
(defun !last (lst)
(reverse (cdr (reverse lst)))
)
(setq obj (vlax-ename->vla-object e)
insertpt (vlax-safearray->list
(vlax-variant-value (vla-get-insertionpoint obj));插入点
)
xscale (vla-get-xscalefactor obj);x比例
yscale (vla-get-yscalefactor obj);y比例
zscale (vla-get-zscalefactor obj);z比例
rotation (vla-get-rotation obj);旋转角
)
;;处理有旋转的块
(if (/= rotation 0.0)
(setq pinblk (polar '(0. 0. 0.)
(- (angle insertpt pt)
rotation
)
(distance insertpt pt)
)
)
(setq pinblk (mapcar '- pt insertpt))
)
(setq blkdef (vla-item
(vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
(vla-get-name obj)
)
)
(setq blk_attref (vla-get-hasattributes obj))
(cond
((= blk_attref :vlax-false) (setq tf t)) ;不含属性
;;含属性但没有与追加属性相同的
(T
(if (not (setq tf
(not
(member t
(mapcar
'(lambda (x)
(= (vla-get-tagstring x) tag)
)
(vlax-safearray->list
(vlax-variant-value (vla-getattributes obj))
)
)
)
)
)
)
(setq tf nil) ;有与追加属性相同的
)
)
)
(if tf
(progn
(setq attdef (vla-addattribute
blkdef
high
(cond
((= mode 1) acAttributeModeInvisible)
((= mode 2) acAttributeModeConstant)
((= mode 3) acAttributeModeVerify)
(t acAttributeModePreset)
)
tag
(vlax-3d-point pinblk)
pro
val
)
)
(setq blkref (vla-insertblock
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
(vlax-3d-point insertpt)
(vla-get-name BLKDEF)
xscale
yscale
zscale
rotation
)
)
(setq attref (vlax-safearray->list
(vlax-variant-value (vla-getattributes blkref))
)
)
(if (> (length attref) 1)
(mapcar
'(lambda (x)
(vla-put-tagstring x (vla-get-tagstring x))
(vla-put-textstring x (vla-get-textstring x))
(vla-put-insertionpoint x (vla-get-insertionpoint x))
)
(!last attref)
)
)
(vla-put-tagstring (last attref) tag)
(vla-put-textstring (last attref) pro)
(vla-put-insertionpoint (last attref) (vlax-3d-point pt))
(vla-delete obj)
)
;;tf 为空时修改块内属性;
(princ "\n块内含有相同标签的属性!")
)
(princ)
)

;| 
功能：对块追加属性; 
说明： e      块引用实体; 
       pt     属性插入点; 
       high   属性字高; 
       tag    属性标签; 
       pro    提示; 
       val    默认值; 
       mode   属性模式; 
              1   不可见，系统变量 attdisp 将覆盖不可见属性; 
              2   预置属性; 
              3   校验; 
              4   默认; 
|; 
(defun block-addattribute (e            pt             high     tag      pro 
                           val            mode     /              obj      insertpt 
                           blkdef   attdef   blkref   attref   tf 
                           blk_attref             !last    xscale   yscale 
                           zscale   rotation pinblk 
                          ) 
  (defun !last (lst) 
    (reverse (cdr (reverse lst))) 
  ) 
  (setq        obj         (vlax-ename->vla-object e) 
        insertpt (vlax-safearray->list 
                   (vlax-variant-value (vla-get-insertionpoint obj));插入点 
                 ) 
        xscale         (vla-get-xscalefactor obj);x比例 
        yscale         (vla-get-yscalefactor obj);y比例 
        zscale         (vla-get-zscalefactor obj);z比例 
        rotation (vla-get-rotation obj);旋转角 
  ) 
  ;;处理有旋转的块 
  (if (/= rotation 0.0) 
    (setq pinblk (polar        '(0. 0. 0.) 
                        (- (angle insertpt pt) 
                           rotation 
                        ) 
                        (distance insertpt pt) 
                 ) 
    ) 
    (setq pinblk (mapcar '- pt insertpt)) 
  ) 
  (setq        blkdef (vla-item 
                 (vla-get-blocks 
                   (vla-get-activedocument (vlax-get-acad-object)) 
                 ) 
                 (vla-get-name obj) 
               ) 
  ) 
  (setq blk_attref (vla-get-hasattributes obj)) 
  (cond 
    ((= blk_attref :vlax-false) (setq tf t)) ;不含属性 
    ;;含属性但没有与追加属性相同的 
    (T 
     (if (not (setq tf 
                     (not 
                       (member t 
                               (mapcar 
                                 '(lambda (x) 
                                    (= (vla-get-tagstring x) tag) 
                                  ) 
                                 (vlax-safearray->list 
                                   (vlax-variant-value (vla-getattributes obj)) 
                                 ) 
                               ) 
                       ) 
                     ) 
              ) 
         ) 
       (setq tf nil)                        ;有与追加属性相同的 
     ) 
    ) 
  ) 
  (if tf 
    (progn 
      (setq attdef (vla-addattribute 
                     blkdef 
                     high 
                     (cond 
                       ((= mode 1) acAttributeModeInvisible) 
                       ((= mode 2) acAttributeModeConstant) 
                       ((= mode 3) acAttributeModeVerify) 
                       (t acAttributeModePreset) 
                     ) 
                     tag 
                     (vlax-3d-point pinblk) 
                     pro 
                     val 
                   ) 
      ) 
      (setq blkref (vla-insertblock 
                     (vla-get-modelspace 
                       (vla-get-activedocument (vlax-get-acad-object)) 
                     ) 
                     (vlax-3d-point insertpt) 
                     (vla-get-name BLKDEF) 
                     xscale 
                     yscale 
                     zscale 
                     rotation 
                   ) 
      ) 
      (setq attref (vlax-safearray->list 
                     (vlax-variant-value (vla-getattributes blkref)) 
                   ) 
      ) 
      (if (> (length attref) 1) 
        (mapcar 
          '(lambda (x) 
             (vla-put-tagstring x (vla-get-tagstring x)) 
             (vla-put-textstring x (vla-get-textstring x)) 
             (vla-put-insertionpoint x (vla-get-insertionpoint x)) 
           ) 
          (!last attref) 
        ) 
      ) 
      (vla-put-tagstring (last attref) tag) 
      (vla-put-textstring (last attref) pro) 
      (vla-put-insertionpoint (last attref) (vlax-3d-point pt)) 
      (vla-delete obj) 
    ) 
    ;;tf 为空时修改块内属性; 
    (princ "\n块内含有相同标签的属性!") 
  )   
  (princ) 
)

LUCAS · 发表于 2003-5-19 12:20:09

;;USAGE:(BLOCK-ADDATTRIBUTE (CAR(ENTSEL "\n选追加属性图块: ")) (GETPOINT "\n属性插入点: ") 5 "12" "45" "bbb" 2)

用_ddatte编辑看看,会发现追加的属性没有出现在_ddatte对话框中

eachy · 发表于 2003-5-19 13:22:35

最初由 LUCAS 发布
[B];;USAGE:(BLOCK-ADDATTRIBUTE (CAR(ENTSEL "\n选追加属性图块: ")) (GETPOINT "\n属性插入点: ") 5 "12" "45" "bbb" 2)

用_ddatte编辑看看,会发现追加的属性没有出现在_ddatte对话框中 [/B]

后面的 vla-for 不对，已修改。另外请教个问题，用getattributes得到的用哪个函数处理。

这个程序是写绿化标注时才学的，应该在 BLKDEF 后加个遍历块内实体检查是否有属性，没有追加；有，是否与追加的Tag一样，一样，不追加仅在后面改，不一样的追加，后面引用时要加条件。

LUCAS · 发表于 2003-5-20 07:51:43

;|
功能：对块追加属性;
说明： e 块引用实体;
pt 属性插入点;
high 属性字高;
tag 属性卷标;
pro 提示;
val 默认值;
mode 属性模式;
1 不可见，系统变量 attdisp 将覆盖不可见属性;
2 预置属性
3 校验;
4 默认;
|;
;; (BLOCK-ADDATTRIBUTE (CAR(ENTSEL "\n选追加属性图块: ")) (GETPOINT "\n属性插入点: ") 5 "12" "45" "bbb" 3)
;;Sorry!我错了!Mode 2 是固定属性
;;对旋转后的图块增加属性,位置非预期
(defun BLOCK-ADDATTRIBUTE (E PT HIGH TAG PRO VAL
MODE / OBJ INSERTPT BLKDEF
ATTDEF
)
(setq OBJ (vlax-ename->vla-object E)
INSERTPT (vlax-safearray->list
(vlax-variant-value (vla-get-insertionpoint OBJ))
)
)
(setq BLKDEF (vla-item
(vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
(vla-get-name OBJ)
)
)
(setq ATTDEF (vla-addattribute
BLKDEF
HIGH
(cond
((= MODE 1) acattributemodeinvisible)
((= MODE 2) acattributemodeconstant)
((= MODE 3) acattributemodeverify)
(t acattributemodepreset)
)
TAG
(vlax-3d-point (mapcar '- PT INSERTPT))
PRO
VAL
)
)
(command "_.attsync" "n" (vla-get-name OBJ))
(princ)
)

;| 
功能：对块追加属性; 
说明： e      块引用实体; 
       pt     属性插入点; 
       high   属性字高; 
       tag    属性卷标; 
       pro    提示; 
       val    默认值; 
       mode   属性模式; 
              1   不可见，系统变量 attdisp 将覆盖不可见属性; 
              2   预置属性 
              3   校验; 
              4   默认; 
|; 
;; (BLOCK-ADDATTRIBUTE (CAR(ENTSEL "\n选追加属性图块: ")) (GETPOINT "\n属性插入点: ") 5 "12" "45" "bbb" 3) 
;;Sorry!我错了!Mode 2 是固定属性 
;;对旋转后的图块增加属性,位置非预期 
 
(defun BLOCK-ADDATTRIBUTE (E          PT         HIGH        TAG    PRO    VAL 
                           MODE          /         OBJ        INSERTPT      BLKDEF 
                           ATTDEF 
                          ) 
  (setq        OBJ         (vlax-ename->vla-object E) 
        INSERTPT (vlax-safearray->list 
                   (vlax-variant-value (vla-get-insertionpoint OBJ)) 
                 ) 
  ) 
  (setq        BLKDEF (vla-item 
                 (vla-get-blocks 
                   (vla-get-activedocument (vlax-get-acad-object)) 
                 ) 
                 (vla-get-name OBJ) 
               ) 
  ) 
  (setq        ATTDEF (vla-addattribute 
                 BLKDEF 
                 HIGH 
                 (cond 
                   ((= MODE 1) acattributemodeinvisible) 
                   ((= MODE 2) acattributemodeconstant) 
                   ((= MODE 3) acattributemodeverify) 
                   (t acattributemodepreset) 
                 ) 
                 TAG 
                 (vlax-3d-point (mapcar '- PT INSERTPT)) 
                 PRO 
                 VAL 
               ) 
  ) 
  (command "_.attsync" "n" (vla-get-name OBJ)) 
  (princ) 
)

你那問題要想想!!

lijiao · 发表于 2003-5-20 08:20:35

最初由 eachy 发布
[B][QUOTE]最初由 LUCAS 发布
[B];;USAGE:(BLOCK-ADDATTRIBUTE (CAR(ENTSEL "\n选追加属性图块: ")) (GETPOINT "\n属性插入点: ") 5 "12" "45" "bbb" 2)

用_ddatte编辑看看,会发现追加的属性没有出现在_ddat... [/B]

getattributes得到的是variant
可以用vlax-variant-value 转变为数组，再用vlax-safearray->list转变为LIST
..............................................................................................................
如果不知道一个函数的返回值，可以用TYPE测试。

lsjjm · 发表于 2003-5-20 09:21:30

eachy, 修改后的贴出来了吗? 未见呀!

eachy · 发表于 2003-5-20 10:01:35

最初由 LUCAS 发布
[B][code]
;|
功能：对块追加属性;
说明： e    块引用实体;
   pt    属性插入点;
   high 属性字高;
   tag 属性卷标;
   pro 提示;
   val 默认值;
   mode 属性?.. [/B]

旋转后的块应该要用矩阵转换吧。

mmmm · 发表于 2003-6-12 13:52:04

能否扩充到直接将点取得属性或文本直接追加到点取的图块中？这样会比较方便。

aeo · 发表于 2003-6-20 23:55:41

上面两位把属性模式给定义死了,属性模式是可以相加的.

0 无属性模式选定
1 不可见
2 常数
4 验证
8 预置

Mode AcAttributeMode enum; input-only
[color=red]
(any combination of constants can be used by adding them together):
[/color]
acAttributeModeInvisible
acAttributeModeConstant
acAttributeModeVerify
acAttributeModePreset

复制代码

应该改一下吧.

jx2008 · 发表于 2007-3-2 17:46:05

这里有两个定义好的属性文本做成的一个块，下面的代码怎么到第二个的时候不能正常修改了阿？

(Foreach ;此循环有点问题
   I
   (Vlax-Safearray->List
      (Vlax-Variant-Value
         (Vla-Getattributes Att_Zbbz)
      ) ;_ End Vlax-Variant-Value
   ) ;_ End Vlax-Safearray->List
   (Vla-Put-Textstring I Att_StrX) ;更改属性值
   (Vla-Put-Textstring I Att_StrY) ;更改属性值  ；此句有点问题

头像显示不出来？

wyzcm · 发表于 2007-3-27 12:28:09

为什么这个在发贴时总是无法控制好版面,尤其是LISP源程序,有啥高招吗?

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

[LISP程序]：[原创]对块追加属性

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子