在dbx里面处理图元的方法

dcl1214

来一个示例：将块复制到dbx空间，炸开后返回多段线的dxf

1. (DEFUN $dao-xian-line-pts$ (blocks / $ents>dbxmodel$ *dbxmodel blocks fzjg line-dxf obj objs vla vlas)
   
2.                                         ;导线的多段线坐标
   
3.   (defun $ents>dbxmodel$ (ents / *DBXmodel arr ent>array vla vrs)
   
4.                                         ;记得释放对象 ，用vlax-release-object函数
   
5.     (defun ent>array (ents)
   
6.                                         ;图元转数组
   
7.       (if (and ents
   
8.                (= (type ents) 'list)
   
9.                (setq ents (vl-remove nil ents))
   
10.           )
    
11.         (vl-catch-all-apply
    
12.           'vlax-safearray-fill
    
13.           (list
    
14.             (vl-catch-all-apply
    
15.               'vlax-make-safearray
    
16.               (list
    
17.                 vlax-vbobject
    
18.                 (cons 0 (1- (length ents)))
    
19.               )
    
20.             )                                ;图元转数组
    
21.             (mapcar '(lambda (x / a)
    
22.                        (setq a (type x))
    
23.                        (cond ((= 'ename a) (vlax-ename->vla-object x))
    
24.                              ((= 'VLA-OBJECT a) x)
    
25.                        )
    
26.                      )
    
27.                     ents
    
28.             )
    
29.           )
    
30.         )
    
31.       )
    
32.     )
    
33.     (if        (and (setq
    
34.                *DBXmodel
    
35.                 (vlax-get-property
    
36.                   (vl-catch-all-apply
    
37.                     'vla-getinterfaceobject
    
38.                     (list (vlax-get-acad-object)
    
39.                           (if (< (setq vrs (atoi (getvar 'acadver))) 16)
    
40.                             "objectdbx.axdbdocument"
    
41.                             (strcat "objectdbx.axdbdocument." (itoa vrs))
    
42.                           )
    
43.                     )
    
44.                   )
    
45.                   'Modelspace
    
46.                 )
    
47.              )                                ;获取dbx对象
    
48.              (not (vl-catch-all-error-p *DBXmodel)) ;防止出错
    
49.              (setq arr (ent>array ents)) ;将图元转换为数组
    
50.              (not (vl-catch-all-error-p arr)) ;防止出错
    
51.         )
    
52.       (progn (setq vla (vl-catch-all-apply
    
53.                          'vla-CopyObjects
    
54.                          (list
    
55.                            (vla-get-ActiveDocument (vlax-get-acad-object))
    
56.                            arr
    
57.                            *DBXmodel
    
58.                          )
    
59.                        )                ;复制到对象空间
    
60.              )
    
61.              (if (vl-catch-all-error-p vla) ;防止出错
    
62.                (setq vla nil)
    
63.              )
    
64.       )
    
65.     )
    
66.     (list (cons "空间对象" *DBXmodel)
    
67.           (cons "复制结果" vla)
    
68.           (cons "备注" "记得释放*DBXmodel对象")
    
69.     )                                        ;用中文形式返回，中国人能看懂的
    
70.   )
    
71. 
    
72.   (if (and blocks
    
73.            (= (type blocks) 'list) ;图元列表矫正
    
74.            (setq blocks (vl-remove nil blocks))
    
75.                                         ;移除空值
    
76.            (setq fzjg ($ents>dbxmodel$ blocks))
    
77.                                         ;复制到db空间去，返回复制结果
    
78.            (setq *DBXmodel (cdr (assoc "空间对象" fzjg)))
    
79.                                         ;揪出对象，下面需要释放
    
80.            (setq vla (cdr (assoc "复制结果" fzjg))) ;揪出复制结果
    
81.            (setq vlas (vl-catch-all-apply 'vlax-variant-value (list vla)))
    
82.                                         ;变体值
    
83.            (not (vl-catch-all-error-p vlas)) ;防止出错
    
84.            (setq vlas (vlax-safearray->list vlas)) ;转list
    
85.            (not (vl-catch-all-error-p vlas)) ;防止出错
    
86.            (setq obj (vla-explode (car vlas))) ;炸开第一个对象
    
87.            (not (vl-catch-all-error-p obj)) ;防止出错
    
88.            (setq objs (vlax-safearray->list (vlax-variant-value obj)))
    
89.                                         ;转为list
    
90.       )
    
91.     (progn (setq LINE-DXF
    
92.                   (mapcar
    
93.                     (function (lambda (a / N DXF)
    
94.                                 (setq n (vla-get-objectname a))
    
95.                                         ;获取名字
    
96.                                 (if (and n (WCMATCH N "[,AcDbPolyline,]"))
    
97.                                         ;是否为多段线
    
98.                                   (SETQ DXF (ENTGET (VLAX-VLA-OBJECT->ENAME A)))
    
99.                                         ;获取祖玛
    
100.                                 )
     
101.                                 (vla-delete a)
     
102.                                         ;从对象中删除当前这个图元
     
103.                                 DXF        ;返回祖玛
     
104.                               )
     
105.                     )
     
106.                     objs
     
107.                   )
     
108.            )
     
109.            (setq LINE-DXF (vl-remove nil LINE-DXF)) ;删除空值
     
110.     )
     
111.   )
     
112.   (vlax-release-object *DBXmodel)        ;释放对象
     
113.   LINE-DXF
     
114. )
     
115. (setq dxf($dao-xian-line-pts$(list(car(entsel)))))

(DEFUN $dao-xian-line-pts$ (blocks / $ents>dbxmodel$ *dbxmodel blocks fzjg line-dxf obj objs vla vlas)<br />                                         ;导线的多段线坐标<br />   (defun $ents>dbxmodel$ (ents / *DBXmodel arr ent>array vla vrs)<br />                                         ;记得释放对象 ，用vlax-release-object函数<br />     (defun ent>array (ents)<br />                                         ;图元转数组<br />       (if (and ents<br />                (= (type ents) 'list)<br />                (setq ents (vl-remove nil ents))<br />           )<br />         (vl-catch-all-apply<br />           'vlax-safearray-fill<br />           (list<br />             (vl-catch-all-apply<br />               'vlax-make-safearray<br />               (list<br />                 vlax-vbobject<br />                 (cons 0 (1- (length ents)))<br />               )<br />             )                                ;图元转数组<br />             (mapcar '(lambda (x / a)<br />                        (setq a (type x))<br />                        (cond ((= 'ename a) (vlax-ename->vla-object x))<br />                              ((= 'VLA-OBJECT a) x)<br />                        )<br />                      )<br />                     ents<br />             )<br />           )<br />         )<br />       )<br />     )<br />     (if        (and (setq<br />                *DBXmodel<br />                 (vlax-get-property<br />                   (vl-catch-all-apply<br />                     'vla-getinterfaceobject<br />                     (list (vlax-get-acad-object)<br />                           (if (< (setq vrs (atoi (getvar 'acadver))) 16)<br />                             "objectdbx.axdbdocument"<br />                             (strcat "objectdbx.axdbdocument." (itoa vrs))<br />                           )<br />                     )<br />                   )<br />                   'Modelspace<br />                 )<br />              )                                ;获取dbx对象<br />              (not (vl-catch-all-error-p *DBXmodel)) ;防止出错<br />              (setq arr (ent>array ents)) ;将图元转换为数组<br />              (not (vl-catch-all-error-p arr)) ;防止出错<br />         )<br />       (progn (setq vla (vl-catch-all-apply<br />                          'vla-CopyObjects<br />                          (list<br />                            (vla-get-ActiveDocument (vlax-get-acad-object))<br />                            arr<br />                            *DBXmodel<br />                          )<br />                        )                ;复制到对象空间<br />              )<br />              (if (vl-catch-all-error-p vla) ;防止出错<br />                (setq vla nil)<br />              )<br />       )<br />     )<br />     (list (cons "空间对象" *DBXmodel)<br />           (cons "复制结果" vla)<br />           (cons "备注" "记得释放*DBXmodel对象")<br />     )                                        ;用中文形式返回，中国人能看懂的<br />   )<br /> <br />   (if (and blocks<br />            (= (type blocks) 'list) ;图元列表矫正<br />            (setq blocks (vl-remove nil blocks))<br />                                         ;移除空值<br />            (setq fzjg ($ents>dbxmodel$ blocks))<br />                                         ;复制到db空间去，返回复制结果<br />            (setq *DBXmodel (cdr (assoc "空间对象" fzjg)))<br />                                         ;揪出对象，下面需要释放<br />            (setq vla (cdr (assoc "复制结果" fzjg))) ;揪出复制结果<br />            (setq vlas (vl-catch-all-apply 'vlax-variant-value (list vla)))<br />                                         ;变体值<br />            (not (vl-catch-all-error-p vlas)) ;防止出错<br />            (setq vlas (vlax-safearray->list vlas)) ;转list<br />            (not (vl-catch-all-error-p vlas)) ;防止出错<br />            (setq obj (vla-explode (car vlas))) ;炸开第一个对象<br />            (not (vl-catch-all-error-p obj)) ;防止出错<br />            (setq objs (vlax-safearray->list (vlax-variant-value obj)))<br />                                         ;转为list<br />       )<br />     (progn (setq LINE-DXF<br />                   (mapcar<br />                     (function (lambda (a / N DXF)<br />                                 (setq n (vla-get-objectname a))<br />                                         ;获取名字<br />                                 (if (and n (WCMATCH N "[,AcDbPolyline,]"))<br />                                         ;是否为多段线<br />                                   (SETQ DXF (ENTGET (VLAX-VLA-OBJECT->ENAME A)))<br />                                         ;获取祖玛<br />                                 )<br />                                 (vla-delete a)<br />                                         ;从对象中删除当前这个图元<br />                                 DXF        ;返回祖玛<br />                               )<br />                     )<br />                     objs<br />                   )<br />            )<br />            (setq LINE-DXF (vl-remove nil LINE-DXF)) ;删除空值<br />     )<br />   )<br />   (vlax-release-object *DBXmodel)        ;释放对象<br />   LINE-DXF<br /> )<br /> (setq dxf($dao-xian-line-pts$(list(car(entsel)))))

kmliro_2017

谢谢分享！！！！！

HLCAD

感谢楼主分享程序！！！！！