[求助]如何把直径标注前的直径符号改为M

alin · 发表于 2007-2-1 13:48:00

(defun C:test (/ IDX SS en blkname blks DOC dimblkdef txtstr)
(IF (SETQ SS (SSGET '((0 . "*DIMENSION"))))
    (PROGN
      (SETQ IDX 0)
      (WHILE (<= IDX (1- (SSLENGTH SS)))
(SETQ en (SSNAME SS IDX))
(setq blkname (cdr (assoc 2 (entget en))))
(setq
   blks (vla-get-blocks
   (SETQ
     DOC (vla-get-activedocument (vlax-get-acad-object))
   )
        )
)
(setq dimblkdef (vla-item blks blkname))
(vlax-for subobj dimblkdef
   (if (= (vla-get-objectname subobj) "AcDbMText")
     (progn
       (setq txtstr (vla-get-textstring subobj))
       (if (vl-string-search "\\U+2205" txtstr)
  (PROGN
    (setq txtstr (vl-string-subst "M" "\\U+2205" txtstr))
    (vla-put-textstring subobj txtstr)
  )
       )
       (if (vl-string-search "%%C" txtstr)
  (PROGN
    (setq txtstr (vl-string-subst "M" "%%C" txtstr))
    (vla-put-textstring subobj txtstr)
  )
       )
       (if (vl-string-search "%%c" txtstr)
  (PROGN
    (setq txtstr (vl-string-subst "M" "%%c" txtstr))
    (vla-put-textstring subobj txtstr)
  )
       )
     )
   )
)
(SETQ IDX (1+ IDX))
      )
      (VLA-REGEN DOC acActiveViewport)
    )
)
(princ)
)

小妹丁 · 发表于 2007-2-1 19:28:00

alin的程序和ZZXXQQ的程序，都只能处理图中的其中一个标注，这是不够的。

ZZXXQQ的程序用文字替代方式，更加不合理。

ygrzz · 发表于 2007-2-1 20:32:00

对一般线性标注按常规处理另建前缀标注当然可以
改下拉菜单（熟悉菜单格式的话）如下也不错
               [线性标注螺纹M ]^C^C_dimlinear \\t;M<>;
               [线性标注螺纹4-M ]^C^C_dimlinear \\t;4-M<>;
               [线性标注直径φ ]^C^C_dimlinear \\t;%%C<>;
改lisp也简单，
(defun c:4m () (command "dimlinear" pause pause "t" "4-M<>"))

但是直径标注dimdiameter套上去
(defun c:4m () (command "dimdiameter" pause "t" "4-M<>"))
出来的结果那个直径符号也一并出来了
还非得用前面2位斑竹程序去整不可，
当然不嫌烦的话标注的过程中输入选项“T”再打上实际数值也不反对

2斑竹已曲同工，测试结果都很好

ygrzz · 发表于 2007-2-1 21:19:00

悄悄问下alin ,程序好长哦，开个玩笑~~~`一定花了你不少时间，谢过了！
看见有好多人写过公差标注，我觉得有一点是相通的，读取标注原值
ZZXXQQ也是读取了标注原值，肯定不会出错的

ygrzz · 发表于 2007-2-1 22:45:00

(IF (= TY "AcDbDiametricDimension")

ZZXXQQ斑竹，你就干脆作个对线性标注的判断，如果是一般线性标注
直接加"M"可以不

ygrzz · 发表于 2007-2-1 23:05:00

坐标尺寸标注(AcDbOrdinateDimension)
(IF
(= TY "AcDbOrdinateDimension")
。。。。？

alin · 发表于 2007-2-2 08:16:00

区别是ZZXXQQ的程序重新计算尺寸值，有可能篡改你图中医编辑过的尺寸值，还有精度的问题，比如用ZZXXQQ的程序%%c70的尺寸值有可能改成M69.88

ZZXXQQ · 发表于 2007-2-2 11:39:00

ygrzz发表于2007-2-1 22:45:00 (IF (= TY \"AcDbDiametricDimension\")ZZXXQQ斑竹，你就干脆作个对线性标注的判断，如果是一般线性标注直接加\"M\"可以不

(DEFUN C:TEST ()
(SETVAR "CMDECHO" 0)
(PROMPT "\nSelect Dimension(s) :")
(IF (SETQ SS (SSGET '((0 . "DIMENSION")))) (PROGN
(SETQ I -1)
(REPEAT (SSLENGTH SS)
(SETQ ENT (ENTGET (SSNAME SS (SETQ I (1+ I))))
TY (CDR (ASSOC 100 (REVERSE ENT))))
(COND
((= TY "AcDbDiametricDimension")
(SETQ D (DISTANCE (CDR (ASSOC 10 ENT)) (CDR (ASSOC 15 ENT)))
DTX (STRCAT "M" (RTOS D 2 3))
TX (CDR (ASSOC 1 ENT)))
(IF (OR (= TX "") (= TX "<>"))
(SETQ ENT (SUBST (CONS 1 DTX) (ASSOC 1 ENT) ENT))
(SETQ ENT (SUBST (CONS 1 (STRCAT "M" TX)) (ASSOC 1 ENT) ENT))
)
(ENTMOD ENT)
)
((= TY "AcDbAlignedDimension")
(SETQ TX (CDR (ASSOC 1 ENT)))
(IF (OR (= TX "") (= TX "<>"))
(SETQ ENT (SUBST (CONS 1 "M<>") (ASSOC 1 ENT) ENT))
(SETQ ENT (SUBST (CONS 1 (STRCAT "M" TX)) (ASSOC 1 ENT) ENT))
)
(ENTMOD ENT)
)
)
)
))
(SETVAR "CMDECHO" 1)
(PRINC)
)

无痕 · 发表于 2007-2-2 12:43:00

个人比较赞同alin 的观点

killer9806 · 发表于 2007-2-2 18:35:00

两个程式都值得学习哦！谢谢了

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

[求助]如何把直径标注前的直径符号改为M

本帖子中包含更多资源