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

124350440 · 发表于 2010-9-30 08:13

本帖最后由作者于 2010-10-7 10:16:00 编辑

如图，计算出1、3、5的图形面积之和标注在指定地点

Gu_xl · 发表于 2010-9-30 09:33

(defun c:mjqh1 (/ pt1 pt2 zg mj zmj ss LastEntity LastEntity1 gxl-Sel-EntNextAll ssaddsel #ZJWS# mjHeight)
;(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 mjHeight (getreal "\n输入注记高度："))
(if (not(or (= 'INT (type mjHeight))(= 'REAL (type 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 #ZJWS# mjHeight)
  ;(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 mjHeight (getreal "\n输入注记高度："))
  (if (not(or (= 'INT (type mjHeight))(= 'REAL (type 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)
  )

461045462 · 发表于 2010-9-30 11:52

2楼的运行后，出现

命令: mjqh1
输入注记位数：
输入注记高度：
请选择中心点:-boundary
指定内部点或 [高级选项(A)]: 正在选择所有对象...
正在选择所有可见对象...
正在分析所选数据...
正在分析内部孤岛...
指定内部点或 [高级选项(A)]:
BOUNDARY 已创建 1 个多段线
命令: Area
指定第一个角点或 [对象(O)/加(A)/减(S)]: o
选择对象:
面积 = 927.8424，周长 = 125.1786
命令: 927.842 当前总面积：927.842; 错误: no function definition:
GXL-NUM-ANGLE->WCS

请问要如何操作？望指教。

谢谢

124350440 · 发表于 2010-9-30 16:44

怎么执行不了啊？

Gu_xl · 发表于 2010-9-30 22:36

补上几个自定义函数，看还缺函数么？

;;;==================================================================
;;;gxl-Num-RtoD 弧度转为度数，十进制
;;;==================================================================
(defun gxl-Num-RtoD (dat /)
(* 180.0 (/ dat pi))
)
;;;==================================================================
;;;gxl-Num-DtoR 度数转为弧度，十进制
;;;==================================================================
(defun gxl-Num-DtoR (JD / a)
(setq a (/ (* jd pi) 180.0))
)
;;;获取自定义坐标系的旋转角度函数
(defun gxl-GetUcsRotateAngle ()
(if (= 0 (CAR (GETVAR "UCSXDIR")))
(if (> (CADR (GETVAR "UCSXDIR")) 0) (/ pi 2.0) (/ pi -2.0))
(if (< (CAR (GETVAR "UCSXDIR")) 0)
(+ pi (ATAN (/ (CADR (GETVAR "UCSXDIR")) (CAR (GETVAR "UCSXDIR")))))
(ATAN (/ (CADR (GETVAR "UCSXDIR")) (CAR (GETVAR "UCSXDIR"))))
)
)
)
;;;gxl-Num-Angle->Wcs 角度换算为世界坐标角度，角度单位为度，返回度
(defun gxl-Num-Angle->Wcs (a)
(+ (gxl-Num-RtoD (gxl-GetUcsRotateAngle)) a )
)

461045462 · 发表于 2010-10-1 06:40

5楼的先收下了。

等会试一试。

谢谢Gu_xl

国庆快乐

124350440 · 发表于 2010-10-7 10:16

能否修改下面的程序为：拾取一个或多个图形内部点后标注面积之和到指定地点 (defun C:d (/ HOLDCMD HOLDZIN PNT LENT) (vl-load-com) (setq HOLDCMD (getvar "cmdecho")) (setq HOLDZIN (getvar "dimzin")) (setvar "cmdecho" 0) (defun DO_IT () (setvar "dimzin" 0) (setq PNT1 (getpoint "\n点选文字起点: ")) (command "_.text" PNT1 1 ;;这里的1改字高 "" (strcat "" (rtos ENT 2 3);;这里的3改小数位数 ) ) (setvar "dimzin" HOLDZIN) ) (while (if (= PNT NIL) (setq PNT (getpoint "\n点选内部点: ")) PNT ) (setq LENT (entlast)) (command "_.boundary" "a" "i" "y" "" PNT "") (if (not (equal (entlast) LENT)) (progn (setq ENT (vla-get-area (vlax-ename->vla-object (entlast)))) (while (not (equal (entlast) LENT)) (entdel (entlast)) ) (DO_IT) ) ) (setq PNT NIL) ) (setvar "cmdecho" HOLDCMD) (princ) )

Gu_xl · 发表于 2010-10-7 14:06

能否修改下面的程序为：拾取一个或多个图形内部点后标注面积之和到指定地点
(defun C:d (/ HOLDCMD HOLDZIN PNT LENT)
(vl-load-com)

我给的程序就是你要的！点取多个图形内部后，按回车键，选择标注的位置，标注完后之前在各个图形内部显示的面积会自动删除！

124350440 · 发表于 2010-10-7 16:25

非常感谢，已经解决了，就是执行到最后是不是有写不顺畅，能否优化一下呢

Gu_xl · 发表于 2010-10-7 19:34

124350440发表于2010-10-7 16:25:00非常感谢，已经解决了，就是执行到最后是不是有写不顺畅，能否优化一下呢

怎么不顺畅，说具体点...

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

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

本帖子中包含更多资源

评分