大哥，你这程序真心坑人啊，很不稳定，第一个多变形同样操作生成点位不一样，后面两个则有不同操作生成点位一样，还有很多种情况生成的点在线上。
lhb7805 发表于 2014-9-27 10:38 static/image/common/back.gif
没有币，能发个吗
没币就别用了，不稳定。 很不错~~~~~~~~~~~~~ 谢谢楼主的分享，看看是不是我寻找的 大神告诉我，坐标值大了的情况下IntersectWith交点在顶点0.01范围内就会出错，所以会出现14楼那种错误，所以我在代码里加了一点修正。这个函数在测绘里还是很有用的！;;;求多边形内相对中心点
;;; 2012-11-15
;;; 感谢 辰 提供方法
;;; 感谢 学院派 指正
;;;by yanguangfei
(defun Get_center_relative (ename / 2R DelLine DistList i lst lst1 Mk Mkline N Newlst Number obj points Pt pt1 Pts R Tssbak Tssred TssSub)
(setq Obj (Vlax-Ename->Vla-Object ename)
Tssbak(Vlax-Get Obj 'Thickness )
TssSub(Vlax-Put Obj 'Thickness 0 )
)
(setq Pts (GetBoundingBox ename)
2R (MJ:MIDPOINT (CAR Pts) (CADR Pts))
Mk (entmake (list (cons 0 "LINE")(cons 8 "JMDSS")(cons 10 (polar 2R 0.0 1000))(cons 11 (polar 2R pi 1000))))
Mkline(entlast)
points(vlax-invoke (vlax-ename->vla-object ename) 'IntersectWith (vlax-ename->vla-object Mkline) acExtendOtherEntity)
Tssred(Vlax-Put Obj 'Thickness (eval Tssbak) )
DelLine (entdel Mkline)
i 0
lst nil
lst1 nil
)
(repeat (/ (length points) 3)
(setq lst (append lst (list (list (nth i points) (nth (1+ i) points) (nth (+ 2 i) points)))))
(setq i (+ i 3))
)
(foreach p1 lst;去掉vla-IntersectWith的bug
(setq pt1 (vlax-curve-getClosestPointTo ename p1))
(if (equal pt1 p1 1e-8)
(setq lst1 (append (list p1) lst1))
)
)
(setq lst (px lst1))
(if (>= (length lst) 4)
(progn
(setq N 0
Newlst nil)
(repeat (/ (length lst) 2)
(setq Newlst (append Newlst (list (list (nth N lst) (nth (1+ N) lst)))))
(setq N (+ 2 N))
)
(setq DistList nil
R 0)
(repeat (length Newlst)
(setq Number (nth R Newlst)
DistList (append DistList(list(distance (car Number) (cadr Number)))))
(setq R (1+ R))
)
(setqPt (nth (vl-position (car (vl-sort DistList '>)) DistList) Newlst))
(MJ:MIDPOINT (car pt) (cadr pt));返回值
)
(MJ:MIDPOINT (car lst) (cadr lst));返回值
)
)
轮回 发表于 2022-2-21 15:35
大神告诉我，坐标值大了的情况下IntersectWith交点在顶点0.01范围内就会出错，所以会出现14楼那种错误，所 ...
用了一下。提示：错误: 参数太少。不懂问题在哪
页:
1
[2]