ACAD字段（Feild)的应用实例

marting · 发表于 2017-3-2 10:57:57

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

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

×

字段是在DWG生命期中，可以随着DWG保存，可以附着对象，跟随对象某个属性动态变化的”文本“。

下面代码是把一个多边形的面积用字段标注，以后随着多边形的面积变化，可以更新面积值。

字段应用（面积标注）.gif

(defun c:somefunc (/ mtobject prec)
(if (null *somefuncmtprec*)
(setq *somefuncmtprec* 2)
)
(initget 4)
(setq prec (getint (strcat "\nEnter mText decimal Precision <"
(itoa *somefuncmtprec*)
">: "
)
)
mtobject (vla-addmtext
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
(vlax-3d-point
(trans (getpoint "\nInsert mText Insertion Point :")
1
0
)
)
0
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(itoa (vla-get-objectid
(vlax-ename->vla-object
(car (entsel "\nSelect Polyline: "))
)
)
)
">%).Area \\f \"%lu2%pr"
(if (> prec 8)
(progn (setq *somefuncmtprec* 8) "8")
(if (null prec)
(itoa *somefuncmtprec*)
(progn (setq *somefuncmtprec* prec)
(itoa *somefuncmtprec*)
)
)
)
"%th44\">%"
" m{\\H0.7x;\\S2^;}"
)
)
)
(vla-put-height mtobject (getvar 'textsize))
(mapcar '(lambda (x y) (setpropertyvalue (entlast) x y))
'("Direction/X" "Direction/Y")
(list (car (getvar 'ucsxdir)) (cadr (getvar 'ucsxdir)))
)
(princ)
)

(defun c:somefunc (/ mtobject prec) 
  (if (null *somefuncmtprec*) 
    (setq *somefuncmtprec* 2) 
  ) 
  (initget 4) 
  (setq        prec         (getint (strcat "\nEnter mText decimal Precision <" 
                                 (itoa *somefuncmtprec*) 
                                 ">: " 
                         ) 
                 ) 
        mtobject (vla-addmtext 
                   (vla-get-modelspace 
                     (vla-get-activedocument (vlax-get-acad-object)) 
                   ) 
                   (vlax-3d-point 
                     (trans (getpoint "\nInsert mText Insertion Point :") 
                            1 
                            0 
                     ) 
                   ) 
                   0 
                   (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                           (itoa (vla-get-objectid 
                                   (vlax-ename->vla-object 
                                     (car (entsel "\nSelect Polyline: ")) 
                                   ) 
                                 ) 
                           ) 
                           ">%).Area \\f \"%lu2%pr" 
                           (if (> prec 8) 
                             (progn (setq *somefuncmtprec* 8) "8") 
                             (if (null prec) 
                               (itoa *somefuncmtprec*) 
                               (progn (setq *somefuncmtprec* prec) 
                                      (itoa *somefuncmtprec*) 
                               ) 
                             ) 
                           ) 
                           "%th44\">%" 
                           " m{\\H0.7x;\\S2^;}" 
                   ) 
                 ) 
  ) 
  (vla-put-height mtobject (getvar 'textsize)) 
  (mapcar '(lambda (x y) (setpropertyvalue (entlast) x y)) 
          '("Direction/X" "Direction/Y") 
          (list (car (getvar 'ucsxdir)) (cadr (getvar 'ucsxdir))) 
  ) 
  (princ) 
)

dnbcgrass · 发表于 2017-3-2 22:38:10

Select Polyline: ; 错误: no function definition: SETPROPERTYVALUE

newer · 发表于 2017-3-2 23:57:34

dnbcgrass 发表于 2017-3-2 22:38

你CAD版本太低了，setpropertyvalue好像是2014以上提供的吧。你什么版本的CAD？

可以写个替代的函数，在低版本。就是写实体数据，entmod就行。

sicky111 · 发表于 2017-3-3 00:03:33

啥也不说了，感谢楼主分享哇！

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

[每日一码] ACAD字段（Feild)的应用实例

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

浏览过的版块