本帖最后由 尘缘一生 于 2026-1-10 11:05 编辑

对于表格居中，本坛代码不少，但是满足要求却很难，
那么表格哪，里面可能各种实体，它并不一定仅是文字，表格的画法也不一定是直线，还有可能是多段线，多于两点的多段线，等等，
那么三领哪，力求一种框选表格，实现里面每个格中实体居中的办法，注意：是格中实体作为一个集合居中即可了
一直使用，一直不断修改，似乎完美达到要求，还很漫长的探索......
代码如下：期待高手进一步完善了，
  2. ;;表格实体居中------
  3. (defun sl-bjz (/ wt)
  4.   (if (setq wt (ssget '((0 . "*TEXT,CIRCLE,ARC,ELLIPSE,DIMENSION,LEADER,INSERT,ATTDEF,TCH_ARROW,TCH_TEXT,TCH_DRAWINGNAME,TCH_MULTILEADER,TCH_ELEVATION,SPLINE"))))
  5.     (ss-bjz wt)
  6.   )
  7. )
  8. ;三领设计功能代码原理展示
  9. ;Modify By SLdesign V3.0 尘缘一生 QQ:15290049
  10. ;;s1 框选(整体表格选择集)居中--注意：需排除了*P*LINE线类选择--(一级)----
  11. (defun ss-bjz (s1 / elis tp n d en p0 p1 p11 p13 pts pls ss nam obj)
  12.   (_undo1)
  13.   (setq elis (ss-enlst s1)) ;选择集转表
  14.   (while (setq en (car elis))
  15.     (setq tp (cdr (assoc 0 (entget en))))
  16.     (cond
  17.       ((= tp "CIRCLE")
  18.         (setq d (/ (vlax-curve-getdistatparam en (vlax-curve-getendparam en)) 30) pts nil n -1)
  19.         (repeat 31
  20.           (setq n (1+ n) pts (cons (vlax-curve-getpointatdist (vlax-ename->vla-object en) (* d n)) pts))
  21.         )
  22.       )
  23.       ((= tp "ELLIPSE")
  24.         (earc->pline en)
  25.         (setq pts (get-pl-pt (entlast)))
  26.       )
  27.       (t
  28.         (setq pts (slget-enbox en))
  29.         (entdel en)
  30.         (if (setq nam (sl-bound (mapcar '(lambda (x y) (* (+ x y) 0.5)) (car pts) (cadr pts))))
  31.           (progn
  32.             (setq pts (get-pl-pt nam))
  33.             (entdel nam)
  34.           )
  35.         )
  36.         (entdel en)
  37.       )
  38.     )
  39.     (if pts
  40.       (progn
  41.         (setq p0 (mapcar '(lambda (x y) (* (+ x y) 0.5)) (apply 'mapcar (cons 'min pts)) (apply 'mapcar (cons 'max pts))))
  42.         (setq ss (ssget "WP" pts))
  43.         (if (and ss (> (sslength ss) 0))
  44.           (progn
  45.             (setq n -1)
  46.             (while (setq nam (ssname ss (setq n (1+ n)))) (if (not (ssmemb nam s1)) (ssdel nam ss)))
  47.             (setq n (sslength ss))
  48.             (cond
  49.               ((= n 1)
  50.                 (setq obj (vlax-ename->vla-object (setq nam (ssname ss 0))))
  51.                 (vla-getboundingbox obj 'p11 'p13)
  52.                 (setq p11 (vlax-safearray->list p11) p13 (vlax-safearray->list p13))
  53.                 (setq p1 (mapcar '(lambda (x y) (* (+ x y) 0.5)) p11 p13))
  54.                 (if (> (distance p1 p0) 0.01) (vla-move obj (vlax-3d-point p1) (vlax-3d-point p0)))
  55.               )
  56.               ((> n 1)
  57.                 (setq pls (get-ssbox ss) p1 (mapcar '(lambda (x y) (* (+ x y) 0.5)) (car pls) (cadr pls))) (if (> (distance p1 p0) 0.01) (sl:move ss p1 p0))
  58.               )
  59.             )
  60.             (setq n -1)
  61.             (while (setq nam (ssname ss (setq n (1+ n))))
  62.               (if (member (cdr (assoc 0 (entget nam))) '("ELLIPSE" "CIRCLE"))
  63.                 (setq elis (append elis (list nam)))
  64.                 (vl-remove nam elis)
  65.               )
  66.             )
  67.           )
  68.         )
  69.       )
  70.     )
  71.     (setq elis (cdr elis))
  72.   )
  73.   (_undo2)
  74. )
SLdesign V3.0  三领设计下载如下：
通过网盘分享的文件：三领设计 V3.0
链接: https://pan.baidu.com/s/1UAWlIANHP1Vb9ICG0ZuPdA?pwd=8tny 提取码: 8tny
GIF不难看出，代码尚有个别区格失败了，^_^


网友答: 赞，这个功能非常不错

网友答: 学习了，线条表格也遇到了这个问题，一直遗留到现在，总算有个领路的了

网友答: 挺好的了，表格用的比较少
  • 上一篇：【Gu_xl】基于方位角计算的拓扑多边形自动构建快
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025