关于对象反应器，如何写才好？

aeo · 发表于 2013-12-24 10:29:06

这样不行吧
属性的好处就是图形不变，里面的文字不停变化
你为了其中的一个属性，把图块改了，那还做什么属性块？

我讲个方法：
反正是块，计算文字大小，自动改那个插入的X比例，
做块的时候那个框的x画成1,这样很好算

反应器只要判断是不是那个块定义就行了，拷贝粘贴也没关系.

st788796 · 发表于 2013-12-24 10:30:42

我写的话就用scaleentity

newer · 发表于 2013-12-24 10:33:38

aeo 发表于 2013-12-24 10:29
这样不行吧
属性的好处就是图形不变，里面的文字不停变化
你为了其中的一个属性，把图块改了，那还做什么 ...

用图块的好处是当做容器了，可以把实体组织起来做个“对象”，类似自定义对象，但是可以通用。

ll_j · 发表于 2013-12-24 11:20:31

其实属性和图块是可以相对独立的，图块可以做成无属性的动态块，然后将属性附着在这个块上，再根据属性的长度来变化动态块的相关长度。
或者也可以使用无名块，根据属性的长度来构建无名块，不过这样用多了，图中的无名块和反应器也会很多，势必影响速度。
本人不懂反应器，属于光说不练的假把式，对不对也就不知道了。

st788796 · 发表于 2013-12-24 11:58:10

高版本的约束更简单

aeo · 发表于 2013-12-24 12:13:53

本帖最后由 aeo 于 2013-12-24 12:20 编辑

