是平行四边形时画中心线，其它封闭曲线在质心处画十字线

/db_自贡黄明儒_

1. ;;是平行四边形时画中心线，其它封闭曲线在质心处画十字线
   
2. (defun HH:CenMark (en / CEN LL LST OBJ OBJN P1 P2 PX1 PX2 PY1 PY2 R UR X Y)
   
3.   ;;133.2 [功能] 缩放一个点
   
4.   ;;scale 'pnt' from a base point of 'p1' by a factor of fact
   
5.   (defun scale_pnt (pnt p1 fact /)
   
6.     (polar p1 (angle p1 pnt) (* fact (distance p1 pnt)))
   
7.   )
   
8. 
   
9.   (if (and
   
10.         (setq lst (entget en))
    
11.         (setq lst (mapcar 'cdr
    
12.                           (vl-remove-if-not '(lambda (x) (= (car x) 10)) lst)
    
13.                   )
    
14.         )
    
15.         (equal (length lst) 4)
    
16.         (not (inters (car lst) (cadr lst) (caddr lst) (cadddr lst) nil))
    
17.         (not (inters (cadr lst) (caddr lst) (cadddr lst) (car lst) nil))
    
18.       )
    
19.     (progn
    
20.       (setq cen (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (car lst) (caddr lst)))
    
21.       (setq p1 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (car lst) (cadddr lst)))
    
22.       (setq p1 (scale_pnt p1 cen 1.25))
    
23.       (setq p2 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (cadr lst) (caddr lst)))
    
24.       (setq p2 (scale_pnt p2 cen 1.25))
    
25.       (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
    
26.       (setq p1 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (car lst) (cadr lst)))
    
27.       (setq p1 (scale_pnt p1 cen 1.25))
    
28.       (setq p2 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (caddr lst) (cadddr lst)))
    
29.       (setq p2 (scale_pnt p2 cen 1.25))
    
30.       (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
    
31.     )
    
32.     (progn
    
33.       (setq obj (vlax-ename->vla-object en))
    
34.       ;;(setq objN (vla-copy obj))
    
35.       (or *DOC*
    
36.           (setq *DOC* (vla-get-ActiveDocument (vlax-get-acad-object)))
    
37.       )
    
38.       (setq *MSP* (vla-get-Modelspace *DOC*))
    
39.       (vlax-invoke *MSP* 'addregion (list obj))
    
40.       (setq objN (vlax-ename->vla-object (entlast)))
    
41.       (setq cen (vlax-safearray->list (vlax-variant-value (vla-get-Centroid objN))))
    
42.       (vla-getboundingbox objN 'll 'ur)
    
43.       (setq lst (mapcar 'vlax-safearray->list (list ll ur)))
    
44.       (vla-delete objN)
    
45.       (setq r (/ (distance (car lst) (cadr lst)) 2.0))
    
46.       (setq px1 (mapcar '- cen (list r 0 0)))
    
47.       (setq px2 (mapcar '+ cen (list r 0 0)))
    
48.       (entmake (list (cons 0 "LINE") (cons 10 px1) (cons 11 px2)))
    
49.       (setq py1 (mapcar '- cen (list 0 r 0)))
    
50.       (setq py2 (mapcar '+ cen (list 0 r 0)))
    
51.       (entmake (list (cons 0 "LINE") (cons 10 py1) (cons 11 py2)))
    
52.     )
    
53.   )
    
54. )
    
55. (defun C:W4 (/ EN)
    
56.   (setq en (car (entsel)))
    
57.   (HH:CenMark en)
    
58.   (princ)
    
59. )

;;是平行四边形时画中心线，其它封闭曲线在质心处画十字线<br /> (defun HH:CenMark (en / CEN LL LST OBJ OBJN P1 P2 PX1 PX2 PY1 PY2 R UR X Y)<br />   ;;133.2 [功能] 缩放一个点<br />   ;;scale 'pnt' from a base point of 'p1' by a factor of fact <br />   (defun scale_pnt (pnt p1 fact /)<br />     (polar p1 (angle p1 pnt) (* fact (distance p1 pnt)))<br />   )<br /> <br />   (if (and<br />         (setq lst (entget en))<br />         (setq lst (mapcar 'cdr<br />                           (vl-remove-if-not '(lambda (x) (= (car x) 10)) lst)<br />                   )<br />         )<br />         (equal (length lst) 4)<br />         (not (inters (car lst) (cadr lst) (caddr lst) (cadddr lst) nil))<br />         (not (inters (cadr lst) (caddr lst) (cadddr lst) (car lst) nil))<br />       )<br />     (progn<br />       (setq cen (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (car lst) (caddr lst)))<br />       (setq p1 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (car lst) (cadddr lst)))<br />       (setq p1 (scale_pnt p1 cen 1.25))<br />       (setq p2 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (cadr lst) (caddr lst)))<br />       (setq p2 (scale_pnt p2 cen 1.25))<br />       (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))<br />       (setq p1 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (car lst) (cadr lst)))<br />       (setq p1 (scale_pnt p1 cen 1.25))<br />       (setq p2 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (caddr lst) (cadddr lst)))<br />       (setq p2 (scale_pnt p2 cen 1.25))<br />       (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))<br />     )<br />     (progn<br />       (setq obj (vlax-ename->vla-object en))<br />       ;;(setq objN (vla-copy obj))<br />       (or *DOC*<br />           (setq *DOC* (vla-get-ActiveDocument (vlax-get-acad-object)))<br />       )<br />       (setq *MSP* (vla-get-Modelspace *DOC*))<br />       (vlax-invoke *MSP* 'addregion (list obj))<br />       (setq objN (vlax-ename->vla-object (entlast)))<br />       (setq cen (vlax-safearray->list (vlax-variant-value (vla-get-Centroid objN))))<br />       (vla-getboundingbox objN 'll 'ur)<br />       (setq lst (mapcar 'vlax-safearray->list (list ll ur)))<br />       (vla-delete objN)<br />       (setq r (/ (distance (car lst) (cadr lst)) 2.0))<br />       (setq px1 (mapcar '- cen (list r 0 0)))<br />       (setq px2 (mapcar '+ cen (list r 0 0)))<br />       (entmake (list (cons 0 "LINE") (cons 10 px1) (cons 11 px2)))<br />       (setq py1 (mapcar '- cen (list 0 r 0)))<br />       (setq py2 (mapcar '+ cen (list 0 r 0)))<br />       (entmake (list (cons 0 "LINE") (cons 10 py1) (cons 11 py2)))<br />     )<br />   )<br /> )<br /> (defun C:W4 (/ EN)<br />   (setq en (car (entsel)))<br />   (HH:CenMark en)<br />   (princ)<br /> )

st788796

点集中心有数学算法,不用生成 Region

/db_自贡黄明儒_

st788796 发表于 2013-11-18 16:24
点集中心有数学算法,不用生成 Region

不是点集，比如一个异型零件，如果知道质心，我们就知道吊钩放在什么地方合适

st788796

/db_自贡黄明儒_ 发表于 2013-11-18 16:27
不是点集，比如一个异型零件，如果知道质心，我们就知道吊钩放在什么地方合适

用API写了个

1. (defun c:tt (/ ss)
   
2.   (if (setq ss (ssget))
   
3.     (progn
   
4.       (xdrx_linetype_load "Center")
   
5.       (mapcar
   
6.         '(lambda (x / pts cen vl hl box an an1 an2 p1 p2 p3 p4 ln1)
   
7.            (setq pts (xdrx_geom_searchoutline x)
   
8.                  cen (apply 'xdrx_points_centroid pts)
   
9.                  box (xdrx_entity_box x)
   
10.                  vl  (* 0.7 (distance (nth 1 box) (nth 2 box)))
    
11.                  hl  (* 0.7 (distance (car box) (cadr box)))
    
12.            )
    
13.            (if (and (= (length pts) 5)
    
14.                     (setq an1 (angle (car pts) (cadr pts)))
    
15.                     (setq an2 (angle (nth 3 pts) (nth 2 pts)))
    
16.                     (equal (setq hl (distance (car pts) (nth 2 pts)))
    
17.                            (distance (cadr pts) (nth 3 pts))
    
18.                            1e-5
    
19.                     )
    
20.                     (equal an1 an2 1e-4)
    
21.                )
    
22.              (setq p1 (polar cen
    
23.                              an2
    
24.                              (setq
    
25.                                hl (* 0.7 (distance (car pts) (cadr pts)))
    
26.                              )
    
27.                       )
    
28.                    p2 (polar cen (+ an2 pi) hl)
    
29.                    p3 (polar cen
    
30.                              (setq an (+ an1 (/ pi 2)))
    
31.                              (setq
    
32.                                vl (* 0.7 (distance (car pts) (nth 3 pts)))
    
33.                              )
    
34.                       )
    
35.                    p4 (polar cen (+ pi an) vl)
    
36.              )
    
37.              (setq p1 (polar cen pi hl)
    
38.                    p2 (polar cen 0. hl)
    
39.                    p3 (polar cen (/ pi 2) vl)
    
40.                    p4 (polar cen (* pi 1.5) vl)
    
41.              )
    
42.            )
    
43.            (setq ln1 (xdrx_line_make p1 p2))
    
44.            (xdrx_entity_setlinetype ln1 "Center")
    
45.            (setq ln1 (xdrx_line_make p3 p4))
    
46.            (xdrx_entity_setlinetype ln1 "Center")
    
47.          )
    
48.         (xdrx_pickset->ents ss)
    
49.       )
    
50.     )
    
51.   )
    
52.   (princ)
    
53. )

(defun c:tt (/ ss)<br />   (if (setq ss (ssget))<br />     (progn<br />       (xdrx_linetype_load "Center")<br />       (mapcar<br />         '(lambda (x / pts cen vl hl box an an1 an2 p1 p2 p3 p4 ln1)<br />            (setq pts (xdrx_geom_searchoutline x)<br />                  cen (apply 'xdrx_points_centroid pts)<br />                  box (xdrx_entity_box x)<br />                  vl  (* 0.7 (distance (nth 1 box) (nth 2 box)))<br />                  hl  (* 0.7 (distance (car box) (cadr box)))<br />            )<br />            (if (and (= (length pts) 5)<br />                     (setq an1 (angle (car pts) (cadr pts)))<br />                     (setq an2 (angle (nth 3 pts) (nth 2 pts)))<br />                     (equal (setq hl (distance (car pts) (nth 2 pts)))<br />                            (distance (cadr pts) (nth 3 pts))<br />                            1e-5<br />                     )<br />                     (equal an1 an2 1e-4)<br />                )<br />              (setq p1 (polar cen<br />                              an2<br />                              (setq<br />                                hl (* 0.7 (distance (car pts) (cadr pts)))<br />                              )<br />                       )<br />                    p2 (polar cen (+ an2 pi) hl)<br />                    p3 (polar cen<br />                              (setq an (+ an1 (/ pi 2)))<br />                              (setq<br />                                vl (* 0.7 (distance (car pts) (nth 3 pts)))<br />                              )<br />                       )<br />                    p4 (polar cen (+ pi an) vl)<br />              )<br />              (setq p1 (polar cen pi hl)<br />                    p2 (polar cen 0. hl)<br />                    p3 (polar cen (/ pi 2) vl)<br />                    p4 (polar cen (* pi 1.5) vl)<br />              )<br />            )<br />            (setq ln1 (xdrx_line_make p1 p2))<br />            (xdrx_entity_setlinetype ln1 "Center")<br />            (setq ln1 (xdrx_line_make p3 p4))<br />            (xdrx_entity_setlinetype ln1 "Center")<br />          )<br />         (xdrx_pickset->ents ss)<br />       )<br />     )<br />   )<br />   (princ)<br /> )