令人头疼的 bpoly boundary...，真的没办法吗？
本帖最后由 尘缘一生 于 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))
[*] (setqobj (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
{:1_1:}谢谢大神的分享 你都没有动画演示或者图纸要干吗，只能看程序猜:L liuhe 发表于 2023-7-7 10:40
你都没有动画演示或者图纸要干吗，只能看程序猜
可能是大佬故意设置的门槛，哈哈 lxl217114 发表于 2023-7-7 11:47
可能是大佬故意设置的门槛，哈哈
没法演示这个，函数，
表格居中是应用例子。， 去CGAL官网看看，有一个开源算法，专门处理面域的 本帖最后由 meja 于 2023-7-8 15:29 编辑
就凭lisp，是无法实现大数据的bploy B的，国外的都是用arx来编制的 文字居中类似的程序，一旦选取过多，会死机的 谢谢大神的分享 顶一下!
参考了一下,整了一个晚上,也没有好的解决方案....
期待高手解决一下
都是矩形还好,有斜的咋整?
页:
[1]