Lee Mac大侠的新程序，麻烦高手给加个注释，不胜感谢！！！

soly2006 · 发表于 2012-3-21 21:25:37

本帖最后由 soly2006 于 2012-3-21 21:27 编辑

;;-------------------=={ Areas 2 Field }==--------------------;;
;; ;;
;; Creates an MText Field referencing the sum of the areas ;;
;; of selected objects. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright ?2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Version 1.1 - 14-03-2012 ;;
;;------------------------------------------------------------;;
(defun c:A2F (/ *error* _startundo _endundo
_objectid acdoc acsel count field
format pt
)
(setq format "%lu6%qf1")
;; Field Formatting
(defun *error* (msg)
(if acdoc
(_endundo acdoc)
)
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
)
(princ)
)
(defun _startundo (doc)
(_endundo doc)
(vla-StartUndoMark doc)
)
(defun _endundo (doc)
(while (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark doc)
)
)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
(setq _objectid
(eval
(list 'lambda
'(obj)
(if
(and
(vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
(vlax-method-applicable-p
(vla-get-utility acdoc)
'getobjectidstring
)
)
(list 'vla-getobjectidstring
(vla-get-utility acdoc)
'obj
':vlax-
false
)
'(itoa (vla-get-objectid obj))
)
)
)
)
(if
(and
(ssget
'((0 . "ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE,REGION,SPLINE"))
)
(setq pt (getpoint "\nPick Point for Field: "))
)
(progn
(setq acsel (vla-get-activeselectionset acdoc)
count (vla-get-count acsel)
field (if (< 1 count)
"%<\\AcExpr "
""
)
)
(_startundo acdoc)
(vlax-for obj acsel
(setq field (strcat field
"%<\\AcObjProp Object(%<\\_ObjId "
(_objectid
obj
)
">%).Area>% + "
)
)
)
(vla-delete acsel)
(vla-addmtext
(vlax-get-property
acdoc
(if (= 1 (getvar 'CVPORT))
'paperspace
'modelspace
)
)
(vlax-3D-point (trans pt 1 0))
0.0
(strcat (substr field
1
(- (strlen field)
(if (< 1 count)
3
5
)
)
)
" \\f
"" format
"">%"
)
)
(_endundo acdoc)
)
)
(princ)
)
(vl-load-com)
(princ)

;;-------------------=={ Areas 2 Field }==--------------------;; 
;;                                                            ;; 
;;  Creates an MText Field referencing the sum of the areas   ;; 
;;  of selected objects.                                      ;; 
;;------------------------------------------------------------;; 
;;  Author: Lee Mac, Copyright ?2012 - www.lee-mac.com       ;; 
;;------------------------------------------------------------;; 
;;  Version 1.1    -    14-03-2012                            ;; 
;;------------------------------------------------------------;; 
 
(defun c:A2F (/                *error*          _startundo              _endundo 
              _objectid        acdoc          acsel            count     field 
              format        pt 
             ) 
 
  (setq format "%lu6%qf1") 
  ;; Field Formatting 
 
  (defun *error* (msg) 
    (if        acdoc 
      (_endundo acdoc) 
    ) 
    (or        (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") 
        (princ (strcat "\n** Error: " msg " **")) 
    ) 
    (princ) 
  ) 
 
  (defun _startundo (doc) 
    (_endundo doc) 
    (vla-StartUndoMark doc) 
  ) 
 
  (defun _endundo (doc) 
    (while (= 8 (logand 8 (getvar 'UNDOCTL))) 
      (vla-EndUndoMark doc) 
    ) 
  ) 
 
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) 
  (setq        _objectid 
         (eval 
           (list 'lambda 
                 '(obj) 
                 (if 
                   (and 
                     (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE")) 
                     (vlax-method-applicable-p 
                       (vla-get-utility acdoc) 
                       'getobjectidstring 
                     ) 
                   ) 
                    (list 'vla-getobjectidstring 
                          (vla-get-utility acdoc) 
                          'obj 
                          ':vlax- 
                          false 
                    ) 
                    '(itoa (vla-get-objectid obj)) 
                 ) 
           ) 
         ) 
  ) 
 
  (if 
    (and 
      (ssget 
        '((0 . "ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE,REGION,SPLINE")) 
      ) 
      (setq pt (getpoint "\nPick Point for Field: ")) 
    ) 
     (progn 
       (setq acsel (vla-get-activeselectionset acdoc) 
             count (vla-get-count acsel) 
             field (if (< 1 count) 
                     "%<\\AcExpr " 
                     "" 
                   ) 
       ) 
       (_startundo acdoc) 
       (vlax-for obj acsel 
         (setq field (strcat field 
                             "%<\\AcObjProp Object(%<\\_ObjId " 
                             (_objectid 
                               obj 
                             ) 
                             ">%).Area>% + " 
                     ) 
         ) 
       ) 
       (vla-delete acsel) 
       (vla-addmtext 
         (vlax-get-property 
           acdoc 
           (if (= 1 (getvar 'CVPORT)) 
             'paperspace 
             'modelspace 
           ) 
         ) 
         (vlax-3D-point (trans pt 1 0)) 
         0.0 
         (strcat (substr field 
                         1 
                         (- (strlen field) 
                            (if        (< 1 count) 
                              3 
                              5 
                            ) 
                         ) 
                 ) 
                 " \\f 
""                 format 
                 "">%" 
         ) 
       ) 
       (_endundo acdoc) 
     ) 
  ) 
  (princ) 
) 
(vl-load-com) 
(princ)

yzxgwl · 发表于 2012-3-29 16:53:24

好象有问题生成不了文字

snddd2000 · 发表于 2012-3-29 21:19:50

一开始看演示，也以为是反应器做的，看了代码，是用命令field里的对象属性来实现的。

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

Lee Mac大侠的新程序，麻烦高手给加个注释，不胜感谢！！！

点评

相关帖子