669423907 发表于 2018-12-29 14:19:24

求助关于修改标注各元素的比例问题


如果选中了直径或半径标注,因为直径或半径标注没有尺寸界限线,所以程序就会出错。请大师帮忙改进一下,让程序自动适应各种标注,谢谢了

;修改标注各项比例
(defun c:13(/ k ss hh dimvla)
(vl-load-com)
(setq k 0)
(setq ss (ssget ":s" '((0 . "dimension"))))
;(setq hh (getdist "\n请输入标注字高:")) (setvar "dimtxt" hh)
(setq hh (getvar "dimtxt"))
(while (< k (sslength ss))
(setq dimvla (vlax-ename->vla-object (ssname ss k)))
(vla-put-ArrowheadSize dimvla (* hh 0.25))          ;箭头大小
(vla-put-TextGap dimvla (* hh 0.12))               ;文字与尺寸线的距离
(vla-put-ExtensionLineExtend dimvla (* hh 0.15));尺寸界限线超出尺寸线距离
(vla-put-ExtensionLineOffset dimvla (* hh 0.2))    ;尺寸界限线起点偏移量
(vla-put-TextHeight dimvla hh)
(setq k (1+ k)))
(command"zoom" "o"ss"" "zoom" "c"(getvar "viewctr")(*(getvar"viewsize")2));屏幕中点
(command"Select"ss""(sssetfirst nil ss))
(princ))

669423907 发表于 2018-12-29 17:38:04

在此非常感谢ZZXXQQ大神
(defun c:13(/ k ss hh dimvla)
(vl-load-com)
(setq k 0)
(setq ss (ssget ":s" '((0 . "DIMENSION"))))
;(setq hh (getdist "\n请输入标注字高:")) (setvar "dimtxt" hh)
(setq hh (getvar "dimtxt"))
(while (< k (sslength ss))
(setq dimvla (vlax-ename->vla-object (ssname ss k)))
(vla-put-ArrowheadSize dimvla (* hh 0.25))         ;箭头大小
(vla-put-TextGap dimvla (* hh 0.12))                     ;文字与尺寸线的距离
(setq ent (entget(ssname ss k)))
(if (not(or (member '(100 . "AcDbDiametricDimension") ent)
      (member '(100 . "AcDbRadialDimension") ent))) (progn
(vla-put-ExtensionLineExtend dimvla (* hh 0.15)) ;尺寸界限线超出尺寸线距离
(vla-put-ExtensionLineOffset dimvla (* hh 0.2))    ;尺寸界限线起点偏移量
))
(vla-put-TextHeight dimvla hh)
(setq k (1+ k)))
(command "zoom" "o" ss "" "zoom" "c"(getvar "viewctr")(*(getvar "viewsize")2));屏幕中点
(command "Select" ss "" (sssetfirst nil ss))
(princ)
)
页: [1]
查看完整版本: 求助关于修改标注各元素的比例问题