多义线节点插块

Free-Lancer

1. (defun c:tt (/ _pi2)
   
2.   (setq _pi2 (* pi 0.5))
   
3.   (if (ssget '((0 . "lwpolyline")))
   
4.     (mapcar
   
5.       '(lambda (x / pts func ans ptl)
   
6.          (setq pts (vlax-get x 'Coordinates))
   
7.          (while        pts
   
8.            (setq ptl (cons (list (car pts) (cadr pts)) ptl)
   
9.                  pts (cddr pts)
   
10.            )
    
11.          )
    
12.          (if (vlax-curve-isclosed x)
    
13.            (setq ptl (reverse (cons (last ptl) ptl)))
    
14.            (setq ptl (reverse ptl))
    
15.          )
    
16.          (if (minusp (XD::Pnts:area ptl))
    
17.            (setq func '-)
    
18.            (setq func '+)
    
19.          )
    
20.          (setq ans (mapcar '(lambda (x1 x2)
    
21.                               (apply func (list (angle x1 x2) _pi2))
    
22.                             )
    
23.                            ptl
    
24.                            (cdr ptl)
    
25.                    )
    
26.          )
    
27.          (mapcar '(lambda (p1 an)
    
28.                     (vla-insertblock
    
29.                       (fy:acms)
    
30.                       (vlax-3d-point p1)
    
31.                       "001";_blockname
    
32.                       1.
    
33.                       1.
    
34.                       1.
    
35.                       an;_angle
    
36.                     )
    
37.                   )
    
38.                  ptl
    
39.                  ans
    
40.          )
    
41.          (setq ptl nil)
    
42.        )
    
43.       (fy:cset->objs)
    
44.     )
    
45.   )
    
46.   (princ)
    
47. )
    

(defun c:tt (/ _pi2)<br />   (setq _pi2 (* pi 0.5))<br />   (if (ssget '((0 . "lwpolyline")))<br />     (mapcar<br />       '(lambda (x / pts func ans ptl)<br />          (setq pts (vlax-get x 'Coordinates))<br />          (while        pts<br />            (setq ptl (cons (list (car pts) (cadr pts)) ptl)<br />                  pts (cddr pts)<br />            )<br />          )<br />          (if (vlax-curve-isclosed x)<br />            (setq ptl (reverse (cons (last ptl) ptl)))<br />            (setq ptl (reverse ptl))<br />          )<br />          (if (minusp (XD::Pnts:area ptl))<br />            (setq func '-)<br />            (setq func '+)<br />          )<br />          (setq ans (mapcar '(lambda (x1 x2)<br />                               (apply func (list (angle x1 x2) _pi2))<br />                             )<br />                            ptl<br />                            (cdr ptl)<br />                    )<br />          )<br />          (mapcar '(lambda (p1 an)<br />                     (vla-insertblock<br />                       (fy:acms)<br />                       (vlax-3d-point p1)<br />                       "001";_blockname<br />                       1.<br />                       1.<br />                       1.<br />                       an;_angle<br />                     )<br />                   )<br />                  ptl<br />                  ans<br />          )<br />          (setq ptl nil)<br />        )<br />       (fy:cset->objs)<br />     )<br />   )<br />   (princ)<br /> )<br />

/db_自贡黄明儒_

属性块行不行呀？{:soso_e113:}

Free-Lancer

/db_自贡黄明儒_ 发表于 2013-12-19 16:55
属性块行不行呀？

只是给个算法示意，贴一个获取属性的

1. (defun Insert:GetAtts (obj)
   
2.   (mapcar '(lambda (x)
   
3.              (list x (vla-get-tagstring x) (vla-get-textstring x))
   
4.            )
   
5.           (vlax-invoke obj 'Getattributes)
   
6.   )
   
7. )

(defun Insert:GetAtts (obj)<br />   (mapcar '(lambda (x)<br />              (list x (vla-get-tagstring x) (vla-get-textstring x))<br />            )<br />           (vlax-invoke obj 'Getattributes)<br />   )<br /> )

xvjiex

感谢楼主分享多义线节点插块！

SHUNDocker

感谢分享学习！！！

天下第五坑

感谢分享学习！！！