[编程申请]：請曉東幫忙修改

skevin1 · 发表于 2002-12-12 10:47:57

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

命令：XDTB_HatchArea
功能：求填充HATCH和SOLID實體的面積
|;
(defun c:XDTB_HatchArea (/ ss harea e hnum snum tf i)
(if (not $XDTB_HATCH_TOTAL_AREA)
(setq $XDTB_HATCH_TOTAL_AREA 0.0)
)
(while (progn
(initget "C")
(setq sel (getkword (strcat "\n{歷史記錄: " (rtos $XDTB_HATCH_TOTAL_AREA
2 2
)
" | 歷史清空[C]}<繼續>:"
)
)
)
)
(cond
((= sel "C")
(setq $XDTB_HATCH_TOTAL_AREA 0.0)
)
)
)
(prompt "\n請選取計算面積的Hatch,Solid實體[ALL-全選]<退出>:")
(if (setq ss (ssget '((0 . "hatch,solid"))))
(progn
(xdrx_setsstodb ss 0)
(setq harea 0
hnum 0
snum 0
)
(setq tf (> (setq len (sslength ss))
100
)
)
(if tf
(progn
(xdrx_pbarbegin "計算中..." len)
(setq i 0
eNum 0
lNum 0
)
)
)
(while (setq e (xdrx_getentdata 0))
(if tf
(xdrx_pbarsetpos (setq i (1+ i)))
)
(setq enttype (xdrx_getentdxf 0))
(cond
((= "SOLID" enttype)
(setq ss1 (ssadd)
ss1 (ssadd e ss1)
snum (+ snum 1)
)
(setq harea (+ harea (abs (apply
'xdrx_parea
(car (xdrx_searchoutline ss1))
)
)
)
)
)
((= "HATCH" enttype)
(setq hnum (+ hnum 1)
harea (+ harea (car (xdrx_getarea e)))
)
)
)
)
(if tf
(xdrx_pbarend)
)
(setq $XDTB_HATCH_TOTAL_AREA (+ $XDTB_HATCH_TOTAL_AREA harea))
(prompt (strcat "\n共選取了 " (itoa hnum) " 個Hatch, " (itoa snum)
" 個Solid,面積總和是：" (rtos harea 2 2)
" 歷史記錄總和是: " (rtos $XDTB_HATCH_TOTAL_AREA 2 2)
)
)
)
)
(princ)
)

命令：XDTB_HatchArea 
  功能：求填充HATCH和SOLID實體的面積 
|; 
(defun c:XDTB_HatchArea (/ ss harea e hnum snum tf i) 
  (if (not $XDTB_HATCH_TOTAL_AREA) 
    (setq $XDTB_HATCH_TOTAL_AREA 0.0) 
  ) 
 
  (while (progn 
           (initget "C") 
           (setq sel (getkword (strcat "\n{歷史記錄: " (rtos $XDTB_HATCH_TOTAL_AREA 
                                                             2 2 
                                                       ) 
                                       " | 歷史清空[C]}<繼續>:" 
                               ) 
                     ) 
           ) 
         ) 
    (cond 
      ((= sel "C") 
        (setq $XDTB_HATCH_TOTAL_AREA 0.0) 
      ) 
    ) 
  ) 
  (prompt "\n請選取計算面積的Hatch,Solid實體[ALL-全選]<退出>:") 
  (if (setq ss (ssget '((0 . "hatch,solid")))) 
    (progn 
      (xdrx_setsstodb ss 0) 
      (setq harea 0 
            hnum 0 
            snum 0 
      ) 
      (setq tf (> (setq len (sslength ss)) 
                  100 
               ) 
      ) 
      (if tf 
        (progn 
          (xdrx_pbarbegin "計算中..." len) 
          (setq i 0 
                eNum 0 
                lNum 0 
          ) 
        ) 
      ) 
      (while (setq e (xdrx_getentdata 0)) 
        (if tf 
          (xdrx_pbarsetpos (setq i (1+ i))) 
        ) 
        (setq enttype (xdrx_getentdxf 0)) 
        (cond 
          ((= "SOLID" enttype) 
 
            (setq ss1 (ssadd) 
                  ss1 (ssadd e ss1) 
                  snum (+ snum 1) 
            ) 
            (setq harea (+ harea (abs (apply 
                                        'xdrx_parea 
                                        (car (xdrx_searchoutline ss1)) 
                                      ) 
                                 ) 
                        ) 
            ) 
          ) 
          ((= "HATCH" enttype) 
            (setq hnum (+ hnum 1) 
                  harea (+ harea (car (xdrx_getarea e))) 
            ) 
          ) 
        ) 
      ) 
      (if tf 
        (xdrx_pbarend) 
      ) 
      (setq $XDTB_HATCH_TOTAL_AREA (+ $XDTB_HATCH_TOTAL_AREA harea)) 
      (prompt (strcat "\n共選取了 " (itoa hnum) " 個Hatch, " (itoa snum) 
                      " 個Solid,面積總和是：" (rtos harea 2 2) 
                      " 歷史記錄總和是: " (rtos $XDTB_HATCH_TOTAL_AREA 2 2) 
              ) 
      ) 
    ) 
  ) 
  (princ) 
)

是否能夠把
" 個Solid,面積總和是：" (rtos harea 2 2)
" 歷史記錄總和是: " (rtos $XDTB_HATCH_TOTAL_AREA 2 2)
直接輸出至螢幕且除上一定數(譬如/100000)+單位(M)
不勝感激

eachy · 发表于 2002-12-12 12:09:05

将最后的这样改下，注意保存避免工具箱升级时覆盖掉：

(setq $XDTB_HATCH_TOTAL_AREA (+ $XDTB_HATCH_TOTAL_AREA harea))
;|(prompt (strcat "\n共選取了 "
(itoa hnum)
" 個Hatch, "
(itoa snum)
" 個Solid,面積總和是："
(rtos harea 2 2)
" 歷史記錄總和是: "
(rtos $XDTB_HATCH_TOTAL_AREA 2 2)
)
)|;
(setq p0 (getpoint "\nInsert Point: "))
(entmake (list '(0 . "Text")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 p0)
(cons 1
(strcat (itoa snum)
" 個Solid,面積總和是："
(rtos (/ harea 100000) 2 2)
)
)
(cons 40 (getvar "textsize"))
'(50 . 0)
)
)
(entmake
(list '(0 . "Text")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (polar p0 (/ pi 2) (* 1.5 (getvar "textsize"))))
(cons 1
(strcat "歷史記錄總和是: "
(rtos (/ $XDTB_HATCH_TOTAL_AREA 100000) 2 2)
)
)
(cons 40 (getvar "textsize"))
'(50 . 0)
)
)

(setq $XDTB_HATCH_TOTAL_AREA (+ $XDTB_HATCH_TOTAL_AREA harea)) 
 ;|(prompt        (strcat        "\n共選取了 " 
                (itoa hnum) 
                " 個Hatch, " 
                (itoa snum) 
                " 個Solid,面積總和是：" 
                (rtos harea 2 2) 
                " 歷史記錄總和是: " 
                (rtos $XDTB_HATCH_TOTAL_AREA 2 2) 
        ) 
)|; 
(setq p0 (getpoint "\nInsert Point: ")) 
(entmake (list '(0 . "Text") 
               '(100 . "AcDbEntity") 
               '(100 . "AcDbText") 
               (cons 10 p0) 
               (cons 1 
                     (strcat (itoa snum) 
                             " 個Solid,面積總和是：" 
                             (rtos (/ harea 100000) 2 2) 
                     ) 
               ) 
               (cons 40 (getvar "textsize")) 
               '(50 . 0) 
         ) 
) 
(entmake 
  (list        '(0 . "Text") 
        '(100 . "AcDbEntity") 
        '(100 . "AcDbText") 
        (cons 10 (polar p0 (/ pi 2) (* 1.5 (getvar "textsize")))) 
        (cons 1 
              (strcat "歷史記錄總和是: " 
                      (rtos (/ $XDTB_HATCH_TOTAL_AREA 100000) 2 2) 
              ) 
        ) 
        (cons 40 (getvar "textsize")) 
        '(50 . 0) 
  ) 
)

skevin1 · 发表于 2002-12-12 12:58:10

感謝.................................
:6

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

[编程申请]：請曉東幫忙修改

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

Re: [编程申请]：請曉東幫忙修改