论坛 › A/VLISP › Table调整列宽

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

Table调整列宽

;;调整列宽
(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)
    )
)
)
**** Hidden Message *****

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

不错，谢谢楼主

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

回复看看，学习学习{:1_12:}

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

学习学习{:1_12:}{:1_12:}{:1_12:}

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

学习         

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

来学习一下

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

学习一下{:1_12:}{:1_12:}

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

最近研究表格            

cyfdean 发表于 2019-6-28 13:59:56

回复看看，学习学习

查看完整版本: Table调整列宽