(defun c:addvlr (/ E OBJ TEXTSTRING)
(if (and(setq e (car(nentsel "\n选择块属性:")))
(= "ATTRIB" (cdr (assoc 0 (entget e)))) )
(progn (setq obj (vlax-ename->vla-object e))
(vlr-pers (VLR-Object-Reactor (list obj)nil '((:vlr-modified . att-Change))))
(princ "\n反应器已注入!") )
)
(princ)
)
(defun att-Change (OBJ VLROBJ PARAMETERS / blkref box dis doc en ename sca textstring)
(setq textstring (vla-get-textstring obj))
(setq blkref (vla-ObjectIDToObject
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-get-ownerid obj)
)
ename (vlax-vla-object->ename blkref)
)
(setq sca (abs(vla-get-YScaleFactor blkref))
box (textbox (entget (vlax-vla-object->ename obj)))
dis (+ (- (caadr box)(caar box))(* sca 0.1) )
en(entget ename)
)
(entmod(subst(cons 41 dis)(assoc 41 en)en))
)

(defun c:addvlr (/ E OBJ TEXTSTRING)   
         (if (and(setq e (car(nentsel "\n选择块属性:")))         
                 (= "ATTRIB" (cdr (assoc 0 (entget e))))        )    
          (progn      (setq obj (vlax-ename->vla-object e))             
                 (vlr-pers (VLR-Object-Reactor (list obj)nil '((:vlr-modified . att-Change))))       
                 (princ "\n反应器已注入!")      )    
         )    
      (princ) 
 ) 
 
 (defun att-Change (OBJ VLROBJ PARAMETERS / blkref box dis doc en ename sca textstring) 
  (setq textstring (vla-get-textstring obj)) 
  (setq blkref (vla-ObjectIDToObject 
                      (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) 
                      (vla-get-ownerid obj) 
                ) 
       ename (vlax-vla-object->ename blkref) 
  ) 
  (setq  sca (abs(vla-get-YScaleFactor blkref)) 
         box (textbox (entget (vlax-vla-object->ename obj))) 
         dis (+ (- (caadr box)(caar box))(* sca 0.1) ) 
         en(entget ename) 
   ) 
   (entmod(subst(cons 41 dis)(assoc 41 en)en)) 
)

下面是实验dwg

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:Drawing1.rar
下载次数:3 文件大小:17.76 KB
下载权限: 不限以上 [免费赚D豆]

aeo · 发表于 2013-12-24 12:14:53

copy 还是不行，要重新加反应器

牢固 · 发表于 2013-12-24 12:35:49

本帖最后由牢固于 2013-12-24 12:47 编辑

newer 发表于 2013-12-24 10:27
G 版，能不鞥用点监视器，做个动态的演示啊。

用点监视器实现了，复制后的对象也可以关联！但是经常API出现异常的Bug，没找到问题出在何处！

;;添加监视
(defun c:tt()
(if (and
(setq e (car(entsel "\n选择属性块:")))
(= "AcDbBlockReference" (xdrx_getpropertyvalue e "IsA"))
(setq atts (xdrx_getpropertyvalue e "AttributeEntities"))
)
(progn
(xdrx_xdata_set e "属性监视" (xdrx_getpropertyvalue (car atts)"TextString"))
(princ "\n监视已注入")
)
)
(princ)
)
;;启动监视
(defun c:tt1 (/ ret)
(VL-ACAD-DEFUN 'CallBak)
(if *CallBakStart*
(progn
(xdrx_PointMonitor)
(princ "\n监视关闭！")
(setq *CallBakStart* nil)
)
(progn
(princ "\n监视打开！")
(setq *CallBakStart* t)
(xdrx_PointMonitor "CallBack")
)
)
(princ)
)
;;回调函数
(defun CallBack (PT / ENT ATTS VAL TXT NAME BLKDEF CP ANG BOX P1 P3 P2
P4 W H MAT PL)
(if (and
(setq ent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
(car ent)
)
)
(if (= "AcDbAttribute" (xdrx_getpropertyvalue ent "IsA"))
(setq atts (list ent)
ent (xdrx_getpropertyvalue ent "Owner")
)
(And
(= "AcDbBlockReference" (xdrx_getpropertyvalue ent "IsA"))
(setq atts (xdrx_getpropertyvalue ent "AttributeEntities"))
)
)
(setq val (xdrx_xdata_get ent "属性监视"))
(setq txt (xdrx_getpropertyvalue (car atts) "TextString"))
(/= val txt)
)
(progn
(xdrx_xdata_set ent "属性监视" txt)
(setq mat (xdrx_matrix_inverse
(xdrx_getpropertyvalue ent "BlockTransform")
)
)
(setq atts (xdrx_getpropertyvalue ent "AttributeEntities"))
(setq name (xdrx_getpropertyvalue ent "BlockTableRecord")
blkdef (cadr name)
name (car name)
)
(mapcar 'set '(p1 p2 p3 p4) (xdrx_entity_box (car atts)))
(setq cp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p3)))
(setq ang (xdrx_getpropertyvalue (car atts) "Rotation"))
(foreach e (xdrx_getpropertyvalue blkdef "Entities")
(if (/= "AcDbAttributeDefinition"
(xdrx_getpropertyvalue e "isa")
)
(xdrx_object_delete e)
)
)
(setq box (textbox (entget (car atts)))
p1 (car box)
p3 (cadr box)
p2 (list (car p1) (cadr p3) (caddr p1))
p4 (list (car p3) (cadr p1) (caddr p3))
w (* 0.5 (- (car p4) (car p1)))
h (* 0.5 (- (cadr p2) (cadr p1)))
p1 (polar (polar cp ang (- w)) (- ang (* pi 0.5)) h)
p2 (polar (polar cp ang (- w)) (+ ang (* pi 0.5)) h)
p3 (polar (polar cp ang w) (+ ang (* pi 0.5)) h)
p4 (polar (polar cp ang w) (- ang (* pi 0.5)) h)
)
(Setq p1 (xdrx_point_transform p1 mat)
p2 (xdrx_point_transform p2 mat)
p3 (xdrx_point_transform p3 mat)
p4 (xdrx_point_transform p4 mat)
)
(setq pl (vla-AddPolyline
(vlax-ename->vla-object blkdef)
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 11))
(append p1 p2 p3 p4)
)
)
)
(vla-put-Closed pl :vlax-true)
(entupd ent)
)
)
)

