area命令所取得多个对象的面积怎么能标注在图形指定地点 - 编程申请 - AutoCAD论坛 - 明经CAD社区 - 第2页

124350440 发表于 2010-10-8 08:25:00

Gu_xl发表于2010-10-7 19:34:00static/image/common/back.gif怎么不顺畅，说具体点...

命令: mjqh1 输入注记位数：3 输入注记高度：3 请选择中心点:-boundary 指定内部点或 [高级选项(A)]: 正在选择所有对象... 正在选择所有可见对象... 正在分析所选数据...
正在分析内部孤岛...
指定内部点或 [高级选项(A)]: BOUNDARY 已创建 1 个多段线 命令: Area 指定第一个角点或 [对象(O)/加(A)/减(S)]: o 选择对象: 面积 = 4684.9831，周长 = 281.0738
命令: 4684.983  当前总面积：4684.983 请选择中心点:-boundary 指定内部点或 [高级选项(A)]: 正在选择所有对象... 正在选择所有可见对象... 正在分析所选数据...
正在分析内部孤岛...
指定内部点或 [高级选项(A)]: BOUNDARY 已创建 1 个多段线 命令: Area 指定第一个角点或 [对象(O)/加(A)/减(S)]: o 选择对象: 面积 = 2458.9718，周长 = 199.4614
命令: 2458.972  当前总面积：7143.955 请选择中心点:-boundary 指定内部点或 [高级选项(A)]: 正在选择所有对象... 正在选择所有可见对象... 正在分析所选数据...
正在分析内部孤岛...
指定内部点或 [高级选项(A)]: BOUNDARY 已创建 1 个多段线 命令: Area 指定第一个角点或 [对象(O)/加(A)/减(S)]: o 选择对象: 面积 = 2543.1098，周长 = 203.6487
命令: 2543.110  当前总面积：9687.065 请选择中心点: erase 选择对象:   找到 6 个
选择对象: 命令:  总面积为: 9687.065  选择注记位置：((0 . "TEXT") (67 . 0) (100 . "AcDbText") (10 186.209 29.0081 0.0) (40 . 3.0) (1 . " 总面积为: 9687.065") (50 . 0.0) (41 . 0.8) (51 . 0.0) (7 . "standard"))

Gu_xl 发表于 2010-10-8 10:44:00

本帖最后由作者于 2010-10-8 15:18:11 编辑

我提供的代码隐去了错误处理代码，一般一个好的程序都要有错误处理函数，在开始要关闭一些系统变量，如"CMDECHO""ATTDIA" "ATTREQ" "BLIPMODE"等等，来关闭命令行显示等，在程序出错或中途意外退出时可自动恢复这些变量；在程序结束时要恢复系统变量，如我的程序开始用setierr函数重定义*error*,设置一些系统变量，程序结束是用reerr函数恢复*error*，下面提供这两个函数代码：

