area命令所取得多个对象的面积怎么能标注在图形指定地点

124350440

Gu_xl发表于2010-10-7 19:34:00怎么不顺畅，说具体点...

命令: 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

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

3. (DEFUN SetIErr (/ sv)
4.   (if (or (= 'LIST (type *Error*))(= 'USUBR (type *Error*)))
5.   (alert "ERROR  :THE LAST (SETiERR) FUNCTION HAS NO (ReErr)!")
6. (PROGN
7.    (SETQ *SVARL* '())
8.    (FOREACH SV *SYSVARNL*
9.      (SETQ *SVARL* (CONS (GETVAR SV) *SVARL*))
10.      )
11.    (FOREACH SV '("ATTDIA" "ATTREQ" "BLIPMODE" "CMDECHO" "DIMZIN"
12.    "OSMODE" "ORTHOMODE" "MIRRTEXT")
13.      (SETVAR SV 0)
14.      )
15.    
16.    (SETVAR "EXPERT" 5)
17.          (SETVAR "CECOLOR" "BYLAYER")
18.          (SETVAR "celtype" "BYLAYER")
19.    (SETVAR "LWDISPLAY" 1)
20.    (SETVAR "PLINEGEN" 1)
21.         ; (if SetScale () (InitMap))
22.          (setq MyOld*error* *error*)
23.    (defun *error* (st) (reerr)(princ))
24.    )
25.   )
26.   
27.     )
28. (defun ReErr ()
29.   (if (or (= 'LIST (type *error*)) (= 'SUBR (type *error*)) (= 'USUBR (type *error*)))
30.   (PROGN (MAPCAR 'SETVAR *SYSVARNL* (REVERSE *SVARL*))
31.     (SETQ  *Error* MyOld*error*)
32.     )
33.   (ALERT "ERROR  : NO (SETIERR)!")
34.   )
35.   (PRINC)
36.    )

(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

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

Gu_xl

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

124350440

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

ok，明白了！

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

Gu_xl

根据你设定的注记位数，中途已经舍去了，如不想损失精度，请将该代码

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

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

删除！

124350440

Gu_xl发表于2010-10-8 16:39:00根据你设定的注记位数，中途已经舍去了，如不想损失精度，请将该代码 以下内容为程序代码: (setq mj (atof (rtos mj 2 #ZJWS#)))

Gu_xl

将

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

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

改为：

3. (setq oldZJWS #ZJWS#)
4. (initget 5 "  ")
5. (if #ZJWS# (setq #ZJWS# (getint (strcat "\n输入注记位数<" (itoa #ZJWS#) ">:")))
6. (setq #ZJWS# (getint "\n输入注记位数<3>："))
7. )
8. (if (and oldZJWS (= #ZJWS# "")) (setq #ZJWS# oldZJWS)
9. (if (and (not oldZJWS) (= #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) ))

注记高度代码的写法类似，注意高度使用getreal函数，并将
(initget 5 "  ")改为
(initget 7 "  ")，阻止0和负数输入
你自己写一下吧！

124350440

Gu_xl发表于2010-10-8 19:48:00将 以下内容为程序代码: (setq #ZJWS# (getint \"\n输入注记位数：\"))

Gu_xl

修改后代码：

3. (defun c:mjqh1 (/ pt1 pt2 zg mj zmj ss LastEntity LastEntity1 gxl-Sel-EntNextAll ssaddsel )
4.   (setierr)
5.   ;(initArea)
6.   ;;;gxl-Sel-EntNextAll en 返回 en 之后的所有物体选择集，无则返回 nil
7. (defun gxl-Sel-EntNextAll (ent / ss ent1)
8.   (setq ss (ssadd))
9.   (while (setq ent1 (entnext ent))
10.     (ssadd ent1 ss)
11.     (setq ent ent1)
12.     )
13.   (if (= 0 (sslength ss))
14.     nil
15.     ss
16.     )
17.   )
18. ;把选择集1中的图元加入到选择集2中
19. (defun ssaddsel (ss1 ss2 / n k)
20.    (setq n (sslength ss1)
21.   k 0)
22.   (if (> n 0)
23.     (while (setq ent (ssname ss1 k))
24.        (ssadd ent ss2)
25.        (setq k (1+ k))
26.       )
27.     )
28.   (setq ss2 ss2)
29. )
30. ;;;gxl-MakeText1 生成文字函数,参数： 标注点 字高 宽比 旋转角 倾角，角度单位：度
31. (defun gxl-MakeText1 (xy Txt ZG KB XZ Qj / xyL TxtL ZGL KBL XZL QJL)
32.    (setq xy (trans xy 1 0));;;坐标换算为世界坐标
33.    (SETQ XZ (gxl-Num-DtoR (gxl-Num-Angle->Wcs XZ )))
34.       (setq xyL  (cons 10 xy)
35.      TxtL (cons 1 Txt)
36.      ZGL  (cons 40 ZG)
37.      KBL  (cons 41 KB)
38.      XZL  (cons 50 XZ)
39.      QJL  (cons 51 (gxl-Num-DtoR QJ))
40.       )
41.       (setq TextL (list '(0 . "TEXT")
42.    '(67 . 0)
43.    '(100
44.      .
45.      "AcDbText"
46.     )
47.    xyL
48.    ZGL
49.    TxtL
50.    XZL
51.    KBL
52.    QJL
53.    '(7 . "standard")
54.     )
55.       )
56.       (entmake TextL)
57.     )
58. ;;;程序开始
59.   (setq zmj 0)
60.   ;(setq #ZJWS# (getint "\n输入注记位数："))
61.   ;(if (not(= 'INT (type #ZJWS#))) (setq #ZJWS# 3))
62.   (setq oldZJWS #ZJWS#)
63. (initget 5 "  ")
64. (if #ZJWS# (setq #ZJWS# (getint (strcat "\n 输入注记位数<" (itoa #ZJWS#) ">:")))
65. (setq #ZJWS# (getint "\n 输入注记位数<3>："))
66. )
67. (if (and oldZJWS (= #ZJWS# "")) (setq #ZJWS# oldZJWS)
68. (if (and (not oldZJWS) (= #ZJWS# "")) (setq #ZJWS# 3) ))
69. (setq oldZJWS #ZJWS#)
70.   ;(setq mjHeight (getreal "\n输入注记高度："))
71.   ;(if (not(or (= 'INT (type mjHeight))(= 'REAL (type mjHeight)))) (setq mjHeight 1.5))
72.   (setq oldZJGD mjHeight)
73. (initget 7 "  ")
74. (if mjHeight (setq mjHeight (getreal (strcat "\n 输入注记高度：<" (rtos mjHeight 2 2) ">:")))
75. (setq mjHeight (getreal "\n 输入注记高度<1.5>："))
76. )
77. (if (and oldZJGD (= mjHeight "")) (setq mjHeight oldZJGD)
78. (if (and (not oldZJGD) (= mjHeight "")) (setq mjHeight 3) ))
79. (setq oldZJGD mjHeight)
80.   (setq ss (ssadd))
81.    (while (= 'LIST (type
82.       (progn
83.                         (initget 7 "No  ")
84.                         (setq pt1 (getpoint "\n请选择中心点:"))
85.                         )
86.       )
87.      )
88.   (setq LastEntity (entlast))
89.   (while (progn
90.    ;(setq pt1 (getpoint "\n请输入中心点:"))
91.    (command "-boundary" pt1 "")
92.    (setq LastEntity1 (entlast))
93.    (equal LastEntity LastEntity1)
94.    )
95.     (setq pt1 (getpoint "\n请输入中心点:"))
96.     )
97.   (command "Area" "o" LastEntity1)
98.   ;(entdel (entlast))
99.     ; (ssadd LastEntity1 ss)
100.           (setq ss0 (GXL-SEL-ENTNEXTALL LastEntity))
101.      (setq ss (ssaddsel ss0 ss))
102.        (redraw LastEntity1 3)
103.   (setq mj (getvar "area"))
104.   ;|(if (= mjdw 1000)
105.     (setq mj (/ mj 1000000.0))
106.     )|;
107.      (princ (rtos mj 2 #ZJWS#))
108.      (setq mj (atof (rtos mj 2 #ZJWS#)))
109.   (setq zg mjHeight)
110.   
111.      (setq zmj (+ zmj mj))
112.      (princ (strcat "  当前总面积：" (rtos zmj 2 #ZJWS#)))
113.      ;;;注记文字
114.      (gxl-MakeText1 pt1 (rtos mj 2 #ZJWS#) zg 0.8 0 0 )
115.     (ssadd (entlast) ss)
116.   ;(setq mj (rtos mj 2 2))
117.   ;(gxl-MakeText pt1 mj zg 0.8 0 0)
118.      )
119.   (command "erase" ss "")
120.   (princ (strcat "\n 总面积为: " (setq zmj (rtos zmj 2 #ZJWS#))))
121.   (setq zmj (strcat " 总面积为: " zmj))
122.   (setq zg mjHeight)
123.   (initget 7 " ")
124.   (setq pt2 (getpoint "\n 选择注记位置："))
125.   (if (= 'List (type pt2))
126.       (gxl-MakeText1 pt2 zmj zg 0.8 0 0 )
127.     )
128.    
129.   (reerr)
130.   ;(princ)
131.   )

(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)   )