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

124350440 · 发表于 2010-10-9 18:20

多谢Gu_xl不厌其烦的解答，不过运行时还是需要输入小数位和字高啊

Gu_xl · 发表于 2010-10-9 19:32

(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) (initget 5 " ") (if (not #ZJWS#)(setq #ZJWS# (getint "\n 输入注记位数<3>：")) ) (if (= #ZJWS# "") (setq #ZJWS# 3)) (initget 7 " ") (if (not mjHeight) (setq mjHeight (getreal "\n 输入注记高度<1.5>：")) ) (if (= mjHeight "") (setq mjHeight 1.5)) (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) )

(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)   (initget 5 "  ") (if (not #ZJWS#)(setq #ZJWS# (getint "\n 输入注记位数<3>：")) ) (if (= #ZJWS# "") (setq #ZJWS# 3)) (initget 7 "  ") (if (not mjHeight)  (setq mjHeight (getreal "\n 输入注记高度<1.5>：")) ) (if (= mjHeight "") (setq mjHeight 1.5))   (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)   )

124350440 · 发表于 2010-10-10 09:31

想送很多鲜花给Gu_xl ，真的很感谢，可以用了！

Gu_xl · 发表于 2010-10-11 23:11

对你有帮助就好了！

461045462 · 发表于 2010-10-13 07:19

谢谢Gu_xl

看见你的

对你有帮助就好了！

感受不少。

从中又学到了不少东西。

也谢谢明经，让我懂得了不少东西

账号		自动登录	找回密码
密码			注册