(DEFUN SetIErr (/ sv)
(if (or (= 'LIST (type *Error*))(= 'USUBR (type *Error*)))
(alert "ERROR:THE LAST (SETiERR) FUNCTION HAS NO (ReErr)!")
(PROGN
(SETQ *SVARL* '())
(FOREACH SV *SYSVARNL*
(SETQ *SVARL* (CONS (GETVAR SV) *SVARL*))
)
(FOREACH SV '("ATTDIA" "ATTREQ" "BLIPMODE" "CMDECHO" "DIMZIN"
"OSMODE" "ORTHOMODE" "MIRRTEXT")
(SETVAR SV 0)
)

(SETVAR "EXPERT" 5)
      (SETVAR "CECOLOR" "BYLAYER")
      (SETVAR "celtype" "BYLAYER")
(SETVAR "LWDISPLAY" 1)
(SETVAR "PLINEGEN" 1)
   ; (if SetScale () (InitMap))
      (setq MyOld*error* *error*)
(defun *error* (st) (reerr)(princ))
)
)

)
(defun ReErr ()
(if (or (= 'LIST (type *error*)) (= 'SUBR (type *error*)) (= 'USUBR (type *error*)))
(PROGN (MAPCAR 'SETVAR *SYSVARNL* (REVERSE *SVARL*))
(SETQ*Error* MyOld*error*)
)
(ALERT "ERROR: NO (SETIERR)!")
)
(PRINC)
)

124350440 发表于 2010-10-8 13:57:00

哦，有点迷糊了，现在要把您发的这些代码都组合在一起吗？该怎么组合啊？

Gu_xl 发表于 2010-10-8 15:22:00

请将12楼贴中错误处理函数setmyerr 改为SetIerr,贴中已改！将2楼的代码第2行和111行语句前面的";"去掉即可！

124350440 发表于 2010-10-8 16:20:00

Gu_xl发表于2010-10-8 15:22:00static/image/common/back.gif请将12楼贴中错误处理函数setmyerr 改为SetIerr,贴中已改！将2楼的代码第2行和111行语句前面的\";\"去掉即可！

ok，明白了！
再问一下，是不是在取小数位数的时候在中途点取的时候就已经四舍五入了，而不是在最终的结果四舍五入。

Gu_xl 发表于 2010-10-8 16:39:00

根据你设定的注记位数，中途已经舍去了，如不想损失精度，请将该代码(setq mj (atof (rtos mj 2 #ZJWS#)))删除！

124350440 发表于 2010-10-8 16:50:00

Gu_xl发表于2010-10-8 16:39:00static/image/common/back.gif根据你设定的注记位数，中途已经舍去了，如不想损失精度，请将该代码

以下内容为程序代码:

(setq mj (atof (rtos mj 2 #ZJWS#)))

</td></tr>
<tr style="DISPLAY: none">
<td id="copycode17927"></td></tr></tbody></table>删除！ </div>
嗯，可以了！如果不需重复的敲空格键来设置小数位和字高，怎么在源码中直接修改？

Gu_xl 发表于 2010-10-8 19:48:00

本帖最后由作者于 2010-10-9 8:30:40 编辑

将(setq #ZJWS# (getint "\n输入注记位数："))改为：

(setq oldZJWS #ZJWS#)
(initget 5 "")
(if #ZJWS# (setq #ZJWS# (getint (strcat "\n输入注记位数<" (itoa #ZJWS#) ">:")))
(setq #ZJWS# (getint "\n输入注记位数<3>："))
)
(if (and oldZJWS (= #ZJWS# "")) (setq #ZJWS# oldZJWS)
(if (and (not oldZJWS) (= #ZJWS# "")) (setq #ZJWS# 3) ))
注记高度代码的写法类似，注意高度使用getreal函数，并将
(initget 5 "")改为
(initget 7 "")，阻止0和负数输入
你自己写一下吧！

124350440 发表于 2010-10-9 11:46:00

Gu_xl发表于2010-10-8 19:48:00static/image/common/back.gif将

以下内容为程序代码:

(setq #ZJWS# (getint \"\n输入注记位数：\"))

</td></tr>
<tr style="DISPLAY: none">
<td id="copycode49080"></td></tr></tbody></table>改为：

<table class="tableborder4" style="FONT-SIZE: 13px; WIDTH: 90%" cellspacing="2" border="0">
<tbody>
<tr>
<td class="tablebody2" height="20">[复制代码][语法着色]以下内容为程序代码:</td></tr>
<tr>
<td>
<div class="blockcode" id="code39253">
<ol>
<li>(setq oldZJWS #ZJWS#)
<li>(initget 5 "  ")
<li>(if #ZJWS# (setq #ZJWS# (getint (strcat "\n输入注记位数<" (itoa #ZJWS#) ">:")))
<li>(setq #ZJWS# (getint "\n输入注记位数<3>："))
<li>)
<li>(if (and oldZJWS (= #ZJWS# "")) (setq #ZJWS# oldZJWS)
<li>(if (and (not oldZJWS) (= #ZJWS# "")) (setq #ZJWS# 3) ))</li></ol></div></td></tr>
<tr style="DISPLAY: none">
<td id="copycode39253"></td></tr></tbody></table>
注记高度代码的写法类似，注意高度使用getreal函数，并将
(initget 5 "  ")改为
(initget 7 "  ")，阻止0和负数输入
你自己写一下吧！
<div align="right">[此贴子已经被作者于2010-10-9 8:30:40编辑过]</div></div>
我改不赢啊，改了还是要输入，并且文字是乱码

Gu_xl 发表于 2010-10-9 14:25:00

修改后代码：

(defun c:mjqh1 (/ pt1 pt2 zg mj zmj ss LastEntity LastEntity1 gxl-Sel-EntNextAll ssaddsel )
(setierr)
;(initArea)
;;;gxl-Sel-EntNextAll en 返回 en 之后的所有物体选择集，无则返回 nil
(defun gxl-Sel-EntNextAll (ent / ss ent1)
(setq ss (ssadd))
(while (setq ent1 (entnext ent))
(ssadd ent1 ss)
(setq ent ent1)
)
(if (= 0 (sslength ss))
nil
ss
)
)
;把选择集1中的图元加入到选择集2中
(defun ssaddsel (ss1 ss2 / n k)
(setq n (sslength ss1)
k 0)
(if (> n 0)
(while (setq ent (ssname ss1 k))
 (ssadd ent ss2)
 (setq k (1+ k))
 )
)
(setq ss2 ss2)
)
;;;gxl-MakeText1 生成文字函数,参数：标注点字高宽比旋转角倾角，角度单位：度
(defun gxl-MakeText1 (xy Txt ZG KB XZ Qj / xyL TxtL ZGL KBL XZL QJL)
(setq xy (trans xy 1 0));;;坐标换算为世界坐标
(SETQ XZ (gxl-Num-DtoR (gxl-Num-Angle->Wcs XZ )))
 (setq xyL(cons 10 xy)
TxtL (cons 1 Txt)
ZGL(cons 40 ZG)
KBL(cons 41 KB)
XZL(cons 50 XZ)
QJL(cons 51 (gxl-Num-DtoR QJ))
 )
 (setq TextL (list '(0 . "TEXT")
'(67 . 0)
'(100
.
"AcDbText"
)
xyL
ZGL
TxtL
XZL
KBL
QJL
'(7 . "standard")
)
 )
 (entmake TextL)
)
;;;程序开始
(setq zmj 0)
;(setq #ZJWS# (getint "\n输入注记位数："))
;(if (not(= 'INT (type #ZJWS#))) (setq #ZJWS# 3))
(setq oldZJWS #ZJWS#)
(initget 5 "")
(if #ZJWS# (setq #ZJWS# (getint (strcat "\n 输入注记位数<" (itoa #ZJWS#) ">:")))
(setq #ZJWS# (getint "\n 输入注记位数<3>："))
)
(if (and oldZJWS (= #ZJWS# "")) (setq #ZJWS# oldZJWS)
(if (and (not oldZJWS) (= #ZJWS# "")) (setq #ZJWS# 3) ))
(setq oldZJWS #ZJWS#)
;(setq mjHeight (getreal "\n输入注记高度："))
;(if (not(or (= 'INT (type mjHeight))(= 'REAL (type mjHeight)))) (setq mjHeight 1.5))
(setq oldZJGD mjHeight)
(initget 7 "")
(if mjHeight (setq mjHeight (getreal (strcat "\n 输入注记高度：<" (rtos mjHeight 2 2) ">:")))
(setq mjHeight (getreal "\n 输入注记高度<1.5>："))
)
(if (and oldZJGD (= mjHeight "")) (setq mjHeight oldZJGD)
(if (and (not oldZJGD) (= mjHeight "")) (setq mjHeight 3) ))
(setq oldZJGD mjHeight)
(setq ss (ssadd))
(while (= 'LIST (type
 (progn
 (initget 7 "No")
 (setq pt1 (getpoint "\n请选择中心点:"))
 )
 )
)
(setq LastEntity (entlast))
(while (progn
;(setq pt1 (getpoint "\n请输入中心点:"))
(command "-boundary" pt1 "")
(setq LastEntity1 (entlast))
(equal LastEntity LastEntity1)
)
(setq pt1 (getpoint "\n请输入中心点:"))
)
(command "Area" "o" LastEntity1)
;(entdel (entlast))
; (ssadd LastEntity1 ss)
 (setq ss0 (GXL-SEL-ENTNEXTALL LastEntity))
(setq ss (ssaddsel ss0 ss))
 (redraw LastEntity1 3)
(setq mj (getvar "area"))
;|(if (= mjdw 1000)
(setq mj (/ mj 1000000.0))
)|;
(princ (rtos mj 2 #ZJWS#))
(setq mj (atof (rtos mj 2 #ZJWS#)))
(setq zg mjHeight)

(setq zmj (+ zmj mj))
(princ (strcat "当前总面积：" (rtos zmj 2 #ZJWS#)))
;;;注记文字
(gxl-MakeText1 pt1 (rtos mj 2 #ZJWS#) zg 0.8 0 0 )
(ssadd (entlast) ss)
;(setq mj (rtos mj 2 2))
;(gxl-MakeText pt1 mj zg 0.8 0 0)
)
(command "erase" ss "")
(princ (strcat "\n 总面积为: " (setq zmj (rtos zmj 2 #ZJWS#))))
(setq zmj (strcat " 总面积为: " zmj))
(setq zg mjHeight)
(initget 7 " ")
(setq pt2 (getpoint "\n 选择注记位置："))
(if (= 'List (type pt2))
 (gxl-MakeText1 pt2 zmj zg 0.8 0 0 )
)

(reerr)
;(princ)
)

页: 1 [2] 3

明经CAD社区's Archiver