[建议]：理正面积标注-续

brainstorm

是否可以这样
(setq pt (getpoint "\n输入文字标注点<不标注>:"))
(if pt
(progn
(if (setq ss (ssget pt '(0 . "text")))
(progn
(setq text (ssname ss 0))
(改变text组码)
)
(progn
(command "dtext" . . . .)
)
)
)
(princ "\n面积为:......")
)

;;;---------------------------------------------------------------------------------------
;而是怕在注面积的附近会有其它文字；如果只是替换已有面积标注，那么出麻烦的几率会比闲
;我觉得不会出现这种情况，下面一段小程序是个例子，欢迎网友测试一下，看看是否方便，给
;Qun老大一个参考意见
;此例是文字标注时，如果选点位置有文字，则替换该文字，如果没有，则生成新文字，功能是
;进行简单的+-*/计算
(defun c:plus
(/ ss1 ss2 i str sum total-ss1
total-ss2 aa bb pt text weishu
loop
)
(defun zgx-nhbl (/ nhbl)
(if (setq nhbl (tblsearch "dimstyle" "normal"))
(setq nhbl (cdr (assoc 40 nhbl)))
(setq nhbl 1.0)
)
)
(defun zgx-grread (msg track allkeys curtype / k)
(prompt (strcat "\n" msg))
(if (= (car (setq k (grread track allkeys curtype))) 12)
(setq k (grread track allkeys curtype))
k
)
)
(defun zgx-getstring (msg / str)
(while (or (not str) (= "" str))
(setq str (getstring (strcat "\n" msg)))
)
)
(defun zgx-get-dxf (code entname kk)
(if (= kk 2)
(assoc code (entget entname))
(cdr (assoc code (entget entname)))
)
)
(defun zgx-select (msg lst1 lst2)
(prompt (strcat "\n" msg))
(ssget (mapcar 'cons lst1 lst2))
)
(defun zgx-chg-dxf (en code newdata / endata)
(setq endata (entget en))
(setq
endata (subst (cons code newdata)
(assoc code endata)
endata
)
)
(entmod endata)
)
(if (not (setq weishu (vlax-ldata-get "zgx-preset" "weishu"))
)
(progn
(setq weishu 2)
(vlax-ldata-put "zgx-preset" "weishu" weishu)
)
)
(setq str (zgx-getstring "请输入+ - * /:"))
(setq ss1
(zgx-select "选择第1组数字:" (list 0) (list "text"))
)
(setq i 0)
(setq total-ss1 0)
(setq total-ss2 0)
(repeat (sslength ss1)
(setq en (ssname ss1 i))
(setq total-ss1 (+
total-ss1
(atof (zgx-get-dxf 1 en 1))
)
)
(setq i (1+ i))
)
(setq ss2
(zgx-select "选择第2组数字:" (list 0) (list "text"))
)
(if ss2
(progn
(setq i 0)
(repeat (sslength ss2)
(setq en (ssname ss2 i))
(setq
total-ss2 (+
total-ss2
(atof (zgx-get-dxf 1 en 1))
)
)
(setq i (1+ i))
)
)
)
(if total-ss2
(setq sum ((eval (read str))
total-ss1
total-ss2
)
)
(setq sum total-ss1)
)
(if ss2
(progn
(while
(and
(princ (strcat
"\n----当前计算结果为"
(rtos sum 2 3)
"----"
)
)
(/= ""
(setq str
(getstring
"\n请输入+ - * / :{右键退出求值}"
)
)
)
)
(setq ss2 (zgx-select
"选择下一组数字:"
(list 0)
(list "text")
)
)
(setq total-ss2 0.0)
(setq i 0)
(repeat (sslength ss2)
(setq en (ssname ss2 i))
(setq total-ss2
(+
total-ss2
(atof (zgx-get-dxf 1 en 1)
)
)
)
(setq i (1+ i))
)
(setq sum ((eval (read str))
sum
total-ss2
)
)
)
)
)
(princ (strcat
"\n"
(rtos sum 2 3)
)
)
(setq loop t)
(while loop
(setq aa (zgx-grread
(strcat
"选择文字位置{可点取文字,q改变位数,当前保留"
(rtos weishu 2 0)
"位}"
)
nil
4
0
)
)
(setq bb (car aa))
(cond
((member bb '(11 12)) ;鼠标右键
(progn
(princ (strcat
"\n----计算结果为"
(rtos sum 2 weishu)
"----"
)
)
(setq loop nil)
)
)
((= 3 bb)
(progn
(setq loop nil)
(setq text (ssget (cadr aa)))
(if text
(setq text (ssname text 0))
)
(if (and
text
(= (zgx-get-dxf 0 text 1) "TEXT")
)
(zgx-chg-dxf
text
1
(rtos sum 2 weishu)
)
(progn
(setq pt (cadr aa))
(entmake
(mapcar
'cons
(list 0 8 10 40 1 41 7)
(list
"text"
"area"
pt
(* (zgx-nhbl) 300.0)
(rtos sum 2 weishu)
0.7
(if (not (tblsearch "style" "s")
)
(getvar "textstyle")
"s"
)
)
)
)
)
;;progn
)
)
)
((= 2 bb)
(progn
(cond
((member (cadr aa) '(13 32))
;空格或回车键
(progn (princ (strcat
"\n----计算结果为"
(rtos sum 2 weishu)
"----"
)
)
(setq loop nil)
)
)
((member (cadr aa) '(81 113))
(progn
(setq weishu (1+ weishu))
(if (> weishu 3)
(setq weishu 0)
)
(vlax-ldata-put
"zgx-preset"
"weishu"
weishu
)
(setq loop t)
)
)
(t (setq loop t))
)
)
) ;cond = 2 bb
(t
(progn
(princ (strcat
"\n----计算结果为"
(rtos sum 2 weishu)
"----"
)
)
)
)
)
) ;while
(princ)
)

Qun

你的程序试了一下，这种用法我是清楚的。只是有两点有疑问：
1、如果不加选项，怕在文字太密集的地方容易替换掉有用的文字。
2、如果是普通字体，平方米符号仅仅替换是解决不了的。

brainstorm

你的程序试了一下，这种用法我是清楚的。只是有两点有疑问：
1、如果不加选项，怕在文字太密集的地方容易替换掉有用的文字。
这种情况基本不存在，因为谁有不会在一个很小的窗口内选择文字
2、如果是普通字体，平方米符号仅仅替换是解决不了的。
这个问题确实存在，只能手动修改，或者将被修改的文的字型改为支持上标的字型文件。
以上是我的个人意见，有时软件设计师同软件使用者在理念上不大一样，各有个的出发点，呵呵。
另外稍带提一下理正FJMJ命令数字运算只支持+法，那么计算出房率时需要除法，所以建议运算功能加强一些

Qun

请试试用【文字编辑】，里面支持计算器。

tudou119

为什么我的2008不能用呢？