表格内实体居中-讨论探讨

尘缘一生 · 发表于 2022-8-10 12:53:28

本帖最后由尘缘一生于 2022-8-11 20:04 编辑

本坛有不少这方面代码，然而，对其深入写代码起来时候，觉得实在力不从心，总做不到完美，下面贴上两个中间代码。

;;表格实体居中------------
(defun sl-bjz (/ wt)
(setq wt (ssget '((0 . "*TEXT,CIRCLE,ARC,ELLIPSE,DIMENSION,LEADER,INSERT,ATTDEF,TCH_ARROW,TCH_TEXT,TCH_DRAWINGNAME,TCH_MULTILEADER,TCH_ELEVATION,SPLINE"))))
(ss-bjz wt)
)
;;wt 表选择集居中支持所有实体--（一级）----
(defun ss-bjz (wt / nam plis plis1 ss n en ent pt0 p0 p01 dis pts tp a b c d)
(defun en-bjz (en) ;en 实体居中
(setq ent (entget en) tp (dxf1 en 0))
(setq plis (e-box4 en t) a (car plis) b (cadr plis) c (caddr plis) d (nth 3 plis))
(setq dis (* 0.05 (distance a d)))
(setq p01 (trans (polar (sl:mid d c) (angle a d) dis) 1 0));包容盒外一点
(setq pt0 (sl:mid a c)) ;实体中心
(if (member tp '("ELLIPSE" "CIRCLE")) ;先删除
(progn
(entdel en)
(ssdel en wt)
)
)
(if (setq nam (sl-bound p01 nil)) ; 边界形成
(progn
(if (member tp '("ELLIPSE" "CIRCLE")) (entmake ent))
(setq plis1 (e-box4 nam t) a (car plis1) c (caddr plis1))
(setq p0 (trans (sl:mid a c) 1 0)) ;单元格中心
(entdel nam)
(setq n (sslength (setq ss (ssget "W" a c))))
(if (> n 0)
(if (= n 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)) ;;差集
)
)
)
;-----------------------------------
(_undo1)
(repeat (setq n (sslength wt))
(setq en (ssname wt (setq n (1- n))) tp (dxf1 en 0))
(if (member tp '("ELLIPSE" "CIRCLE")) (en-bjz en))
)
(repeat (setq n (sslength wt))
(setq en (ssname wt (setq n (1- n))))
(en-bjz en)
)
(_undo2)
)

;;三领boundary----(一级)-----
;;k 误差值 nil slbl
(defun sl-bound (p0 k / e_lst ft en en1 en2 en3)
(setq ft
(vl-catch-all-apply
(function
(lambda ()
(setq e_lst (sysvar '("osmode" "cmdecho" "ORTHOMODE" "HPGAPTOL" "HPBOUND" "HPBOUNDRETAIN")))
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
(setvar "ORTHOMODE" 0)
(setvar "HPBOUND" 1) ;创建多段线 0创建面域
(setvar "HPBOUNDRETAIN" 1) ;根据 HPBOUND 系统变量创建边界对象 0不创建
(if (= k nil) (setq k slbl))
(setvar "HPGAPTOL" k)
(setq en1 (entlast))
(vl-cmdf "-boundary" "a" "o" "p" "" p0 "");生成多段线
(while (> (getvar "cmdactive") 0) (command "n"))
(setq en2 (entlast))
(bpoly p0)
(setq en3 (entlast))
(cond
((and (equal en2 en1) (equal en3 en1))
(setq en nil)
)
((and (not (equal en2 en1)) (equal en3 en1))
(setq en en2)
)
((and (not (equal en3 en1)) (equal en2 en1))
(setq en en3)
)
((and (not (equal en3 en1))
(not (equal en2 en1))
)
(setq en en2)
(entdel en3)
)
)
)
)
)
)
(mapcar 'eval e_lst)
(if (vl-catch-all-error-p ft) (setq en nil))
en
)

以上代码的基础，就是，采用 "-boundary" “poly” 做法，对表格不完全闭合情况，不甚完美

;;表格实体居中------------
(defun sl-bjz (/ wt en lis)
(setq wt (ssget '((0 . "*TEXT,CIRCLE,ARC,ELLIPSE,DIMENSION,LEADER,INSERT,ATTDEF,TCH_ARROW,TCH_TEXT,TCH_DRAWINGNAME,TCH_MULTILEADER,TCH_ELEVATION,SPLINE"))))
(ss-bjz wt)
)
;;从一个点求到某个方向最近线的距离---(一级)----
(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)
)
)
)
;;实体四周线格包容四角点、实体中点表----（一级）----
;;返回 (单元格左下单元格右下单元格右上单元格左上实体中心))
(defun enear4p (enam / plis p0 pz py ps px p1 p2 p3 p4)
(setq plis (ebox4 enam))
(setq p0 (sl:mid (car plis) (caddr plis)))
(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))
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)
)
(list p1 p2 p3 p4 p0)
)
;;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))))
(if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (setq pts (enear4p en))))))
(progn
(setq a (car pts) c (caddr pts))
(setq pt0 (nth 4 pts));实体中心
(setq p0 (sl:mid a c)) ;单元格中心
(setq i (sslength (setq ss (ssget "W" a c))))
(if (> i 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)
)

以上这段代码另辟蹊径，然而，测试发现，也不是太完美。这种方式的缺点就是：表格线不能是连续拐弯方式。

需要说明一点，由于涉及其他，这代码不能独立运行，相信高手们一看就知道函数的作用，本坛也能搜索到。

20060510412 · 发表于 2022-8-11 18:27:04

lxl217114 · 发表于 2022-8-10 14:51:55

http://bbs.mjtd.com/thread-181585-1-1.html
这个帖子的跟帖的那个居中还可以

尘缘一生 · 发表于 2022-8-10 16:01:55

lxl217114 发表于 2022-8-10 14:51
http://bbs.mjtd.com/thread-181585-1-1.html
这个帖子的跟帖的那个居中还可以

我仔细看过这个帖子，贴出来的代码都不行，贴出来的动画是可以的，但是，贴出来动画的，是没有放出源码的。

用我第二种方式，基本达到动画效果了。

lxl217114 · 发表于 2022-8-10 16:31:04

尘缘一生发表于 2022-8-10 16:01
我仔细看过这个帖子，贴出来的代码都不行，贴出来的动画是可以的，但是，贴出来动画的，是没有放出源码的 ...

跟帖的意思是2楼3楼不是楼主的意思。

20060510412 · 发表于 2022-8-10 22:45:56

请问动图中对应的代码是哪一段哦？看着效果已经很完美了。

尘缘一生 · 发表于 2022-8-10 23:15:25

本帖最后由尘缘一生于 2022-8-10 23:19 编辑

20060510412 发表于 2022-8-10 22:45
请问动图中对应的代码是哪一段哦？看着效果已经很完美了。

是第二种方式，又进行了修改，贴上

;;表格实体居中------------
(defun sl-bjz (/ wt en lis)
(setq wt (ssget '((0 . "*TEXT,CIRCLE,ARC,ELLIPSE,DIMENSION,LEADER,INSERT,ATTDEF,TCH_ARROW,TCH_TEXT,TCH_DRAWINGNAME,TCH_MULTILEADER,TCH_ELEVATION,SPLINE"))))
(ss-bjz wt)
)
;;从一个点求到某个方向最近线的距离---(一级)----
(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)
)
)
)
;;实体四周线框包容四角点、实体中点表----（一级）----
;;返回 (单元格左下单元格右下单元格右上单元格左上实体中心))
(defun enear4p (enam / plis p0 pz py ps px p1 p2 p3 p4)
(setq plis (ebox4 enam))
(setq p0 (sl:mid (car plis) (caddr plis)))
(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))
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)
)
(list p1 p2 p3 p4 p0)
)
;;wt 表选择集居中支持所有实体--（一级）----
(defun ss-bjz (wt / ss n i en pt0 p0 pts a c dis ang)
(_undo1)
(repeat (setq n (sslength wt))
(setq en (ssname wt (setq n (1- n))))
(if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (setq pts (enear4p en))))))
(progn
(setq a (car pts) c (caddr pts))
(setq pt0 (nth 4 pts));实体中心
(setq p0 (sl:mid a c)) ;单元格中心
(setq dis (* 0.99 (distance a c)) ang (angle a c));;修改此处，对角点进行1%缩小，涉及本行和下面两行
(setq c (polar a ang dis))
(setq a (polar c (+ ang pi) dis))
(setq i (sslength (setq ss (ssget "W" a c))))
(if (> i 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)
)

20060510412 · 发表于 2022-8-11 09:12:55

那个子函数ebox4，不知道是什么意思，猜不出来……

20060510412 · 发表于 2022-9-4 15:04:24

尘缘一生发表于 2022-8-10 23:15
是第二种方式，又进行了修改，贴上

您好，请问您还有highflybird分享的DynamicLisp源代码么？

尘缘一生 · 发表于 2022-9-5 06:52:46

20060510412 发表于 2022-9-4 15:04
您好，请问您还有highflybird分享的DynamicLisp源代码么？

你看是不是这个

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

表格内实体居中-讨论探讨

本帖子中包含更多资源

评分

本帖子中包含更多资源

评分

点评

点评

本帖子中包含更多资源