做了一个检查图框内字体和标注的插件

WWYYBB1015 · 发表于 2019-10-13 12:45:40

本帖最后由 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_2 col_3
 zg tk tkname tksc acdoc mspace dimss dim
 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 (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)
)

xyp1964 · 发表于 2019-10-13 18:52:41

;; 简单优化了一下

(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)
)

(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) 
)

WWYYBB1015 · 发表于 2019-10-15 12:17:54

这个版本的可以框选图纸，但是只识别块名为“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 ( (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))

bai2000 · 发表于 2019-10-13 19:42:10

异常标注能自动处理就更完美了

sunny_8848 · 发表于 2019-10-13 20:24:38

谢谢分享，下载试用

WWYYBB1015 · 发表于 2019-10-14 21:33:29

xyp1964 发表于 2019-10-13 18:52
;; 简单优化了一下

这个子函数，值得借鉴，整个程序现在看着比较有条理，比较简洁。

WWYYBB1015 · 发表于 2019-10-14 21:38:09

已经做好了一个可以批量修改字体并标记标注的版本了，把上面的程序作为子函数引用。代码不在这个电脑里，明天可以上传。

WWYYBB1015 · 发表于 2019-10-14 21:44:50

bai2000 发表于 2019-10-13 19:42
异常标注能自动处理就更完美了

正在想解决办法，有两种思路。
第一种，读取所有图纸的比例，按照比例的种类，用entmake创建一系列标准标注，再把异常标注刷成该格式。
第二种，手动建一个标注模板，不打开图纸引用模板里的标注，再把所有标注按照该模板刷一遍。
但目前还不会不打开图纸引用，也不熟悉entmake创建标注，只能慢慢研究了。

cghdy · 发表于 2019-10-15 08:43:43

xyp1964 发表于 2019-10-13 18:52
;; 简单优化了一下

院长最近很活跃啊

海盗曹 · 发表于 2019-10-15 10:54:44

来学习一下，试用一下，感谢楼主分享

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

[基础] 做了一个检查图框内字体和标注的插件

本帖子中包含更多资源

评分

本帖子中包含更多资源

浏览过的版块