这是一个刷标注的插件,布局图中只刷标注和文字,有些问题,能帮忙改一下
我先说这个插件的用法,在布局图中只刷标注和文字,相当于你重新套视口,以前的标注就在这视口不一样的大小,用法就是在视口中随便出一个标注,用插件命令就能刷视口所有标注和文字。自动就能匹配视口大小。就是有些问题,刷了以后自动给你生成一个标注替代,造成后续标注都是一样大。能帮忙改一下不然它生成一个替代。 也可以用格式刷,但就是格式刷会把图形,标注,文字把全部都刷了。我就想刷标注。以下是源代码(DEFUN C:DUU (/ BlkElist@ BlkEname^ BlkEntList@ BlkEntName^ BlkList@ Cnt#
DimStyle@ DimTad# DimValue DimVarDxf# EndLen# EndList@ EntName^ EntName1^
EntList@ EntType$ Font$ Num# OSmode# SSet& StyHeight~ TextHeight~
);variables
(setq OSmode# (getvar "osmode"))
(setvar "cmdecho" 0)(setvar "regenmode" 1)***
(setq EntName1^ (car (entsel "必须选择标注样式,再刷需要匹配的标注样式和文字!: ")))
(if EntName1^
(setq EntList@ (entget EntName1^ (list "*"))
EntType$ (cdr (assoc 0 EntList@))
EndList@ (last EntList@)
);setq
);if
(if (= EntType$ "DIMENSION")
(progn
(redraw EntName1^ 3)
(setq BlkEntName^
(cdr (assoc -2 (tblsearch "BLOCK" (cdr (assoc 2 EntList@)))))
);setq
(while (setq BlkEntName^ (entnext BlkEntName^))
(setq BlkEntList@ (entget BlkEntName^))
(if (= (cdr (assoc 0 BlkEntList@)) "MTEXT")
(setq TextHeight~ (cdr (assoc 40 BlkEntList@)))
);if
);while
(command ".DIMSTYLE" "R" (cdr (assoc 3 EntList@)))
(setq DimStyle@ (tblsearch "STYLE" (getvar "DIMTXSTY")))
(command ".TEXTSIZE" TextHeight~)
(if (/= (cdr (assoc 40 (tblsearch "STYLE" (cdr (assoc 3 EntList@))))) 0)
(command ".STYLE" (cdr(assoc 3 EntList@)) "" TextHeight~ "" "" "" "" "")
);if
(command ".LAYER" "S" (cdr (assoc 8 EntList@)) "")
(if (= (car EndList@) -3)
(progn
(setq EndList@ (nth 1 EndList@)
EndLen# (/ (length EndList@) 2)
Num# 1
);setq
(repeat EndLen#
(if (= (type (nth Num# EndList@)) 'LIST)
(if (= (car (nth Num# EndList@)) 1070)
(if (or (= (car (nth (1+ Num#) EndList@)) 1040)
(= (car (nth (1+ Num#) EndList@)) 1070)
);or
(progn
(setq DimVarDxf# (cdr (nth Num# EndList@))
DimValue (cdr (nth (1+ Num#) EndList@))
);setq
(cond
( (= DimVarDxf# 3)(setvar "DIMPOST" DimValue))
( (= DimVarDxf# 4)(setvar "DIMAPOST"DimValue))
( (= DimVarDxf# 5)(setvar "DIMBLK"DimValue))
( (= DimVarDxf# 6)(setvar "DIMBLK1" DimValue))
( (= DimVarDxf# 7)(setvar "DIMBLK2" DimValue))
( (= DimVarDxf# 40) (setvar "DIMSCALE"DimValue))
( (= DimVarDxf# 41) (setvar "DIMASZ"DimValue))
( (= DimVarDxf# 42) (setvar "DIMEXO"DimValue))
( (= DimVarDxf# 43) (setvar "DIMDLI"DimValue))
( (= DimVarDxf# 44) (setvar "DIMEXE"DimValue))
( (= DimVarDxf# 45) (setvar "DIMRND"DimValue))
( (= DimVarDxf# 46) (setvar "DIMDLE"DimValue))
( (= DimVarDxf# 47) (setvar "DIMTP" DimValue))
( (= DimVarDxf# 48) (setvar "DIMTM" DimValue))
( (= DimVarDxf# 71) (setvar "DIMTOL"DimValue))
( (= DimVarDxf# 72) (setvar "DIMLIM"DimValue))
( (= DimVarDxf# 73) (setvar "DIMTIH"DimValue))
( (= DimVarDxf# 74) (setvar "DIMTOH"DimValue))
; Ignore suppressing extension lines
; ( (= DimVarDxf# 75) (setvar "DIMSE1"DimValue))
; ( (= DimVarDxf# 76) (setvar "DIMSE2"DimValue))
( (= DimVarDxf# 77) (setvar "DIMTAD"DimValue))
( (= DimVarDxf# 78) (setvar "DIMZIN"DimValue))
( (= DimVarDxf# 140)(setvar "DIMTXT"DimValue))
( (= DimVarDxf# 141)(setvar "DIMCEN"DimValue))
( (= DimVarDxf# 142)(setvar "DIMTSZ"DimValue))
( (= DimVarDxf# 143)(setvar "DIMALTF" DimValue))
( (= DimVarDxf# 144)(setvar "DIMLFAC" DimValue))
( (= DimVarDxf# 145)(setvar "DIMTVP"DimValue))
( (= DimVarDxf# 146)(setvar "DIMTFAC" DimValue))
( (= DimVarDxf# 147)(setvar "DIMGAP"DimValue))
( (= DimVarDxf# 170)(setvar "DIMALT"DimValue))
( (= DimVarDxf# 171)(setvar "DIMALTD" DimValue))
( (= DimVarDxf# 172)(setvar "DIMTOFL" DimValue))
( (= DimVarDxf# 173)(setvar "DIMSAH"DimValue))
( (= DimVarDxf# 174)(setvar "DIMTIX"DimValue))
( (= DimVarDxf# 175)(setvar "DIMSOXD" DimValue))
( (= DimVarDxf# 176)(setvar "DIMDLRD" DimValue))
( (= DimVarDxf# 177)(setvar "DIMCLRE" DimValue))
( (= DimVarDxf# 178)(setvar "DIMCLRT" DimValue))
( (= DimVarDxf# 270)(setvar "DIMUNIT" DimValue))
( (= DimVarDxf# 271)(setvar "DIMDEC"DimValue))
( (= DimVarDxf# 272)(setvar "DIMTDEC" DimValue))
( (= DimVarDxf# 273)(setvar "DIMALTU" DimValue))
( (= DimVarDxf# 274)(setvar "DIMALTTD"DimValue))
( (= DimVarDxf# 275)(setvar "DIMAUNIT"DimValue))
( (= DimVarDxf# 280)(setvar "DIMJUST" DimValue))
( (= DimVarDxf# 281)(setvar "DIMSD1"DimValue))
( (= DimVarDxf# 282)(setvar "DIMSD2"DimValue))
( (= DimVarDxf# 283)(setvar "DIMTOLJ" DimValue))
( (= DimVarDxf# 284)(setvar "DIMTZIN" DimValue))
( (= DimVarDxf# 285)(setvar "DIMALTZ" DimValue))
( (= DimVarDxf# 286)(setvar "DIMALTTZ"DimValue))
( (= DimVarDxf# 287)(setvar "DIMFIT"DimValue))
( (= DimVarDxf# 288)(setvar "DIMUPT"DimValue))
);cond
);progn
);if
);if
);if
(setq Num# (+ Num# 2))
);repeat
);progn
);if
(setq BlkList@ (tblsearch "BLOCK" (cdr (assoc 2 EntList@))))
(setq BlkEname^ (cdr (assoc -2 BlkList@)))
(while (setq BlkEname^ (entnext BlkEname^))
(if BlkEname^
(progn
(setq BlkList@ (entget BlkEname^))
(if (= (cdr (assoc 0 BlkList@)) "MTEXT")
(setq StyHeight~ (cdr (assoc 40 BlkList@)))
);if
);progn
);if
);while
(if (= StyHeight~ 0)
(progn
(setq StyHeight~ (/ (getvar "dimscale") StyHeight~))
(setvar "dimtxt" StyHeight~)
);progn
);if
(princ "\n选择尺寸或文本更新:")
(setq SSet& (ssget
'((-4 . "<OR")
(0 . "DIMENSION")(0 . "LEADER")(0 . "MTEXT")(0 . "TEXT")
(-4 . "OR>")))
);setq
(setq Cnt# 0)
(if SSet&
(repeat (sslength SSet&)
(setq EntType$ (cdr (assoc 0 (entget (ssname SSet& Cnt#)))))
(setq EntName^ (ssname SSet& Cnt#))
(cond
( (= EntType$ "DIMENSION")
(command ".DIM1" "UP" EntName^ "")
)
( (= EntType$ "LEADER")
(setq DimTad# (getvar "DIMTAD"))
(setvar "DIMTAD" 0)
(command ".DIM1" "UP" EntName^ "")
(setvar "DIMTAD" DimTad#)
)
( (or (= EntType$ "TEXT") (= EntType$ "MTEXT"))
(setq EntList@ (entget (ssname SSet& Cnt#)))
(entmod (subst (cons 40 StyHeight~) (assoc 40 EntList@) EntList@))
)
);cond
(cond
( (or (= EntType$ "TEXT") (= EntType$ "MTEXT"))
(setq EntList@ (entget (ssname SSet& Cnt#)))
(setq Font$ (cdr (assoc 2 Dimstyle@)))
(entmod (subst (cons 7 Font$) (assoc 7 EntList@) EntList@))
)
);cond
(setq Cnt# (1+ Cnt#))
);repeat
);if
(redraw EntName1^ 4)
);progn
(princ "\n没有选择标注样式!.")
);if
(princ)
);defun
(princ)
找到解决办法不了这个命令就行了 (DEFUN C:DU ( ) (COMMAND "DIM" "UP")) 虽说只能刷标注,但还是很好用 本帖最后由 chenry676 于 2022-4-28 10:49 编辑
已解决已解决已解决 本帖最后由 chenry676 于 2022-4-28 10:49 编辑
已解决已解决已解决 简答代码解决问题
页:
[1]