做了一个检查图框内字体和标注的插件
本帖最后由 WWYYBB1015 于 2019-12-16 21:04 编辑根据大家的要求，更新一下修改标注文字引线的功能。插件会根据图框比例自动创建一个新的标注样式，例如：名称为机械标注5。找到代码：(setq dim (strcat "机械标注" (rtos tksc 2 0)))，将文字修改为自己需要的就行，另外由于标注的方式各种各样，很难统一。
所以mkdim子函数中的代码，可以根据自己的需要进行适当修改。今天不忙，花了大半天时间，做出来还是比较粗糙的，接下来会考虑
完善标注样式的创建和增加框选批量修改的功能。目前暂时主要只提供一个思路，也希望大佬能多指点指点。
(defun C:JC2 (/ num ent name h_txt col_1 col_2col_3
zg tk tkname tksc acdoc mspace dimssdim
obj minext maxext ptzx ptys tz i
)
(setvar "cmdecho" 0)
(vl-cmdf "undo" "be")
;;定义子函数
(defun dxf (num ent) (assoc num (entget ent)))
(defun mkdim (name h_txt col_1 col_2 col_3)
(entmake (list '(0 . "DIMSTYLE")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbDimStyleTableRecord")
'(70 . 0)
(cons 340 (tblobjname "style" "Arial")) ; 文字样式名
(cons 2 name) ; 标注样式名
'(3 . "") ; 标注前缀
'(40 . 0.0) ; 标注特征比例，缩放到布局
'(41 . 2.5) ; 箭头尺寸
'(42 . 1.5) ; 起点偏移量
'(43 . 5.5) ; 基线间距
'(44 . 1.5) ; 超出尺寸线
'(47 . 0.000) ; 上偏差
'(48 . 0.000) ; 下偏差
'(71 . 0) ; 公差无
'(77 . 1) ; 文字在尺寸线上方
'(74 . 1) ;
(cons 140 h_txt) ; 文字高度
'(141 . -2.5) ; 圆心标记
'(144 . 1.0) ; 测量比例单位
'(146 . 0.7) ; 公差高度比例
'(147 . 1.0) ; 文字从尺寸线偏移
'(172 . 2) ; 尺寸界线间连线
(cons 176 col_1) ; 标注引线颜色随层
(cons 177 col_2) ; 尺寸界线随层
(cons 178 col_3) ; 文字颜色黄色
'(271 . 3) ; 尺寸标注精度
'(272 . 3) ; 公差标注精度
'(275 . 0) ; 角度标注制式，十进制。
'(288 . 1) ; 手动放置尺寸
)
)
)
;;(mkdim 标注名称 字高 颜色1 颜色2 颜色3)
;;设置默认字高
(setq zg (getreal "\n指定字高，默认为<3>"))
(if (not zg)
(setq zg 3)
)
;;点选图块获得块名和块比例
(setq tk (entsel "\n点选图块确定图纸类型"))
(setq tkname (cdr (assoc 2 (entget (car tk)))))
(setq tksc (cdr (assoc 41 (entget (car tk)))))
;;查找当前标注样式符号表并创建不存在的标注
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq mspace (vla-get-modelspace acdoc))
(setq dimss (vla-get-DimStyles acdoc))
(setq dim (strcat "机械标注" (rtos tksc 2 0)))
(mkdim dim (* zg tksc) 1 1 2)
(if (/= (vlax-for obj dimss (vla-get-name obj)) dim)
(mkdim dim (* zg tksc) 1 1 2)
)
;;修改图纸文字标注引线比例
(vla-GetBoundingBox
(vlax-ename->vla-object (car tk))
'minext
'maxext
)
(setq ptzx (vlax-safearray->list minext)
ptys (vlax-safearray->list maxext)
)
(command "zoom" "w" ptys ptzx)
(setq tz (ssget "_w" ptys ptzx '((0 . "TEXT,DIMENSION,LEADER"))))
(setq i 0)
(while (< i (sslength tz))
(setq obj (vlax-ename->vla-object (ssname tz i)))
(cond ((equal (dxf 0 (ssname tz i)) '(0 . "TEXT"))
(vla-put-height obj (* zg tksc))
)
((equal (dxf 0 (ssname tz i)) '(0 . "DIMENSION"))
(vla-put-stylename obj dim)
)
((equal (dxf 0 (ssname tz i)) '(0 . "LEADER"))
(vla-put-stylename obj dim)
)
(t nil)
)
(setq i (1+ i))
)
;(vl-cmdf "undo" "e")
(princ)
)
;; 简单优化了一下
(defun c:JC ()
(defun dxf (code e) (cdr (assoc code (entget e))))
(setq tk (car (entsel "\n点选图框: ")))
(setq sc (DXF 41 tk))
(vla-GetBoundingBox (vlax-ename->vla-object tk) 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
ss (ssget "w" p1 p2 '((0 . "TEXT,DIMENSION")))
i-1
wz 0
bz 0
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq ob (vlax-ename->vla-object s1))
(if (equal (DXF 0 s1) "TEXT")
(if (> (abs (- (DXF 40 s1) (* 3 sc))) 0.02)
(progn
(entmod (subst (cons 40 (* 3 sc))(assoc 40 (entget s1))(entget s1)))
(setq wz (+ 1 wz))
)
)
(if (/= (vla-get-ScaleFactor ob) sc)
(progn
(vla-put-TextColor ob acgreen)
(setq bz (+ 1 bz))
)
)
)
)
(princ (strcat "发现并修改" (itoa wz)"个异常文字," (itoa bz)"个异常标注"))
(princ)
) 这个版本的可以框选图纸，但是只识别块名为“TK-JG-A4”的图纸，可以自己修改对于楼上的建议，因为这次插件在这之前就做好了，就懒得改了，以后的程序会借鉴这种方法。
;;检查单个图框内文字和标注，修改文字并标出异常标注
(defun jc1 (tk / attlst tkname tksc minext maxext ptzx ptys ss i wz bz)
(setq attlst (vlax-safearray->list (vlax-variant-value (vla-getattributes (vlax-ename->vla-object tk)))))
(setq tkname (vla-get-TextString (nth 2 attlst)))
(setq tksc (cdr (assoc '41 (entget tk))))
(vla-GetBoundingBox (vlax-ename->vla-object tk) 'minext 'maxext)
(setq ptzx (vlax-safearray->list minext)
ptys (vlax-safearray->list maxext))
(command "zoom" "w" ptys ptzx)
(setq ss (ssget "_w" ptys ptzx '((0 . "TEXT,DIMENSION"))))
(setq i 0 wz 0 bz 0)
(while (< i (sslength ss))
(if (equal (assoc '0 (entget (ssname ss i)))'(0 . "TEXT"))
(progn
(if (> (abs (- (cdr (assoc '40 (entget (ssname ss i)))) (* 3 tksc))) 0.02)
(progn
(vla-put-Color (vlax-ename->vla-object (ssname ss i)) acgreen)
(setq wz (+ 1 wz))))
(setq i (+ 1 i)))
(progn
(if (/= (vla-get-ScaleFactor (vlax-ename->vla-object (ssname ss i))) tksc)
(progn
(vla-put-TextColor (vlax-ename->vla-object (ssname ss i)) acgreen)
(setq bz (+ 1 bz))))
(setq i (+ 1 i)))
)
)
(if (and (= wz 0) (= bz 0))
(princ (strcat "\n" tkname "文字及标注的比例正常"))
(progn
(princ (strcat "\n" tkname "发现" (itoa wz) "个异常文字,发现" (itoa bz) "个异常标注"))
(entmake (list '(0 . "LINE") (cons '10 ptys) (cons '11 ptzx))))
))
;;检查单个图框内文字和标注，修改文字并标出异常标注
(defun c:JC(/ tkss i)
(setvar "cmdecho" 0)
(command "undo" "be")
(setq tkss (ssget '((0 . "insert") (2 . "TK-JG-A4"))))
(setq i 0)
(while (< i (sslength tkss))
(jc1 (ssname tkss i))
(setq i (+ 1 i)))
(command "undo" "e")
(princ))
异常标注能自动处理就更完美了 谢谢分享，下载试用 xyp1964 发表于 2019-10-13 18:52
;; 简单优化了一下
这个子函数，值得借鉴，整个程序现在看着比较有条理，比较简洁。 已经做好了一个可以批量修改字体并标记标注的版本了，把上面的程序作为子函数引用。代码不在这个电脑里，明天可以上传。 bai2000 发表于 2019-10-13 19:42
异常标注能自动处理就更完美了
正在想解决办法，有两种思路。
第一种，读取所有图纸的比例，按照比例的种类，用entmake创建一系列标准标注，再把异常标注刷成该格式。
第二种，手动建一个标注模板，不打开图纸引用模板里的标注，再把所有标注按照该模板刷一遍。
但目前还不会不打开图纸引用，也不熟悉entmake创建标注，只能慢慢研究了。 xyp1964 发表于 2019-10-13 18:52
;; 简单优化了一下
院长最近很活跃啊 来学习一下，试用一下，感谢楼主分享