[原创]求取复线中一点座标,不用面域法!!!

舟自横

(defun hy_polyinp(polys / poly1 p1 p2 anglep1 anglep2 line dist1 needpoint
pointlist basedis nedis shpoint yourpoint line frontpoint
backpoint)
;;;;;;;;;;;;取封闭復线内一点..........已完善.......
(setvar "osmode" 0)
(command "udo" "be")
(command "ucs" "w")
(setq key 0)
(hy_polyinp_1 polys)
(if (and frontpoint backpoint)
(progn
(setq angle1 (angle needpoint frontpoint)
angle2 (angle needpoint backpoint))
(while (or (equal angle1 anglep1 0.00001)
(equal angle2 anglep1 0.00001))
(vla-delete (vlax-ename->vla-object line))
(command "._rotate" polys "" '(0 0 0) 15.0)
(hy_polyinp_1 polys)
(setq key (1+ key))
)
)
);;;;;;;;;判断是否有角度与BOX对角一致如果一致转过15度重新计算
(foreach item (hy_interpoint line polys)
(if (equal needpoint item 0.00001)
(setq pointlist(vl-remove item (hy_interpoint line polys)))
)
)
(setq basedis (distance needpoint (nth 0 pointlist)))
(foreach item pointlist
(if (<= (setq nedis (distance needpoint item)) basedis)
(progn (setq basedis nedis)
(setq shpoint item))
)
)
(setq yourpoint (list (/ (+ (car needpoint) (car shpoint)) 2)
(/ (+ (cadr needpoint) (cadr shpoint)) 2)
0)
)
(vla-delete (vlax-ename->vla-object line))
(if (/= 0 key) (progn (command "._rotate" polys "" '(0 0 0) (* key -15.0))
(setq yourpoint (polar '(0 0 0) (- (angle '(0 0 0) yourpoint)
(* (/ (* key 15.0) 180) pi))
(distance '(0 0 0) yourpoint)
)
))
)
(command "undo" "e")
yourpoint
)
(defun hy_polyinp_1(poly / poly1 io)
(setq poly1 (vlax-ename->vla-object poly))
(vla-getboundingbox poly1 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
anglep1 (angle p1 p2)
anglep2 (angle p2 p1)
p1 (polar p1 anglep2 5)
p2 (polar p2 anglep1 5))
(command "line" p1 p2 "")(setq line (entlast))
(command "trim" poly "" (list line p1) "")
(setq line (entlast))
(setq dist1 (vla-get-length (vlax-ename->vla-object line)))
(setq needpoint (polar p2 anglep2 dist1))
(setq io 0)
(setq ptlist (hy_polpoint poly))
(setq frontpoint nil backpoint nil)
(repeat (length ptlist)
(if (equal needpoint (hy_2d->3d(nth io ptlist)) 0.00001)
(if (and (/= io 0) (/= io (1- (length ptlist))))
(setq frontpoint (hy_2d->3d(nth (1- io) ptlist))
backpoint (hy_2d->3d(nth (1+ io) ptlist))
)
(progn (if (= io 0)
(setq frontpoint (hy_2d->3d(last ptlist))
backpoint (hy_2d->3d(nth (1+ io) ptlist))
))
(if (= io (1- (length ptlist)))
(setq frontpoint (hy_2d->3d(nth (1- io) ptlist))
backpoint (hy_2d->3d(car ptlist))
))
)
)
)
(setq io (1+ io))
);;;判断needpoint是否是復线的一个顶点如果是求得前后点的坐标
)
(defun hy_2d->3d(point)
(vlax-safearray->list
(vlax-variant-value
(vlax-3d-point point))
)
)

(defun hy_interpoint(object1 object2 / jdtb);;返回两图元交点
(vl-load-com)
(setq jdtb (vla-intersectwith (vlax-ename->vla-object object1) (vlax-ename->vla-object object2) acExtendnone))
(setq jdtb (vlax-safearray->list (vlax-variant-value jdtb)))
(hy_ocom jdtb 3)
)
(defun hy_polpoint(object / endata i endata_li)
(setq point_list '())
(setq endata (entget object))
(setq i 0)
(while (< i (length endata))
(setq endata_li (nth i endata))
(if (= (car endata_li) 10) (setq point_list (cons (cdr endata_li) point_list)))
(setq i (1+ i))
)
(setq point_list (reverse point_list))
)
(defun hy_ocom(totlist num / needlist shuldlist numer stay);;处理数据列表分组每一组为NUM个,余项也为组
;;FOR EXCAMPLE: (hy_ocom '(-64.4309 100.541 0.0 -106.992 144.345 0.0 1 2) 3)
;;return : ((-106.992 144.345 0.0) (-64.4309 100.541 0.0) (1 2))
(setq needlist totlist)
(setq shuldlist nil)
(if (> (length totlist) num)
(progn
(setq stay (rem (length totlist) num))
(setq numer (/ (- (length totlist) stay) num))
(repeat numer
(setq shuldlist (cons (hy_ijlist needlist 0 num) shuldlist))
(setq needlist (hy_ijlist needlist (- num 1) nil))
)
(setq shuldlist (reverse shuldlist))
(if (/= stay 0) (setq remlist (reverse(hy_ijlist (reverse totlist) 0 stay))
shuldlist (append shuldlist (list remlist))))
shuldlist
)
nil)
)
(defun hy_ijlist(lst i j);;;取得列表从i开始以后j数量的片段表如果j为nil则取出i以后的列表从0开始
(setq aplist '())
(if (= j nil)
(repeat (+ i 1)
(setq lst (cdr lst))
(setq aplist lst))
(progn
(repeat j
(setq aplist (cons (nth i lst) aplist))
(setq i (1+ i))
)
(setq aplist (reverse aplist))
)
)
aplist
)