令人头疼的 bpoly boundary...，真的没办法吗？

尘缘一生 · 发表于 2023-7-6 21:52

本帖最后由尘缘一生于 2023-7-6 22:21 编辑

如题，探索这个问题，因为填充，表格居中什么的，要用它，希望能继续得到高手的指点，更好下去，
《三领设计》也需它的完美。。。

;;从一个点求到某个方向最近线的距离---(一级)----
(defun snearlin (pt ang / dis ss n obj lst)
(if (setq ss (ssget "f" (list pt (polar pt ang (getvar "viewsize"))) '((0 . "LINE,*P*LINE"))))
(progn
(repeat (setq n (sslength ss))
(setq obj (en2obj (ssname ss (setq n (1- n))))
dis (distance pt (vlax-curve-getclosestpointto obj pt t))
lst (cons dis lst)
)
)
(apply 'min lst)
)
)
)
;;三领boundary----(一级)-----
;;k 误差值 nil slbl
;;Modify 尘缘一生 QQ: 15290049
(defun sl-bound (p0 k / e_lst en en1 pts px py pz ps)
(setq e_lst (sysvar '("OSMODE" "ORTHOMODE" "HPGAPTOL" "HPBOUNDRETAIN")))
(setvar "OSMODE" 0)
(setvar "ORTHOMODE" 0)
(setvar "HPBOUNDRETAIN" 1) ;根据 HPBOUND 系统变量创建边界对象 0不创建
(if (= k nil) (setq k slbl)) ;slbl 为三领设计的比例常量，自理即可
(setvar "HPGAPTOL" k)
(setq en1 (entlast))
(vl-catch-all-apply 'bpoly (list p0)) ;;行不行，意在别中断能下去，然而，我严重怀疑
(setq en (entlast))
(if (not (equal en1 en))
(setq en (entlast))
(setq en nil)
)
(if (= en nil)
(progn
(vl-catch-all-apply '(lambda () (vl-cmdf "_boundary" p0 "")))
(setq en (entlast))
(if (and (not (equal en1 en)) (equal (dxf1 en 0) "lwpolyline"))
(setq en (entlast))
(setq en nil)
)
(mapcar 'eval e_lst)
)
)
(if (and
(= en nil)
(setq
pz (polar p0 pi (snearlin p0 pi))
py (polar p0 0 (snearlin p0 0))
ps (polar p0 pi2 (snearlin p0 pi2))
px (polar p0 3pi2 (snearlin p0 3pi2))
)
)
(progn
(setq
p1 (list (car pz) (cadr px) 0)
p2 (list (car py) (cadr px) 0)
p3 (list (car py) (cadr ps) 0)
p4 (list (car pz) (cadr ps) 0)
)
(makelwpolyline (list p1 p2 p3 p4) 0 t) ;闭合矩形函数，自理
(setq en (entlast))
)
)
;;(setq en (entlast))
(if (not (equal en1 en))
(setq en (entlast))
(setq en nil)
)
en
)
)

以下示例三领设计表格居中

;;wt 表选择集居中 --(一级)----
;;支持区隔内：所有实体
(defun ss-bjz (wt / ss n i en pt0 p0 pts a c)
(_undo1)
(repeat (setq n (sslength wt))
(setq en (ssname wt (setq n (1- n))) pt0 (e-mid en))
(entdel en) ;先删除
(if (setq nam (sl-bound pt0 nil))
(progn
(setq pts (e-box4 nam t))
(setq a (car pts) c (caddr pts) p0 (sl:mid a c))
(entdel nam)
)
)
(entdel en) ;再恢复
(if (and a c p0
(setq ss (ssget "W" a c))
(> (setq i (sslength ss)) 0)
)
(progn
(if (= i 1)
(vla-move (en2obj (ssname ss 0)) (vlax-3d-point pt0) (vlax-3d-point p0))
(progn
(setq pts (get-box ss) pt0 (sl:mid (car pts) (cadr pts)))
(command "MOVE" ss "" pt0 p0)
)
)
(setq wt (ssdiff wt ss))
)
)
)
(_undo2)
)

如果你画图纸的，能否驾驭三领？
永久下载地址：
链接：https://pan.baidu.com/s/1FTyLPKtQdJzkj3Ql6HzfSQ 提取码：uiz9

xcmdos · 发表于 2023-7-6 23:49

谢谢大神的分享

liuhe · 发表于 2023-7-7 10:40

你都没有动画演示或者图纸要干吗，只能看程序猜

lxl217114 · 发表于 2023-7-7 11:47

liuhe 发表于 2023-7-7 10:40
你都没有动画演示或者图纸要干吗，只能看程序猜

可能是大佬故意设置的门槛，哈哈

尘缘一生 · 发表于 2023-7-7 16:15

lxl217114 发表于 2023-7-7 11:47
可能是大佬故意设置的门槛，哈哈

没法演示这个，函数，
表格居中是应用例子。，

dcl1214 · 发表于 2023-7-7 21:24

去CGAL官网看看，有一个开源算法，专门处理面域的

meja · 发表于 2023-7-8 12:45

本帖最后由 meja 于 2023-7-8 15:29 编辑

就凭lisp，是无法实现大数据的bploy B的，国外的都是用arx来编制的

meja · 发表于 2023-7-8 12:47

文字居中类似的程序，一旦选取过多，会死机的

zwq8629 · 发表于 2023-7-8 14:04

谢谢大神的分享

春江在线 · 发表于 2024-1-13 22:21

顶一下!
参考了一下,整了一个晚上,也没有好的解决方案....
期待高手解决一下
都是矩形还好,有斜的咋整?

账号		自动登录	找回密码
密码			注册