本帖最后由 WWYYBB1015 于 -12-16 21:04 编辑
根据大家的要求，更新一下修改标注文字引线的功能。插件会根据图框比例自动创建一个新的标注样式，例如：名称为机械标注5。找到代码：(setq dim (strcat "机械标注" (rtos tksc 2 0)))，将文字修改为自己需要的就行，另外由于标注的方式各种各样，很难统一。
所以mkdim子函数中的代码，可以根据自己的需要进行适当修改。今天不忙，花了大半天时间，做出来还是比较粗糙的，接下来会考虑
完善标注样式的创建和增加框选批量修改的功能。目前暂时主要只提供一个思路，也希望大佬能多指点指点。
(defun C:JC2 (/num entname 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)
)
LISP 圆孔标记_做了一个检查图框内字体和标注的插件 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