;;添加监视 
(defun c:tt() 
  (if (and 
  (setq e (car(entsel "\n选择属性块:"))) 
  (= "AcDbBlockReference" (xdrx_getpropertyvalue e "IsA")) 
  (setq atts (xdrx_getpropertyvalue e "AttributeEntities")) 
  ) 
    (progn 
      (xdrx_xdata_set e "属性监视" (xdrx_getpropertyvalue (car atts)"TextString")) 
      (princ "\n监视已注入") 
      ) 
    ) 
  (princ) 
  ) 
;;启动监视 
(defun c:tt1  (/ ret) 
  (VL-ACAD-DEFUN 'CallBak) 
  (if *CallBakStart* 
  (progn 
    (xdrx_PointMonitor) 
    (princ "\n监视关闭！") 
    (setq *CallBakStart* nil) 
    ) 
  (progn 
    (princ "\n监视打开！") 
    (setq *CallBakStart* t) 
    (xdrx_PointMonitor "CallBack") 
    ) 
  ) 
  (princ) 
  ) 
;;回调函数 
(defun CallBack        (PT / ENT ATTS VAL TXT NAME BLKDEF CP ANG BOX P1 P3 P2 
                 P4 W H        MAT PL) 
  (if (and 
        (setq ent (nentselp pt) 
              ent (if (and ent (= (type (last (last ent))) 'ename)) 
                    (last (last ent)) 
                    (car ent) 
                  ) 
        ) 
        (if (= "AcDbAttribute" (xdrx_getpropertyvalue ent "IsA")) 
          (setq        atts (list ent) 
                ent  (xdrx_getpropertyvalue ent "Owner") 
          ) 
          (And 
            (= "AcDbBlockReference" (xdrx_getpropertyvalue ent "IsA")) 
            (setq atts (xdrx_getpropertyvalue ent "AttributeEntities")) 
          ) 
        ) 
        (setq val (xdrx_xdata_get ent "属性监视")) 
        (setq txt (xdrx_getpropertyvalue (car atts) "TextString")) 
        (/= val txt) 
      ) 
    (progn 
      (xdrx_xdata_set ent "属性监视" txt) 
      (setq mat        (xdrx_matrix_inverse 
                  (xdrx_getpropertyvalue ent "BlockTransform") 
                ) 
      ) 
      (setq atts (xdrx_getpropertyvalue ent "AttributeEntities")) 
      (setq name   (xdrx_getpropertyvalue ent "BlockTableRecord") 
            blkdef (cadr name) 
            name   (car name) 
      ) 
      (mapcar 'set '(p1 p2 p3 p4) (xdrx_entity_box (car atts))) 
      (setq cp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p3))) 
      (setq ang (xdrx_getpropertyvalue (car atts) "Rotation")) 
 
      (foreach e (xdrx_getpropertyvalue blkdef "Entities") 
        (if (/=        "AcDbAttributeDefinition" 
                (xdrx_getpropertyvalue e "isa") 
            ) 
          (xdrx_object_delete e) 
        ) 
      ) 
      (setq box        (textbox (entget (car atts))) 
            p1        (car box) 
            p3        (cadr box) 
            p2        (list (car p1) (cadr p3) (caddr p1)) 
            p4        (list (car p3) (cadr p1) (caddr p3)) 
            w        (* 0.5 (- (car p4) (car p1))) 
            h        (* 0.5 (- (cadr p2) (cadr p1))) 
            p1        (polar (polar cp ang (- w)) (- ang (* pi 0.5)) h) 
            p2        (polar (polar cp ang (- w)) (+ ang (* pi 0.5)) h) 
            p3        (polar (polar cp ang w) (+ ang (* pi 0.5)) h) 
            p4        (polar (polar cp ang w) (- ang (* pi 0.5)) h) 
      ) 
 
      (Setq p1 (xdrx_point_transform p1 mat) 
            p2 (xdrx_point_transform p2 mat) 
            p3 (xdrx_point_transform p3 mat) 
            p4 (xdrx_point_transform p4 mat) 
      ) 
      (setq pl (vla-AddPolyline 
                 (vlax-ename->vla-object blkdef) 
                 (vlax-safearray-fill 
                   (vlax-make-safearray vlax-vbdouble (cons 0 11)) 
                   (append p1 p2 p3 p4) 
                 ) 
               ) 
      ) 
      (vla-put-Closed pl :vlax-true) 
      (entupd ent) 
    ) 
  ) 
)

st788796 · 发表于 2013-12-24 12:40:06

牢固发表于 2013-12-24 12:35
用点监视器实现了，复制后的对象也可以关联！但是经常API出现异常的Bug，没找到问题出在何处！

为什么删掉再添加?直接对原来的 Pline Transform 不可以?

牢固 · 发表于 2013-12-24 13:04:33

st788796 发表于 2013-12-24 12:40
为什么删掉再添加?直接对原来的 Pline Transform 不可以?

修改原来的多段线顶点当然可以！我只是为了图省事！

牢固 · 发表于 2013-12-24 13:23:39

本帖最后由牢固于 2013-12-24 20:42 编辑

牢固发表于 2013-12-24 12:35
用点监视器实现了，复制后的对象也可以关联！但是经常API出现异常的Bug，没找到问题出在何处！

出现异常的是xdrx_xdata_set函数！修改和查询扩展数的函数换成自己定义的就完全没问题了！

(defun c:tt() (if (and
(setq e (car(entsel "\n选择属性块:")))
(= "AcDbBlockReference" (xdrx_getpropertyvalue e "IsA"))
(setq atts (xdrx_getpropertyvalue e "AttributeEntities"))
)
(progn
;(xdrx_xdata_set e "属性监视" (xdrx_getpropertyvalue (car atts)"TextString"))
(xxl-Data-ax:PutXData e (list '(1001 . "属性监视") (cons 1000 (xdrx_getpropertyvalue (car atts)"TextString"))))
(princ "\n监视已注入")
)
)
(princ)
)
;;启动监视
(defun c:tt1 (/ ret)
(VL-ACAD-DEFUN 'CallBak)
(if *CallBakStart*
(progn
(xdrx_PointMonitor)
(princ "\n监视关闭！")
(setq *CallBakStart* nil)
)
(progn
(princ "\n监视打开！")
(setq *CallBakStart* t)
(xdrx_PointMonitor "CallBack")
)
)
(princ)
)
;;回调函数
(defun CallBack (PT / ENT ATTS VAL TXT NAME BLKDEF CP ANG BOX P1 P3 P2
P4 W H MAT PL)
(if (and
(setq ent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
(car ent)
)
)
(if (= "AcDbAttribute" (xdrx_getpropertyvalue ent "IsA"))
(setq atts (list ent)
ent (xdrx_getpropertyvalue ent "Owner")
)
(And
(= "AcDbBlockReference" (xdrx_getpropertyvalue ent "IsA"))
(setq atts (xdrx_getpropertyvalue ent "AttributeEntities"))
)
)
;(setq val (xdrx_xdata_get ent "属性监视"))
(setq val (cdr (assoc 1000 (xxl-DATA-AX:GETXDATA ent "属性监视"))))
(setq txt (xdrx_getpropertyvalue (car atts) "TextString"))
(/= val txt)
)
(progn
(setq mat (xdrx_matrix_inverse
(xdrx_getpropertyvalue ent "BlockTransform")
)
)
;(xdrx_xdata_set ent "属性监视" txt)
(xxl-Data-ax:PutXData ent (list '(1001 . "属性监视") (cons 1000 txt)))
(setq name (xdrx_getpropertyvalue ent "BlockTableRecord")
blkdef (cadr name)
name (car name)
)
(mapcar 'set '(p1 p2 p3 p4) (xdrx_entity_box (car atts)))
(setq cp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p3)))
(setq ang (xdrx_getpropertyvalue (car atts) "Rotation"))
(setq box (textbox (entget (car atts)))
p1 (car box)
p3 (cadr box)
p2 (list (car p1) (cadr p3) (caddr p1))
p4 (list (car p3) (cadr p1) (caddr p3))
w (* 0.5 (- (car p4) (car p1)))
h (* 0.5 (- (cadr p2) (cadr p1)))
p1 (polar (polar cp ang (- w)) (- ang (* pi 0.5)) h)
p2 (polar (polar cp ang (- w)) (+ ang (* pi 0.5)) h)
p3 (polar (polar cp ang w) (+ ang (* pi 0.5)) h)
p4 (polar (polar cp ang w) (- ang (* pi 0.5)) h)
)
(Setq p1 (xdrx_point_transform p1 mat)
p2 (xdrx_point_transform p2 mat)
p3 (xdrx_point_transform p3 mat)
p4 (xdrx_point_transform p4 mat)
)
(foreach e (xdrx_getpropertyvalue blkdef "Entities")
(if (/= "AcDbAttributeDefinition"
(xdrx_getpropertyvalue e "isa")
)
(progn
;;修改边界
(xdrx_polyline_SetPointAt e 0 p1)
(xdrx_polyline_SetPointAt e 1 p2)
(xdrx_polyline_SetPointAt e 2 p3)
(xdrx_polyline_SetPointAt e 3 p4)
)
)
)
(entupd ent)
)
)
)
;;;xxl-Data-ax:PutXData 附着扩展图元数据到AutoCAD对象上。
;|
功能
附着扩展图元数据到AutoCAD对象上。
参数
一个ActiveX对象和一个与GetXData返回的格式相同的扩展图元数据列表。
返回值
无
示例
(xxl-Data-ax:PutXData myVlaObj '((1001 . "ACADX") (1000 . "myStringData")))
(xxl-Data-ax:PutXData (setq e (car(entsel)))(append '((1001 . "ACADX")) (mapcar '(lambda (x) (cons 1010 x)) (xxl-GET_POLY_PTLIST e))))
注意
在1001组码中标明的扩展图元数据应用名必须先使用AutoLISP函数REGAPP进行注册以便附着数据到该对象上。
可查看AutoCAD帮助文件以熟悉有关扩展图元数据代码及值。
1000 ASCII 码字串
1001 应用登记名
1007 控制字，{ 或｝
1003 层名
1004 长字节
1005 对象索引名
1010 点位
1040 浮点数
1041 距离值
1042 比例系数
1070 16位整数
1071 32位整数
|;
(defun xxl-Data-ax:PutXData (vlaObj XData)
(regapp (cdr (assoc 1001 xdata)))
(setq XData
(xxl-AX:BuildFilter
(mapcar
'(lambda (item / key)
(setq key (car item))
(if (<= 1010 key 1033)
(cons key
(vlax-variant-value (vlax-3d-point (cdr item)))
)
item
)
)
XData
)
)
)
(IF (= 'ENAME (TYPE VLAOBJ))
(vla-setXData
(vlax-ename->vla-object vlaObj)
(car XData)
(cadr XData)
)
(vla-setXData vlaObj (car XData) (cadr XData))
)
)
;;;==================================================================
;;;xxl-Data-ax:GetXData 获取附着在AutoCAD对象上的扩展图元数据。
;|
功能
获取附着在AutoCAD对象上的扩展图元数据。
参数
一个ActiveX对象和一个已经使用AutoLISP函数REGAPP注册的应用名。
返回值
返回附着到对象上的扩展图元数据列表
示例
(xxl-Data-ax:GetXData myVlaObj "ACAD")
|;
;;;==================================================================
(defun xxl-Data-ax:GetXData (vlaObj AppID / xType XData)
(IF (= 'ENAME (TYPE VLAOBJ))
(vla-getxdata
(vlax-ename->vla-object vlaObj)
AppID
'xType
'xData
)
(vla-getxdata vlaObj AppID 'xType 'xData)
)
(if (and xType xData)
(mapcar (function
(lambda (key val) (cons key (xxl-Num-AX->LispValue val)))
)
(vlax-safearray->list xType)
(vlax-safearray->list xData)
)
)
)
;;;xxl-AX:BuildFilter 返回包含用于ActiveX选择集过滤器的一对变体的列表
;|
语法:
(xxl-AX:BuildFilter filter)
说明:
返回包含用于ActiveX选择集过滤器的一对变体的列表
参数:
filter: 常规的选择集过滤器列表
返回值:
一对变体数组的列表
示例:
(xxl-AX:BuildFilter '((0 . "LWPOLYLINE")(8 . "WALLS")))
|;
;;;===================================================================
(defun xxl-AX:BuildFilter (Filter1)
(mapcar '(lambda (lst typ)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
typ
(cons 0
(1- (length lst))
)
)
lst
)
)
)
(list (mapcar 'car filter1) (mapcar 'cdr filter1))
(list vlax-vbInteger vlax-vbVariant)
)
)
;;;(xxl-Num-AX->LispValue 个ActiveX变体或安全数组)该函数将递归深入一个安全数组并转换所有的值，包括嵌套的安全数组，将其转换为LISP值。
(defun xxl-Num-AX->LispValue (v)
(cond ((= (type v) 'variant) (xxl-Num-AX->LispValue (vlax-variant-value v)))
((= (type v) 'safearray)
(mapcar 'xxl-Num-AX->LispValue (safearray-value v))
)
((= (type v) 'list)
(mapcar 'xxl-Num-AX->LispValue v)
)
(T v)
)
)

(defun c:tt()  (if (and 
  (setq e (car(entsel "\n选择属性块:"))) 
  (= "AcDbBlockReference" (xdrx_getpropertyvalue e "IsA")) 
  (setq atts (xdrx_getpropertyvalue e "AttributeEntities")) 
  ) 
    (progn 
      ;(xdrx_xdata_set e "属性监视" (xdrx_getpropertyvalue (car atts)"TextString")) 
      (xxl-Data-ax:PutXData e (list '(1001 . "属性监视") (cons 1000 (xdrx_getpropertyvalue (car atts)"TextString")))) 
      (princ "\n监视已注入") 
      ) 
    ) 
  (princ) 
  ) 
;;启动监视 
(defun c:tt1  (/ ret) 
  (VL-ACAD-DEFUN 'CallBak) 
  (if *CallBakStart* 
  (progn 
    (xdrx_PointMonitor) 
    (princ "\n监视关闭！") 
    (setq *CallBakStart* nil) 
    ) 
  (progn 
    (princ "\n监视打开！") 
    (setq *CallBakStart* t) 
    (xdrx_PointMonitor "CallBack") 
    ) 
  ) 
  (princ) 
  ) 
;;回调函数 
(defun CallBack  (PT / ENT ATTS VAL TXT NAME BLKDEF CP ANG BOX P1 P3 P2 
     P4 W H  MAT PL) 
  (if (and 
        (setq ent (nentselp pt) 
              ent (if (and ent (= (type (last (last ent))) 'ename)) 
                    (last (last ent)) 
                    (car ent) 
                  ) 
        ) 
        (if (= "AcDbAttribute" (xdrx_getpropertyvalue ent "IsA")) 
          (setq        atts (list ent) 
                ent  (xdrx_getpropertyvalue ent "Owner") 
          ) 
          (And 
            (= "AcDbBlockReference" (xdrx_getpropertyvalue ent "IsA")) 
            (setq atts (xdrx_getpropertyvalue ent "AttributeEntities")) 
          ) 
        ) 
        ;(setq val (xdrx_xdata_get ent "属性监视")) 
        (setq val (cdr (assoc 1000 (xxl-DATA-AX:GETXDATA ent "属性监视")))) 
               (setq txt (xdrx_getpropertyvalue (car atts) "TextString")) 
        (/= val txt) 
      ) 
    (progn 
 
      (setq mat        (xdrx_matrix_inverse 
                  (xdrx_getpropertyvalue ent "BlockTransform") 
                ) 
      ) 
      ;(xdrx_xdata_set ent "属性监视" txt) 
       (xxl-Data-ax:PutXData ent (list '(1001 . "属性监视") (cons 1000 txt))) 
      (setq name   (xdrx_getpropertyvalue ent "BlockTableRecord") 
            blkdef (cadr name) 
            name   (car name) 
      ) 
      (mapcar 'set '(p1 p2 p3 p4) (xdrx_entity_box (car atts))) 
      (setq cp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p3))) 
      (setq ang (xdrx_getpropertyvalue (car atts) "Rotation")) 
 
 
      (setq box        (textbox (entget (car atts))) 
            p1        (car box) 
            p3        (cadr box) 
            p2        (list (car p1) (cadr p3) (caddr p1)) 
            p4        (list (car p3) (cadr p1) (caddr p3)) 
            w        (* 0.5 (- (car p4) (car p1))) 
            h        (* 0.5 (- (cadr p2) (cadr p1))) 
            p1        (polar (polar cp ang (- w)) (- ang (* pi 0.5)) h) 
            p2        (polar (polar cp ang (- w)) (+ ang (* pi 0.5)) h) 
            p3        (polar (polar cp ang w) (+ ang (* pi 0.5)) h) 
            p4        (polar (polar cp ang w) (- ang (* pi 0.5)) h) 
      ) 
 
 
      (Setq p1 (xdrx_point_transform p1 mat) 
            p2 (xdrx_point_transform p2 mat) 
            p3 (xdrx_point_transform p3 mat) 
            p4 (xdrx_point_transform p4 mat) 
      ) 
      (foreach e (xdrx_getpropertyvalue blkdef "Entities") 
        (if (/=        "AcDbAttributeDefinition" 
                (xdrx_getpropertyvalue e "isa") 
            ) 
          (progn 
            ;;修改边界 
            (xdrx_polyline_SetPointAt e 0 p1) 
            (xdrx_polyline_SetPointAt e 1 p2) 
            (xdrx_polyline_SetPointAt e 2 p3) 
            (xdrx_polyline_SetPointAt e 3 p4) 
          ) 
        ) 
      ) 
 
 
 
 
      (entupd ent) 
 
    ) 
  ) 
) 
;;;xxl-Data-ax:PutXData 附着扩展图元数据到AutoCAD对象上。 
;| 
功能 
附着扩展图元数据到AutoCAD对象上。 
参数 
一个ActiveX对象和一个与GetXData返回的格式相同的扩展图元数据列表。 
返回值 
无 
示例 
(xxl-Data-ax:PutXData myVlaObj '((1001 . "ACADX") (1000 . "myStringData"))) 
(xxl-Data-ax:PutXData (setq e (car(entsel)))(append '((1001 . "ACADX")) (mapcar '(lambda (x) (cons 1010 x)) (xxl-GET_POLY_PTLIST e)))) 
注意 
在1001组码中标明的扩展图元数据应用名必须先使用AutoLISP函数REGAPP进行注册以便附着数据到该对象上。 
可查看AutoCAD帮助文件以熟悉有关扩展图元数据代码及值。 
1000 ASCII 码字串 
1001 应用登记名 
1007 控制字，{ 或 ｝ 
1003 层名 
1004 长字节 
1005 对象索引名 
1010 点位 
1040 浮点数 
1041 距离值 
1042 比例系数 
1070 16位整数 
1071 32位整数 
 |; 
(defun xxl-Data-ax:PutXData (vlaObj XData) 
  (regapp (cdr (assoc 1001 xdata))) 
  (setq        XData 
         (xxl-AX:BuildFilter 
           (mapcar 
             '(lambda (item / key) 
                (setq key (car item)) 
                (if (<= 1010 key 1033) 
                  (cons        key 
                        (vlax-variant-value (vlax-3d-point (cdr item))) 
                  ) 
                  item 
                ) 
              ) 
             XData 
           ) 
         ) 
  ) 
  (IF (= 'ENAME (TYPE VLAOBJ)) 
    (vla-setXData 
      (vlax-ename->vla-object vlaObj) 
      (car XData) 
      (cadr XData) 
    ) 
    (vla-setXData vlaObj (car XData) (cadr XData)) 
  ) 
) 
 
 
 
 
;;;================================================================== 
;;;xxl-Data-ax:GetXData 获取附着在AutoCAD对象上的扩展图元数据。 
;| 
功能 
获取附着在AutoCAD对象上的扩展图元数据。 
参数 
一个ActiveX对象和一个已经使用AutoLISP函数REGAPP注册的应用名。 
返回值 
返回附着到对象上的扩展图元数据列表 
示例 
(xxl-Data-ax:GetXData myVlaObj "ACAD") 
|; 
;;;================================================================== 
(defun xxl-Data-ax:GetXData (vlaObj AppID / xType XData) 
  (IF (= 'ENAME (TYPE VLAOBJ)) 
    (vla-getxdata 
      (vlax-ename->vla-object vlaObj) 
      AppID 
      'xType 
      'xData 
    ) 
    (vla-getxdata vlaObj AppID 'xType 'xData) 
  ) 
  (if (and xType xData) 
    (mapcar (function 
              (lambda (key val) (cons key (xxl-Num-AX->LispValue val))) 
            ) 
            (vlax-safearray->list xType) 
            (vlax-safearray->list xData) 
    ) 
  ) 
) 
 
;;;xxl-AX:BuildFilter  返回包含用于ActiveX选择集过滤器的一对变体的列表 
;| 
语法: 
(xxl-AX:BuildFilter filter) 
  说明: 
返回包含用于ActiveX选择集过滤器的一对变体的列表 
参数: 
filter: 常规的选择集过滤器列表 
  返回值: 
一对变体数组的列表 
  示例: 
(xxl-AX:BuildFilter '((0 . "LWPOLYLINE")(8 . "WALLS"))) 
|; 
;;;=================================================================== 
(defun xxl-AX:BuildFilter (Filter1) 
  (mapcar '(lambda (lst typ) 
      (vlax-make-variant 
        (vlax-safearray-fill 
   (vlax-make-safearray 
     typ 
     (cons 0 
    (1- (length lst)) 
     ) 
   ) 
   lst 
        ) 
      ) 
    ) 
   (list (mapcar 'car filter1) (mapcar 'cdr filter1)) 
   (list vlax-vbInteger vlax-vbVariant) 
  ) 
) 
;;;(xxl-Num-AX->LispValue 个ActiveX变体或安全数组)该函数将递归深入一个安全数组并转换所有的值，包括嵌套的安全数组，将其转换为LISP值。 
(defun xxl-Num-AX->LispValue (v) 
  (cond ((= (type v) 'variant) (xxl-Num-AX->LispValue (vlax-variant-value v))) 
        ((= (type v) 'safearray) 
         (mapcar 'xxl-Num-AX->LispValue (safearray-value  v)) 
        ) 
        ((= (type v) 'list) 
         (mapcar 'xxl-Num-AX->LispValue v) 
         ) 
        (T v) 
  ) 
  )

aeo · 发表于 2013-12-24 13:39:20

牢固发表于 2013-12-24 13:23
出现异常的是xdrx_xdata_set函数！修改和查询扩展数的函数换成自己定义的就完全没问题了！

实在没想明白，你把块定义改了，那图里面的其他地方的插入不是也改了?

难道只插入一个?那还做块干什么

st788796 · 发表于 2013-12-24 13:41:12

aeo 发表于 2013-12-24 13:39
实在没想明白，你把块定义改了，那图里面的其他地方的插入不是也改了?

难道只插入一个?那还做块干什么 ...

按比例修改

牢固 · 发表于 2013-12-24 13:46:36

本帖最后由牢固于 2013-12-24 13:49 编辑

aeo 发表于 2013-12-24 13:39
实在没想明白，你把块定义改了，那图里面的其他地方的插入不是也改了?

难道只插入一个?那还做块干什么 ...

块定义改了，其他同名块自然会变！我只是对楼主命题的回答！不知道这个东西有什么实际用途！我想说这种属性快应该为无名块，修改块定义才不会影响其他块！或者属性包围框干脆和块定义没有任何关系，只将句柄记录在块的扩展数据里，这样会更好点！

牢固 · 发表于 2013-12-24 13:52:35

st788796 发表于 2013-12-24 13:41
按比例修改

按比例修改只适用单一种情况！但是同一块属性可以角度不同、位置不同，所以修改比例不能适用全部情况！

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

[研讨] 关于对象反应器，如何写才好？

点评

点评

点评

点评

点评

点评