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-TextSuffixobj "")
    (vla-put-TextSuffixobj "（通孔）")
)
(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 (strcatTextOverride "（通孔）"))
)
      )
    )
)
(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-TextSuffixobj "")
    (vla-put-TextSuffixobj "（通孔）")
)
(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


院长好:handshake，请教下批量改变标注值的倍数，这个代码怎么弄
(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)
)
页: [1] 2
查看完整版本: （求助）尺寸加前缀功能求改