明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 3404|回复: 30

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

[复制链接]
发表于 2019-10-13 12:45 | 显示全部楼层 |阅读模式
本帖最后由 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 (< 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)
)







本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 3明经币 +3 收起 理由
BaoWSE + 1 赞一个!
donghuidong2003 + 1 很给力!
xyp1964 + 1 赞一个!

查看全部评分

发表于 2019-10-13 18:52 | 显示全部楼层
;; 简单优化了一下
  1. (defun c:JC ()
  2.   (defun dxf (code e) (cdr (assoc code (entget e))))
  3.   (setq tk (car (entsel "\n点选图框: ")))
  4.   (setq sc (DXF 41 tk))
  5.   (vla-GetBoundingBox (vlax-ename->vla-object tk) 'p1 'p2)
  6.   (setq p1 (vlax-safearray->list p1)
  7.         p2 (vlax-safearray->list p2)
  8.         ss (ssget "w" p1 p2 '((0 . "TEXT,DIMENSION")))
  9.         i  -1
  10.         wz 0
  11.         bz 0
  12.   )
  13.   (while (setq s1 (ssname ss (setq i (1+ i))))
  14.     (setq ob (vlax-ename->vla-object s1))
  15.     (if        (equal (DXF 0 s1) "TEXT")
  16.       (if (> (abs (- (DXF 40 s1) (* 3 sc))) 0.02)
  17.         (progn
  18.           (entmod (subst (cons 40 (* 3 sc))(assoc 40 (entget s1))(entget s1)))
  19.           (setq wz (+ 1 wz))
  20.         )
  21.       )
  22.       (if (/= (vla-get-ScaleFactor ob) sc)
  23.         (progn
  24.           (vla-put-TextColor ob acgreen)
  25.           (setq bz (+ 1 bz))
  26.         )
  27.       )
  28.     )
  29.   )
  30.   (princ (strcat "发现并修改" (itoa wz)"个异常文字," (itoa bz)"个异常标注"))
  31.   (princ)
  32. )
回复 支持 2 反对 0

使用道具 举报

 楼主| 发表于 2019-10-15 12:17 | 显示全部楼层
这个版本的可以框选图纸,但是只识别块名为“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))

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2019-10-13 19:42 | 显示全部楼层
异常标注能自动处理就更完美了
发表于 2019-10-13 20:24 | 显示全部楼层
谢谢分享,下载试用
 楼主| 发表于 2019-10-14 21:33 | 显示全部楼层
xyp1964 发表于 2019-10-13 18:52
;; 简单优化了一下

这个子函数,值得借鉴,整个程序现在看着比较有条理,比较简洁。
 楼主| 发表于 2019-10-14 21:38 | 显示全部楼层
已经做好了一个可以批量修改字体并标记标注的版本了,把上面的程序作为子函数引用。代码不在这个电脑里,明天可以上传。
 楼主| 发表于 2019-10-14 21:44 | 显示全部楼层
bai2000 发表于 2019-10-13 19:42
异常标注能自动处理就更完美了

正在想解决办法,有两种思路。
第一种,读取所有图纸的比例,按照比例的种类,用entmake创建一系列标准标注,再把异常标注刷成该格式。
第二种,手动建一个标注模板,不打开图纸引用模板里的标注,再把所有标注按照该模板刷一遍。
但目前还不会不打开图纸引用,也不熟悉entmake创建标注,只能慢慢研究了。
发表于 2019-10-15 08:43 | 显示全部楼层
xyp1964 发表于 2019-10-13 18:52
;; 简单优化了一下

院长最近很活跃啊
发表于 2019-10-15 10:54 | 显示全部楼层
来学习一下,试用一下,感谢楼主分享
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-4-25 00:26 , Processed in 0.331322 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表