更新pline多线坐标点

dcl1214

1. (DEFUN $gen-xin-pline-zuo-biao$  (ent pts / b g h i)
   
2.           ;更新pl线的坐标，更新直线坐标，不能是多个list，只能是一个list，注意：pts必需是二维点，不是三维点
   
3.   (if (and ent pts)
   
4.     (PROGN
   
5.       (if (and (> (length pts) 1)
   
6.          (= (type (car pts)) 'list)
   
7.          (= (length (car pts)) 3)
   
8.     )
   
9.   (progn
   
10.     (setq b (vlax-ename->vla-object ent))
    
11.           ;(setq ent(car(entsel)))
    
12.     (or (AND (= (vla-get-objectname b) "AcDb3dPolyline")
    
13.        (setq
    
14.          pts
    
15.           (mapcar (function (lambda (a) (list (car a) (cadr a) 0)))
    
16.             pts
    
17.           )
    
18.        )
    
19.         )        ;这里确保是三维点坐标
    
20.         (AND (= (vla-get-objectname b) "AcDbPolyline")
    
21.        (setq
    
22.          pts
    
23.           (mapcar (function (lambda (a) (list (car a) (cadr a))))
    
24.             pts
    
25.           )
    
26.        )
    
27.         )        ;这里确保是二维点坐标
    
28.     )
    
29.     (setq pts (apply 'append pts)) ;拼接成一个list
    
30.   )
    
31.       )
    
32.       (setq g pts)
    
33.       (setq h (vl-catch-all-apply
    
34.     'vlax-make-safearray
    
35.     (LIST vlax-vbDouble (cons 0 (1- (length g))))
    
36.         )
    
37.       )
    
38.       (setq
    
39.   i (vl-catch-all-apply 'vlax-safearray-fill (LIST h g))
    
40.       )
    
41.       (vl-catch-all-apply
    
42.   'vla-put-Coordinates
    
43.   (LIST b (vl-catch-all-apply 'vlax-make-variant (list i)))
    
44.       )
    
45.       (vl-catch-all-apply 'vla-update (LIST b))
    
46.     )
    
47.   )
    
48. )

(DEFUN $gen-xin-pline-zuo-biao$  (ent pts / b g h i)<br />           ;更新pl线的坐标，更新直线坐标，不能是多个list，只能是一个list，注意：pts必需是二维点，不是三维点<br />   (if (and ent pts)<br />     (PROGN<br />       (if (and (> (length pts) 1)<br />          (= (type (car pts)) 'list)<br />          (= (length (car pts)) 3)<br />     )<br />   (progn<br />     (setq b (vlax-ename->vla-object ent))<br />           ;(setq ent(car(entsel)))<br />     (or (AND (= (vla-get-objectname b) "AcDb3dPolyline")<br />        (setq<br />          pts<br />           (mapcar (function (lambda (a) (list (car a) (cadr a) 0)))<br />             pts<br />           )<br />        )<br />         )        ;这里确保是三维点坐标<br />         (AND (= (vla-get-objectname b) "AcDbPolyline")<br />        (setq<br />          pts<br />           (mapcar (function (lambda (a) (list (car a) (cadr a))))<br />             pts<br />           )<br />        )<br />         )        ;这里确保是二维点坐标<br />     )<br />     (setq pts (apply 'append pts)) ;拼接成一个list<br />   )<br />       )<br />       (setq g pts)<br />       (setq h (vl-catch-all-apply<br />     'vlax-make-safearray<br />     (LIST vlax-vbDouble (cons 0 (1- (length g))))<br />         )<br />       )<br />       (setq<br />   i (vl-catch-all-apply 'vlax-safearray-fill (LIST h g))<br />       )<br />       (vl-catch-all-apply<br />   'vla-put-Coordinates<br />   (LIST b (vl-catch-all-apply 'vlax-make-variant (list i)))<br />       )<br />       (vl-catch-all-apply 'vla-update (LIST b))<br />     )<br />   )<br /> )