求SOLID,REGION的形心

marting

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

(defun c:centroid ( / v^v unit ucs x y ss ent enta n p )<br /> (vl-load-com)<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 /> (defun unit ( v )<br />    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)<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 />

kqqt6236

沙发支持。

th9909

沙发支持。