Table调整列宽

/db_自贡黄明儒_ · 发表于 2017-10-13 11:08:22

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;调整列宽
(defun C:JustCW (/ E EN HEIGHT OBJ OBJTABLE SCALE SCOL SROW STYLENAME TEXTSTRING WIDTH WIDTH1)
(if (and
(setq e (entsel "\n 选取Table列:"))
(setq en (entget (car e)))
(= (cdr (assoc 0 en)) "ACAD_TABLE")
(setq ObjTable (vlax-ename->vla-object (cdr (assoc -1 en))))
(equal (vla-HitTest
ObjTable
(vlax-3d-point (cadr e))
(vlax-3d-point (getvar 'ViewDir))
'sRow
'sCol
)
:vlax-true
)
sRow
sCol
(setq e (nentselp (cadr e)))
(setq e (car e))
(setq en (entget e))
(= (cdr (assoc 0 en)) "MTEXT")
)
(progn
(setq Obj (vlax-ename->vla-object e))
(setq StyleName (vlax-get Obj 'StyleName))
(setq Width (vlax-get Obj 'Width))
(setq TextString (vlax-get Obj 'TextString))
(setq Height (vlax-get Obj 'Height))
(setq Width1 (HH:String:Len StyleName TextString Height 1.2))
(setq Width1 (abs (apply '- (mapcar 'car Width1))))
(setq scale (/ Width1 Width))
(vla-setColumnWidth ObjTable sCol Width1)
)
)
)

;;调整列宽 
(defun C:JustCW        (/ E EN HEIGHT OBJ OBJTABLE SCALE SCOL SROW STYLENAME TEXTSTRING WIDTH WIDTH1) 
  (if (and 
        (setq e (entsel "\n 选取Table列:")) 
        (setq en (entget (car e))) 
        (= (cdr (assoc 0 en)) "ACAD_TABLE") 
        (setq ObjTable (vlax-ename->vla-object (cdr (assoc -1 en)))) 
        (equal (vla-HitTest 
                 ObjTable 
                 (vlax-3d-point (cadr e)) 
                 (vlax-3d-point (getvar 'ViewDir)) 
                 'sRow 
                 'sCol 
               ) 
               :vlax-true 
        ) 
        sRow 
        sCol 
        (setq e (nentselp (cadr e))) 
        (setq e (car e)) 
        (setq en (entget e)) 
        (= (cdr (assoc 0 en)) "MTEXT") 
      ) 
    (progn 
      (setq Obj (vlax-ename->vla-object e)) 
      (setq StyleName (vlax-get Obj 'StyleName)) 
      (setq Width (vlax-get Obj 'Width)) 
      (setq TextString (vlax-get Obj 'TextString)) 
      (setq Height (vlax-get Obj 'Height)) 
      (setq Width1 (HH:String:Len StyleName TextString Height 1.2)) 
      (setq Width1 (abs (apply '- (mapcar 'car Width1)))) 
      (setq scale (/ Width1 Width)) 
      (vla-setColumnWidth ObjTable sCol Width1) 
    ) 
  ) 
)

游客，如果您要查看本帖隐藏内容请回复

zhaoyafei19 · 发表于 2017-10-13 13:22:58

不错，谢谢楼主

yshf · 发表于 2017-10-13 14:30:08

回复看看，学习学习

HLCAD · 发表于 2017-10-13 17:59:03

感谢黄大师分享程序

lucas3 · 发表于 2017-10-13 21:28:31

直接拖拉不可以么？

/db_自贡黄明儒_ · 发表于 2017-10-13 21:53:10

lucas3 发表于 2017-10-13 21:28

excel也有拽拖功能，也有autofit功能，但table没有

q3_2006 · 发表于 2017-10-14 06:11:57

TABLE操作代码很少..学习了..

sicky111 · 发表于 2017-10-14 23:00:59

谢谢分享。

liunian0524 · 发表于 2017-10-16 08:08:25

感谢大师新作分享

ray7891 · 发表于 2017-10-16 09:56:54

学习学习

qyming2000 · 发表于 2019-1-7 17:21:03

学习

naruto018 · 发表于 2019-1-8 08:17:37

来学习一下

pengfei2010 · 发表于 2019-1-8 08:44:37

学习一下

455383153 · 发表于 2019-3-31 21:35:04

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

[每日一码] Table调整列宽

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。