用VLISP实现打印动态块的属性

marting

1. (defun c:extract() ; by Fenton Webb and Wayne Brill, DevTech, 08/Jan/2007
   
2. 
   
3.   ; make sure com is loaded
   
4.   (vl-load-com)
   
5.   ; get the acad application object
   
6.   (setq AcadApp (vlax-get-acad-object))
   
7.   ; now from that get the active document
   
8.   (setq AcadDoc (vla-Get-ActiveDocument AcadApp))
   
9.   ; now get the utility object so we can select an entity
   
10.   (setq UtilObj (vla-Get-Utility AcadDoc))
    
11.   ; now pick the block ref
    
12.   (vla-GetEntity UtilObj 'BlockRefObj 'selPt)
    
13.   ; so is this def a block ref
    
14.   (if (equal (setq ObjType (vla-Get-ObjectName BlockRefObj))
    
15.                      "AcDbBlockReference")
    
16.     (progn
    
17.       ; now get the dynamic block's properties
    
18.       (setq dynProps (vlax-variant-value (vla-getDynamicBlockProperties BlockRefObj )))
    
19.       (setq lBound (vlax-safearray-get-l-bound dynProps 1))
    
20.       (setq uBound (vlax-safearray-get-u-bound dynProps 1))
    
21.       (setq aCounter lBound)
    
22.       (while (<= aCounter uBound)
    
23.        (setq obj (vlax-safearray-get-element dynProps aCounter))
    
24.        (princ "\nPropertyName ")
    
25.        (princ "\n")
    
26.        (princ (vla-get-PropertyName obj))
    
27.           (princ "\nDescription ")
    
28.           (princ (vla-get-Description obj))
    
29.           (princ "\nReadonly ")
    
30.           (princ (vla-get-readonly obj))
    
31.           (princ "\nshow ")
    
32.           (princ (vla-get-show obj))
    
33.           (princ "\nvalue ")
    
34.           (princ (vla-get-value obj))
    
35.                
    
36.           (setq aCounter(1+ aCounter))
    
37.                
    
38.       )
    
39.      
    
40.     );progn
    
41.   );if
    
42. 
    
43.   ; now release everything to make sure
    
44.   (if UtilObj
    
45.     (progn (vlax-Release-Object UtilObj) (setq UtilObj nil))
    
46.   )
    
47.   (if AcadDoc
    
48.     (progn (vlax-Release-Object AcadDoc) (setq AcadDoc nil))
    
49.   )
    
50.   (if AcadApp
    
51.     (progn (vlax-Release-Object AcadApp) (setq AcadApp nil))
    
52.   )
    
53.   (princ)
    
54. );defun
    

(defun c:extract() ; by Fenton Webb and Wayne Brill, DevTech, 08/Jan/2007<br /> <br />   ; make sure com is loaded<br />   (vl-load-com)<br />   ; get the acad application object<br />   (setq AcadApp (vlax-get-acad-object))<br />   ; now from that get the active document<br />   (setq AcadDoc (vla-Get-ActiveDocument AcadApp))<br />   ; now get the utility object so we can select an entity<br />   (setq UtilObj (vla-Get-Utility AcadDoc))<br />   ; now pick the block ref<br />   (vla-GetEntity UtilObj 'BlockRefObj 'selPt)<br />   ; so is this def a block ref<br />   (if (equal (setq ObjType (vla-Get-ObjectName BlockRefObj))<br />                      "AcDbBlockReference")<br />     (progn<br />       ; now get the dynamic block's properties<br />       (setq dynProps (vlax-variant-value (vla-getDynamicBlockProperties BlockRefObj )))<br />       (setq lBound (vlax-safearray-get-l-bound dynProps 1))<br />       (setq uBound (vlax-safearray-get-u-bound dynProps 1))<br />       (setq aCounter lBound)<br />       (while (<= aCounter uBound)<br />        (setq obj (vlax-safearray-get-element dynProps aCounter))<br />        (princ "\nPropertyName ")<br />        (princ "\n")<br />        (princ (vla-get-PropertyName obj))<br />           (princ "\nDescription ")<br />           (princ (vla-get-Description obj))<br />           (princ "\nReadonly ")<br />           (princ (vla-get-readonly obj))<br />           (princ "\nshow ")<br />           (princ (vla-get-show obj))<br />           (princ "\nvalue ")<br />           (princ (vla-get-value obj))<br />                <br />           (setq aCounter(1+ aCounter))<br />                <br />       )<br />      <br />     );progn <br />   );if <br /> <br />   ; now release everything to make sure<br />   (if UtilObj<br />     (progn (vlax-Release-Object UtilObj) (setq UtilObj nil))<br />   )<br />   (if AcadDoc<br />     (progn (vlax-Release-Object AcadDoc) (setq AcadDoc nil))<br />   )<br />   (if AcadApp<br />     (progn (vlax-Release-Object AcadApp) (setq AcadApp nil))<br />   )<br />   (princ)<br /> );defun<br />

daodai123

高手啊，多谢多谢

sicky111

谢谢分享。