坐标集就质心
(defun $point->Polyline->reg->centroid$(pts lst / centroid doc obj obj1 obj2 mp tmp)
;坐标集求质心
(setq pts (vl-remove nil pts))
(setqpts (mapcar (function (lambda (a) (list (car a) (cadr a))))
pts
)
)
(SETQ pts (APPLY 'APPEND pts))
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (= (getvar 'ctab) "Model")
(setq mp (vla-get-modelSpace doc))
(setq mp (vla-get-paperSpace doc))
)
(and pts
(setq tmp (vl-catch-all-apply
'vlax-make-safearray
(LIST vlax-vbDouble
(cons 0 (- (length pts) 1))
)
)
)
(vl-catch-all-apply 'vlax-safearray-fill (LIST tmp pts))
)
(and doc
tmp
(setq
obj1
(vl-catch-all-apply
'vla-addLightweightPolyline
(LIST mp tmp)
)
)
(not (vl-catch-all-error-p obj1))
(progn (vl-catch-all-apply 'vla-Put-CLOSED (LIST obj1 1)) t)
(setq
OBJ2 (vl-catch-all-apply
'vla-addRegion
(list
mp
(vl-catch-all-apply
'vlax-make-variant
(list
(vl-catch-all-apply
'vlax-safearray-fill
(list
(vlax-make-safearray vlax-vbObject '(0 . 0))
(list obj1)
)
)
)
)
)
)
)
(not (vl-catch-all-error-p OBJ2))
(setq obj (car (vlax-safearray->list (vlax-variant-value obj2))))
(not (vl-catch-all-error-p obj))
(setq
centroid (vlax-safearray->list
(vlax-variant-value
(vla-get-Centroid
obj
)
)
)
)
)
(if (and obj (not (vl-catch-all-error-p obj)))
(vl-catch-all-apply 'vla-delete (list obj))
)
(if (and obj1 (not (vl-catch-all-error-p obj1)))
(vl-catch-all-apply 'vla-delete (list obj1))
)
centroid
)
;调用示例
(vl-cmdf "point"
($points->Polyline>reg>centroid$
(list (getpoint)
(getpoint)
(getpoint)
(getpoint)
)
nil
)
)
本帖最后由 kozmosovia 于 2025-8-24 09:15 编辑
几个command，5行代码就可以搞定的事，写那么长，真闲。但凡取个点集，计算凸壳再求质心，我都觉得这函数有价值。 kozmosovia 发表于 2025-8-24 09:08
几个command，5行代码就可以搞定的事，写那么长，真闲。但凡取个点集，计算凸壳再求质心，我都觉得这函数有 ...
凸壳求质心，CGAL就可以，我现在不想用CGAL了，试试lisp求质心到底什么情况 本帖最后由 xyp1964 于 2025-8-24 16:30 编辑
参数 lst 跑哪里去了？
点集连线有可能自相交
xyp1964 发表于 2025-8-24 16:16
参数 lst 跑哪里去了？
lst是属于【未来参数】 这个容易出bug，自交的pl线，弄不出来面域 本帖最后由 yanshengjiang 于 2025-8-25 12:31 编辑
虽然保证了在线内，但或许不是质心。
(Defun c:tt()
(command "point" (CENpoint(car(entsel))) )
)
(defun CENpoint(e / p POLY POLY_vl Dx Dy Lp List_vert_poly list_p_int P_center dist step1 step2 e1 makep LWPoly->List grid_1 Point_int grid+ Point_center)
(defun makep(pt)
(entmake(append(list'(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")'(8 . "0")
(cons 90(length pt))'(70 . 1))(mapcar '(lambda (x)(cons 10 x))pt))))
(defun LWPoly->List(ent / der di1 di2 inc lst par rad )
(setq par 0)
(repeat(cdr(assoc 90(entget ent)))
(if (setq der(vlax-curve-getsecondderiv ent par))
(if (equal der '(0.0 0.0 0.0) 1e-8)
(setq lst (cons (vlax-curve-getpointatparam ent par) lst))
(if(setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par))
di1 (vlax-curve-getdistatparam ent par)
di2 (vlax-curve-getdistatparam ent (1+ par)))
(progn
(setq inc(/(- di2 di1)(1+(fix(* 25(/(- di2 di1)rad(+ pi pi)))))))
(while (< di1 di2)
(setq lst(cons (vlax-curve-getpointatdist ent di1)lst)
di1(+ di1 inc)))))))
(setq par(1+ par)))
lst)
(defun grid_1 (POLY_vl step1 / P1_ P2_ n P> )
(vla-getboundingbox POLY_vl 'p1 'p2)
(setq P1_ (vlax-safearray->list p1)
P2_ (vlax-safearray->list p2)
P1_ (list (car P1_) (cadr P1_))
P2_ (list (car P2_) (cadr P2_))n 0
Dx (/ (- (car P2_) (car P1_)) step1)
Dy (/ (- (cadr P2_) (cadr P1_)) step1)
P> P1_
Lp (list P1_))
(repeat (* (1+ step1) step1)
(setq P> (list (+ (car P>) Dx) (cadr P>))
Lp (cons P> Lp)n (1+ n))
(if (= n step1)
(setq n 0
P1_ (list (car P1_) (+ (cadr P1_) Dy))
P> P1_
Lp (cons P> Lp))))
(cdr Lp))
(defun Point_int ( Lp list_vert_poly / P_distant n Pr cont attr p# Pa Pa_ Pb )
(setq P_distant (list (car (getvar "extmax")) (* 2 (cadr (getvar "extmax"))))
list_p_int nil)
(foreach Pr Lp
(setq cont -1
attr 0
Pa (nth (setq cont (1+ cont)) list_vert_poly)
Pa_ Pa)
(repeat(length list_vert_poly)
(setq Pb (nth (setq cont (1+ cont)) list_vert_poly))
(if (= cont (length list_vert_poly)) (setq Pb Pa_))
(if(inters Pa Pb Pr P_distant)(setq attr (1+ attr)))
(setq Pa Pb))
(if(>(rem attr 2)0)(setq list_p_int(cons Pr list_p_int))))
list_p_int)
(defun grid+ (list_p_int / G+)
(setq G+(mapcar '(lambda ( x ) (list (+ (car x) (/ Dx 2)) (+ (cadr x) (/ Dy 2)))) list_p_int)
list_p_int(append G+ list_p_int)))
(defun Point_center (list_p_int / Pa n Pvic)
(setq Dist 0.0000001)
(setq P_center nil)
(foreach Pa list_p_int
(setq Pvic (vlax-curve-getClosestPointTo POLY_vl Pa))
(if(>(distance Pa Pvic)Dist)
(setq Dist(distance Pa Pvic)P_center Pa)))
P_center)
(if(equal(type e)'LIST)(progn(makep e)(setq e1(entlast)))(setq e1 e))
(setq step1 50)
(setq step2 25)
(setq POLY_vl (vlax-ename->vla-object e1))
(setq list_vert_poly (LWPoly->List e1))
(setq lp(grid_1 POLY_vl step1))
(setq list_p_int(grid+(Point_int lp list_vert_poly)))
(setq p(Point_center list_p_int))
(if (equal(type e)'LIST)(entdel e1))
p)
多段线质心和相对内部点
如果要考虑线内和线外，CGAL是专门解决这个问题的
页:
[1]
2