获取REGION,3DSOLID的centroid的代码

marting

1. (defun c:centroid ( / v^v unit ucs x y ss ent enta n p )
   
2. 
   
3.   (vl-load-com)
   
4. 
   
5.   (defun v^v ( u v )
   
6.     (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
   
7.   )
   
8. 
   
9.   (defun unit ( v )
   
10.     (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
    
11.   )
    
12. 
    
13.   (if (/= (getvar 'worlducs) 1)
    
14.     (command "_.ucs" "_w")
    
15.   )
    
16.   (setq ss (ssget "_+.:E:S" '((0 . "3DSOLID,REGION"))))
    
17.   (setq ent (ssname ss 0))
    
18.   (setq enta (vlax-ename->vla-object ent))
    
19.   (if
    
20.     (eq (cdr (assoc 0 (entget ent))) "REGION")
    
21.     (progn
    
22.       (setq n (vlax-safearray->list (vlax-variant-value (vla-get-normal enta))))
    
23.       (if (equal (v^v n '(0.0 0.0 1.0)) '(0.0 0.0 0.0) 1e-6)
    
24.         (setq x '(1.0 0.0 0.0) y '(0.0 1.0 0.0))
    
25.         (setq x (unit (v^v n '(0.0 0.0 1.0))) y (unit (v^v n x)))
    
26.       )
    
27.       (command "_.explode" ent)
    
28.       (while
    
29.         (> (getvar 'cmdactive) 0)
    
30.         (command "")
    
31.       )
    
32.       (setq p (vlax-curve-getstartpoint (entlast)))
    
33.       (command "_.undo")
    
34.       (while
    
35.         (> (getvar 'cmdactive) 0)
    
36.         (command "")
    
37.       )
    
38.       (setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point p) (vlax-3d-point (mapcar '+ p x)) (vlax-3d-point (mapcar '+ p y)) "{ UCS }"))
    
39.       (vla-put-activeucs (vla-get-activedocument (vlax-get-acad-object)) ucs)
    
40.       (command "_.UCS" "_D" "{ UCS }")
    
41.       (vlax-release-object ucs)
    
42.       (setq cent (trans (vlax-safearray->list (vlax-variant-value (vla-get-centroid enta))) 1 0))
    
43.       (command "_.ucs" "_p")
    
44.     )
    
45.     (setq cent (vlax-safearray->list (vlax-variant-value (vla-get-centroid enta))))
    
46.   )
    
47.   (prompt "\nCentroid : ") (princ cent)
    
48.   (prompt "\nVariable is called \"cent\" - you call it with !cent")
    
49.   (princ)
    
50. )
    

(defun c:centroid ( / v^v unit ucs x y ss ent enta n p )<br /> <br />   (vl-load-com)<br /> <br />   (defun v^v ( u v )<br />     (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))<br />   )<br /> <br />   (defun unit ( v )<br />     (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)<br />   )<br /> <br />   (if (/= (getvar 'worlducs) 1)<br />     (command "_.ucs" "_w")<br />   )<br />   (setq ss (ssget "_+.:E:S" '((0 . "3DSOLID,REGION"))))<br />   (setq ent (ssname ss 0))<br />   (setq enta (vlax-ename->vla-object ent))<br />   (if<br />     (eq (cdr (assoc 0 (entget ent))) "REGION")<br />     (progn<br />       (setq n (vlax-safearray->list (vlax-variant-value (vla-get-normal enta))))<br />       (if (equal (v^v n '(0.0 0.0 1.0)) '(0.0 0.0 0.0) 1e-6)<br />         (setq x '(1.0 0.0 0.0) y '(0.0 1.0 0.0))<br />         (setq x (unit (v^v n '(0.0 0.0 1.0))) y (unit (v^v n x)))<br />       )<br />       (command "_.explode" ent)<br />       (while<br />         (> (getvar 'cmdactive) 0)<br />         (command "")<br />       )<br />       (setq p (vlax-curve-getstartpoint (entlast)))<br />       (command "_.undo")<br />       (while<br />         (> (getvar 'cmdactive) 0)<br />         (command "")<br />       )<br />       (setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point p) (vlax-3d-point (mapcar '+ p x)) (vlax-3d-point (mapcar '+ p y)) "{ UCS }"))<br />       (vla-put-activeucs (vla-get-activedocument (vlax-get-acad-object)) ucs)<br />       (command "_.UCS" "_D" "{ UCS }")<br />       (vlax-release-object ucs)<br />       (setq cent (trans (vlax-safearray->list (vlax-variant-value (vla-get-centroid enta))) 1 0))<br />       (command "_.ucs" "_p")<br />     )<br />     (setq cent (vlax-safearray->list (vlax-variant-value (vla-get-centroid enta))))<br />   )<br />   (prompt "\nCentroid : ") (princ cent)<br />   (prompt "\nVariable is called \"cent\" - you call it with !cent")<br />   (princ)<br /> )<br />