（求助）尺寸加前缀功能求改

xudongchu · 发表于 2023-4-12 15:38:44

程序是论坛的大神的
地址http://bbs.mjtd.com/thread-186646-1-1.html?_dsign=0cb88072

程序功能是给尺寸前缀加Φ，如果尺寸前缀有Φ则去除Φ，没有Φ则加Φ。

有没有大神帮改一下，改成尺寸后缀加“（通孔）”，如果尺寸后缀有“（通孔）”则去除“（通孔）”，没有“（通孔）”则加“（通孔）”。

yaojing38 · 发表于 2023-4-12 15:38:45

xudongchu 发表于 2023-4-12 16:44
谢谢你的回复，是需要的功能。
但是有BUG，当尺寸有前缀或者后缀时，程序就变成了前缀加“通孔”的功能 ...

;1尺寸前加前缀φ
(defun C:TT (/ E N OBJ SS TEXTOVERRIDE )
(while (and (setvar "nomutt" 1)
(princ "\n 选择尺寸,切换前缀φ")
(setq ss (ssget ":S" '((0 . "*DIMENSION"))))
(setvar "nomutt" 0)
)
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq obj (vlax-ename->vla-object e))
(setq TextOverride (vlax-get obj 'TextOverride))
(if (= "" TextOverride)
(if (= (vla-get-TextSuffix obj) "（通孔）")
(vla-put-TextSuffix obj "")
(vla-put-TextSuffix obj "（通孔）")
)
(if (or (wcmatch TextOverride "*（通孔）")
(wcmatch TextOverride "（通孔）*")
(wcmatch TextOverride "*（通孔）*")
)
(progn
(while (VL-STRING-SEARCH "（通孔）" TextOverride)
(setq TextOverride
(VL-STRING-SUBST "" "（通孔）" TextOverride)
)
)
(while (VL-STRING-SEARCH "（通孔）" TextOverride)
(setq TextOverride
(VL-STRING-SUBST "" "（通孔）" TextOverride)
)
)
(while (VL-STRING-SEARCH "（通孔）" TextOverride)
(setq TextOverride
(VL-STRING-SUBST "" "（通孔）" TextOverride)
)
)
(vla-put-TextOverride obj TextOverride)
)
(vla-put-TextOverride obj (strcat TextOverride "（通孔）"))
)
)
)
)
(setvar "nomutt" 0) ;空选时执行
)

;1尺寸前加前缀φ 
(defun C:TT (/ E N OBJ SS TEXTOVERRIDE ) 
  (while (and (setvar "nomutt" 1) 
        (princ "\n 选择尺寸,切换前缀φ") 
        (setq ss (ssget ":S" '((0 . "*DIMENSION")))) 
        (setvar "nomutt" 0) 
   ) 
    (repeat (setq n (sslength ss)) 
      (setq e (ssname ss (setq n (1- n)))) 
      (setq obj (vlax-ename->vla-object e)) 
      (setq TextOverride (vlax-get obj 'TextOverride)) 
      (if (= "" TextOverride) 
  (if (= (vla-get-TextSuffix obj) "（通孔）") 
    (vla-put-TextSuffix  obj "") 
    (vla-put-TextSuffix  obj "（通孔）") 
  ) 
  (if (or  (wcmatch TextOverride "*（通孔）") 
    (wcmatch TextOverride "（通孔）*") 
    (wcmatch TextOverride "*（通孔）*") 
      ) 
    (progn 
      (while (VL-STRING-SEARCH "（通孔）" TextOverride) 
        (setq TextOverride 
         (VL-STRING-SUBST "" "（通孔）" TextOverride) 
        ) 
      ) 
      (while (VL-STRING-SEARCH "（通孔）" TextOverride) 
        (setq TextOverride 
         (VL-STRING-SUBST "" "（通孔）" TextOverride) 
        ) 
      ) 
      (while (VL-STRING-SEARCH "（通孔）" TextOverride) 
        (setq TextOverride 
         (VL-STRING-SUBST "" "（通孔）" TextOverride) 
        ) 
      ) 
      (vla-put-TextOverride obj TextOverride) 
    ) 
    (vla-put-TextOverride obj (strcat  TextOverride "（通孔）")) 
  ) 
      ) 
    ) 
  ) 
  (setvar "nomutt" 0)      ;空选时执行 
)

llsheng_73 · 发表于 2023-4-12 15:50:33

神一样的需求描述：改成尺寸后缀加“（通孔）”，如果尺寸后缀有“（通孔）”则去除“（通孔）”，没有“（通孔）”则加“（通孔）”
按描述，假设部分尺寸后缀有“（通孔）”，部分没有，那么运行两次后和没运行完全一样。。。这是楼主希望的么？

yaojing38 · 发表于 2023-4-12 16:16:13

;1尺寸后加加前通孔
(defun C:TT (/ E N OBJ SS TEXTOVERRIDE)
(while (and (setvar "nomutt" 1)
(princ "\n 选择尺寸,切换前缀φ")
(setq ss (ssget ":S" '((0 . "*DIMENSION"))))
(setvar "nomutt" 0)
)
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq obj (vlax-ename->vla-object e))
(setq TextOverride (vlax-get obj 'TextOverride))
(if (= "" TextOverride)
(if (= (vla-get-TextSuffix obj) "（通孔）")
(vla-put-TextSuffix obj "")
(vla-put-TextSuffix obj "（通孔）")
)
(if (or (wcmatch TextOverride "*（通孔）")
(wcmatch TextOverride "*（通孔）")
(wcmatch TextOverride "*（通孔）")
)
(progn
(while (VL-STRING-SEARCH "（通孔）" TextOverride)
(setq TextOverride
(VL-STRING-SUBST "" "（通孔）" TextOverride)
)
)
(while (VL-STRING-SEARCH "（通孔）" TextOverride)
(setq TextOverride
(VL-STRING-SUBST "" "（通孔）" TextOverride)
)
)
(while (VL-STRING-SEARCH "（通孔）" TextOverride)
(setq TextOverride
(VL-STRING-SUBST "" "（通孔）" TextOverride)
)
)
(vla-put-TextOverride obj TextOverride)
)
(vla-put-TextOverride obj (strcat "（通孔）" TextOverride))
)
)
)
)
(setvar "nomutt" 0) ;空选时执行
)

;1尺寸后加加前通孔 
(defun C:TT (/ E N OBJ SS TEXTOVERRIDE) 
  (while (and (setvar "nomutt" 1) 
        (princ "\n 选择尺寸,切换前缀φ") 
        (setq ss (ssget ":S" '((0 . "*DIMENSION")))) 
        (setvar "nomutt" 0) 
   ) 
    (repeat (setq n (sslength ss)) 
      (setq e (ssname ss (setq n (1- n)))) 
      (setq obj (vlax-ename->vla-object e)) 
      (setq TextOverride (vlax-get obj 'TextOverride)) 
      (if (= "" TextOverride) 
  (if (= (vla-get-TextSuffix obj) "（通孔）") 
    (vla-put-TextSuffix  obj "") 
    (vla-put-TextSuffix  obj "（通孔）") 
  ) 
  (if (or  (wcmatch TextOverride "*（通孔）") 
    (wcmatch TextOverride "*（通孔）") 
    (wcmatch TextOverride "*（通孔）") 
      ) 
    (progn 
      (while (VL-STRING-SEARCH "（通孔）" TextOverride) 
        (setq TextOverride 
         (VL-STRING-SUBST "" "（通孔）" TextOverride) 
        ) 
      ) 
      (while (VL-STRING-SEARCH "（通孔）" TextOverride) 
        (setq TextOverride 
         (VL-STRING-SUBST "" "（通孔）" TextOverride) 
        ) 
      ) 
      (while (VL-STRING-SEARCH "（通孔）" TextOverride) 
        (setq TextOverride 
         (VL-STRING-SUBST "" "（通孔）" TextOverride) 
        ) 
      ) 
      (vla-put-TextOverride obj TextOverride) 
    ) 
    (vla-put-TextOverride obj (strcat "（通孔）" TextOverride)) 
  ) 
      ) 
    ) 
  ) 
  (setvar "nomutt" 0)      ;空选时执行 
)

xudongchu · 发表于 2023-4-12 16:44:04

yaojing38 发表于 2023-4-12 16:16

谢谢你的回复，是需要的功能。
但是有BUG，当尺寸有前缀或者后缀时，程序就变成了前缀加“通孔”的功能了。

xudongchu · 发表于 2023-4-12 16:50:37

llsheng_73 发表于 2023-4-12 15:50
神一样的需求描述：改成尺寸后缀加“（通孔）”，如果尺寸后缀有“（通孔）”则去除“（通孔）”，没有“（ ...

谢谢你的回复，是的。

xudongchu · 发表于 2023-4-12 17:02:21

yaojing38 发表于 2023-4-12 16:56

谢谢测试没问题。

xyp1964 · 发表于 2023-4-12 19:34:35

本帖最后由 xyp1964 于 2023-4-12 19:36 编辑

(defun c:tt ()
;; 尺寸后缀加减“（通孔）”
(while (and (princ "\n选择尺寸,切换前缀φ")
(setq ss (ssget '((0 . "*DIMENSION"))))
)
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(setq obj (vlax-ename->vla-object e))
(if (= (vla-get-TextSuffix obj) "（通孔）")
(vla-put-TextSuffix obj "")
(vla-put-TextSuffix obj "（通孔）")
)
)
)
(princ)
)

xudongchu · 发表于 2023-4-13 10:57:52

xyp1964 发表于 2023-4-12 19:34

月下闲人 · 发表于 2023-5-4 20:38:47

xyp1964 发表于 2023-4-12 19:34

院长好

，请教下批量改变标注值的倍数，这个代码怎么弄
(defun c:TT (/ factor ss obj)
(setq factor (getreal "\nEnter scale factor: "))
(setq ss (ssget "_X" '((0 . "DIMENSION"))))
(if ss
(progn
(setq count 0)
(vl-loop-for i 0 (1- (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss i)))
(vla-put-dimscale obj (* (vla-get-dimscale obj) factor))
(setq count (1+ count))
)
(princ (strcat "\n" (itoa count) " dimensions scaled."))
)
(princ "\nNo dimensions found.")
)
(princ)
)

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

[源码] （求助）尺寸加前缀功能求改

最佳答案

改了下，，应该可以了

改了下，，你看下是不是你要的