这个面积标注启动命令时怎么修改让他默认执行第一次输入的字体的高度不然每次...
本帖最后由 超人黄 于 2024-5-30 17:17 编辑这个面积标注启动命令时怎么修改让他默认执行第一次输入的字体的高度不然每次都要从新输入因为使用的频率较高望大佬帮帮忙指导一下不胜感激。
(defun c:Q (/ en i mj mjz obj pt ss sshat th)
(vl-load-com)
(setq th (getdist "\n输入字高：") ss (ssget '((0 . "CIRCLE,LWPOLYLINE")))i -1 mjz 0 sshat (ssadd))
(command "copy" ss "" "non" '(0 0) "non" '(0 0))
(while (setq en (ssname ss (setq i (1+ i))))
(setq obj (vlax-ename->vla-object en))
(setq mj (vla-get-area obj))
(setq mjz (+ mj mjz))
(command "region"en "")
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid (vlax-ename->vla-object (entlast)))))sshat (ssadd (entlast) sshat))
(entmake (list '(0 . "TEXT") (cons 1 (strcat "S=" (rtos (/ mj 1000000) 2 2) "m2")) (cons 10 pt) (cons 11 pt)(cons 40 th)(cons 62 20) (cons 72 1) (cons 73 2)))
)
(entmake (list '(0 . "TEXT") (cons 1 (strcat "总面积=" (rtos (/ mjz 1000000) 2 2) "m2")) (cons 10 (getpoint"\n选取总面积插入点：")) (cons 40 th) (cons 62 20)))
(command "ERASE" sshat "")
(princ)
)
(defun c:Q (/ en i mj mjz obj pt ss sshat )
(vl-load-com)
(if (null $th)
(setq $th (getdist "\n输入字高："))
)
(setq
ss (ssget '((0 . "CIRCLE,LWPOLYLINE")))
i -1
mjz 0
sshat (ssadd)
)
(command "copy" ss "" "non" '(0 0) "non" '(0 0))
(while (setq en (ssname ss (setq i (1+ i))))
(setq obj (vlax-ename->vla-object en))
(setq mj (vla-get-area obj))
(setq mjz (+ mj mjz))
(command "region" en "")
(setq pt (vlax-safearray->list
(vlax-variant-value
(vla-get-centroid (vlax-ename->vla-object (entlast)))
)
)
sshat (ssadd (entlast) sshat)
)
(entmake
(list '(0 . "TEXT")
(cons 1 (strcat "S=" (rtos (/ mj 1000000) 2 2) "m2"))
(cons 10 pt)
(cons 11 pt)
(cons 40 $th)
(cons 62 20)
(cons 72 1)
(cons 73 2)
)
)
)
(entmake
(list '(0 . "TEXT")
(cons 1 (strcat "总面积=" (rtos (/ mjz 1000000) 2 2) "m2"))
(cons 10 (getpoint "\n选取总面积插入点："))
(cons 40 $th)
(cons 62 20)
)
)
(command "ERASE" sshat "")
(princ)
) jun353835273 发表于 2024-5-30 17:40
感谢大佬的帮忙不胜感激，要是能像这样(setq ss (strcat "n输入字体的高度<" (rtos ffsize 2 1) ">:"))
(setq ffsize1 (getreal ss))
(ifffsize1
(setq ffsize ffsize1)
) 选择方式就好了，因为在不同的区域图纸中需要在修改字体大小望大佬在百忙中抽空在帮忙看下。 好像是院长的代码，反正来自论坛
;;;---------------------- UREAL ----------------------------
;;; 实型数输入格式化
;;;方式 : (setq no1 (ureal 1 "" "\n\t实数" no1))
(defun ureal (bit kwd msg def / inp)
(if def
(setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (getreal msg))
(if inp inp def)
) ;;---------------------- UREAL ----------------------------
;;; 实型数输入格式化
;;;方式 : (setq no1 (ureal 1 "" "\n\t实数" no1))
(defun ureal (bit kwd msg def / inp)
(if def
(setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (getreal msg))
(if inp inp def)
)
(defun c:Q (/ en i mj mjz obj pt ss sshat )
(vl-load-com)
(setq $th (ureal 1 "" "\n\输入字高：" $th))
(setq
ss (ssget '((0 . "CIRCLE,LWPOLYLINE")))
i -1
mjz 0
sshat (ssadd)
)
(command "copy" ss "" "non" '(0 0) "non" '(0 0))
(while (setq en (ssname ss (setq i (1+ i))))
(setq obj (vlax-ename->vla-object en))
(setq mj (vla-get-area obj))
(setq mjz (+ mj mjz))
(command "region" en "")
(setq pt (vlax-safearray->list
(vlax-variant-value
(vla-get-centroid (vlax-ename->vla-object (entlast)))
)
)
sshat (ssadd (entlast) sshat)
)
(entmake
(list '(0 . "TEXT")
(cons 1 (strcat "S=" (rtos (/ mj 1000000) 2 2) "m2"))
(cons 10 pt)
(cons 11 pt)
(cons 40 $th)
(cons 62 20)
(cons 72 1)
(cons 73 2)
)
)
)
(entmake
(list '(0 . "TEXT")
(cons 1 (strcat "总面积=" (rtos (/ mjz 1000000) 2 2) "m2"))
(cons 10 (getpoint "\n选取总面积插入点："))
(cons 40 $th)
(cons 62 20)
)
)
(command "ERASE" sshat "")
(princ)
) jun353835273 发表于 2024-5-31 11:38
感谢大佬可以选择了非常感谢，要是字体样式能改就好了不知道怎么改望大佬指导一下，默认字体的样式Standard，要是能改成黑体或者宋体就好了。 MJ...............................................
页:
[1]