嵌套块坐标

树櫴希德

假如一块内含多个块 子块又含有直线 园 等图元 我想批量提取子图元 圆CIRCLE的坐标，循环老是有问题，大侠们看看

2. (defun INSERT1 ( ENT11 / OBJ LST)
   
3. (setq OBJ (vlax-ename->vla-object ENT11))
   
4. (vlax-for X
   
5. (vla-item
   
6. (vla-get-blocks (vla-get-ActiveDocument(vlax-get-acad-object)))
   
7. (vla-get-name OBJ)
   
8. )
   
9. (setq lst (cons (vlax-vla-object->ename X) LST))
   
10. )
    
11. LST
    
12. )
    
13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
14. (defun c:gczbh1 (/ p qianzhui blc zg ss i lst1t e kkkk ptlst ff )
    
15. 
    
16. (setq blc (getint "\n请输入比例尺1:"))
    
17.   (setvar 'userr1 blc);设置比例尺
    
18. (setq zg(* 0.002 blc));字高
    
19. 
    
20. 
    
21. (defun get_inpoint (blockname)
    
22.   (setq in_point(cdr (assoc 10 (entget blockname))))
    
23.   in_point
    
24. )
    
25. 
    
26. 
    
27. (setq ss (ssget '((0 . "insert")))   )
    
28. ;(setq jidian (getpoint "请选择基点："))
    
29. ;(setq fangx (getpoint  jidian "请选择方向点："))
    
30. ;(setq angle1 (* (angle jidian fangx) 1))
    
31. ;(command "_.rotate" ss "" jidian "r" jidian fangx (polar jidian 0 100))
    
32. 
    
33. (setq i 0)
    
34.   (setq lsttt '())
    
35. (setq lst '())
    
36.   (setq lstt '())
    
37. (repeat (sslength ss)
    
38. (setq insert_name (ssname ss i))
    
39.   (SETQ E (INSERT1 insert_name))
    
40. (foreach x E
    
41.   ;;;;;;;;;;;;;;
    
42.         ;;;;;;;;;;;;;;;;
    
43. (if   (= (cdr (assoc 0(entget x))) "insert")
    
44.   (progn
    
45.     (setq PPP  (INSERT1 x))
    
46.    
    
47.   (mapcar  '(lambda (xxx)
    
48.     (if (= (cdr (assoc 0(entget xxx)) ) "CIRCLE"   ) (progn
    
49. (setq zhuobiao (cdr (assoc 10(entget xxx))))
    
50.   (setq lstt (append lstt (list zhuobiao)))    ) )  
    
51.     )
    
52.         ppp)
    
53.   )
    
54. 
    
55.   ;;;;;;;;;;;;;;;;;;;;;
    
56.   (if  (= (cdr (assoc 0(entget x)) ) "CIRCLE"   )
    
57.     (progn
    
58.      (setq zhuobiao (cdr (assoc 10(entget x))))
    
59.     (setq lstt (append lstt (list zhuobiao)))
    
60. );;;;;;;;;;;;;;;;;;;;
    
61. )
    
62.   )
    
63. ;(setq e(get_inpoint insert_name))
    
64.   
    
65.   (setq lst (append lst lstt))
    
66.   
    
67. (setq i (1+ i))
    
68. 
    
69.   )
    
70. )

(defun INSERT1 ( ENT11 / OBJ LST)<br /> (setq OBJ (vlax-ename->vla-object ENT11))<br /> (vlax-for X<br /> (vla-item<br /> (vla-get-blocks (vla-get-ActiveDocument(vlax-get-acad-object)))<br /> (vla-get-name OBJ)<br /> )<br /> (setq lst (cons (vlax-vla-object->ename X) LST))<br /> )<br /> LST<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun c:gczbh1 (/ p qianzhui blc zg ss i lst1t e kkkk ptlst ff )<br /> <br /> (setq blc (getint "\n请输入比例尺1:"))<br />   (setvar 'userr1 blc);设置比例尺<br /> (setq zg(* 0.002 blc));字高<br /> <br /> <br /> (defun get_inpoint (blockname)<br />   (setq in_point(cdr (assoc 10 (entget blockname))))<br />   in_point<br /> )<br /> <br /> <br /> (setq ss (ssget '((0 . "insert")))   )<br /> ;(setq jidian (getpoint "请选择基点："))<br /> ;(setq fangx (getpoint  jidian "请选择方向点："))<br /> ;(setq angle1 (* (angle jidian fangx) 1))<br /> ;(command "_.rotate" ss "" jidian "r" jidian fangx (polar jidian 0 100))<br /> <br /> (setq i 0)<br />   (setq lsttt '())<br /> (setq lst '())<br />   (setq lstt '())<br /> (repeat (sslength ss)<br /> (setq insert_name (ssname ss i))<br />   (SETQ E (INSERT1 insert_name))<br /> (foreach x E<br />   ;;;;;;;;;;;;;;<br />         ;;;;;;;;;;;;;;;;<br /> (if   (= (cdr (assoc 0(entget x))) "insert")<br />   (progn<br />     (setq PPP  (INSERT1 x))<br />     <br />   (mapcar  '(lambda (xxx)<br />     (if (= (cdr (assoc 0(entget xxx)) ) "CIRCLE"   ) (progn<br /> (setq zhuobiao (cdr (assoc 10(entget xxx))))<br />   (setq lstt (append lstt (list zhuobiao)))    ) )  <br />     )<br />         ppp)<br />   )<br /> <br />   ;;;;;;;;;;;;;;;;;;;;;<br />   (if  (= (cdr (assoc 0(entget x)) ) "CIRCLE"   )<br />     (progn<br />      (setq zhuobiao (cdr (assoc 10(entget x))))<br />     (setq lstt (append lstt (list zhuobiao)))<br /> );;;;;;;;;;;;;;;;;;;;<br /> )<br />   )<br /> ;(setq e(get_inpoint insert_name))<br />   <br />   (setq lst (append lst lstt))<br />   <br /> (setq i (1+ i))<br /> <br />   )<br /> )

edata

一般都是递归法，lisp或vlisp都可以。

树櫴希德

edata 发表于 2015-9-1 21:18
一般都是递归法，lisp或vlisp都可以。

不懂递归

edata

1. ;;vla版递归遍历图元
   
2. ;;(sk_get_blk->ent obj) obj= 插入块的vla-object
   
3. ;;by edata 2015-9-1
   
4. (defun sk_get_blk->ent(blk / blk_name  blocks n lst)
   
5.   (if(and blk (= (vla-get-objectname blk) "AcDbBlockReference"))
   
6.     (progn
   
7.       (setq blk_name(vla-get-name blk))
   
8.       (setq blocks(vla-get-blocks(vla-get-activedocument(vlax-get-acad-object))))
   
9.       (vlax-for n (vla-item blocks blk_name)
   
10.         (cond ((= (vla-get-objectname n) "AcDbBlockReference")
    
11.               (setq lst(append (sk_get_blk->ent n) lst ))
    
12.                )
    
13.               (t (setq lst(cons n lst)))
    
14.               )
    
15.         )
    
16.       (reverse lst)
    
17.       )
    
18.     )
    
19.   )
    
20. 
    
21. ;;test
    
22. (defun c:tt(/ obj all_blk_en)
    
23.   (setq obj(vlax-ename->vla-object (car(entsel))))
    
24.   (setq all_blk_en(mapcar 'vlax-vla-object->ename (sk_get_blk->ent obj)))
    
25.   )
    
26.   

;;vla版递归遍历图元<br /> ;;(sk_get_blk->ent obj) obj= 插入块的vla-object<br /> ;;by edata 2015-9-1<br /> (defun sk_get_blk->ent(blk / blk_name  blocks n lst)<br />   (if(and blk (= (vla-get-objectname blk) "AcDbBlockReference"))<br />     (progn<br />       (setq blk_name(vla-get-name blk))<br />       (setq blocks(vla-get-blocks(vla-get-activedocument(vlax-get-acad-object))))<br />       (vlax-for n (vla-item blocks blk_name)<br />         (cond ((= (vla-get-objectname n) "AcDbBlockReference")<br />               (setq lst(append (sk_get_blk->ent n) lst ))<br />                )<br />               (t (setq lst(cons n lst)))<br />               )<br />         )<br />       (reverse lst)<br />       )<br />     )<br />   )<br /> <br /> ;;test<br /> (defun c:tt(/ obj all_blk_en)<br />   (setq obj(vlax-ename->vla-object (car(entsel))))<br />   (setq all_blk_en(mapcar 'vlax-vla-object->ename (sk_get_blk->ent obj)))<br />   )<br />   

树櫴希德

edata 发表于 2015-9-1 22:35

这段代码能返回0次嵌套图元名，返回的图元名10组是以母块插入点为0基准的，但是大神上面那个是以字块插入点为基准的，可不可以修改下返回的图元名10组也以母块插入点为基准啊

2. (defun INSERT1 ( ENT11 / OBJ LST)
   
3. (setq OBJ (vlax-ename->vla-object ENT11))
   
4. (vlax-for X
   
5. (vla-item
   
6. (vla-get-blocks (vla-get-ActiveDocument(vlax-get-acad-object)))
   
7. (vla-get-name OBJ)
   
8. )
   
9. (setq lst (cons (vlax-vla-object->ename X) LST))
   
10. )
    
11. LST
    
12. )
    
13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun INSERT1 ( ENT11 / OBJ LST)<br /> (setq OBJ (vlax-ename->vla-object ENT11))<br /> (vlax-for X<br /> (vla-item<br /> (vla-get-blocks (vla-get-ActiveDocument(vlax-get-acad-object)))<br /> (vla-get-name OBJ)<br /> )<br /> (setq lst (cons (vlax-vla-object->ename X) LST))<br /> )<br /> LST<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

edata

这个涉及到坐标转换；
假设一个块内的坐标点是： x ,y ,z ,且一般不考虑法线矢量。
插入块的缩放比例是u, v ,w
块的旋转角度是  a
块的插入点坐标是 x0,y0,z0
那么这个点在世界坐标系是：
u*cos(a)*x - v*sin(a)*y + X0,
u*sin(a)*x +v*cos(a)*y +Y0,
w*Z0                      BY highflybird

树櫴希德

edata 发表于 2015-9-2 12:16
这个涉及到坐标转换；
假设一个块内的坐标点是： x ,y ,z ,且一般不考虑法线矢量。
插入块的缩放比例是u, ...

关键是信息丢失 分的太彻底了