【求大神修改一下源码 要求：填充完一个图案 在命令行输出一次填充的面积

yjpyjp

(defun C:tt (/ s1 s2)
  (setvar "cmdecho" 0)
  (setvar "OSMODE" 0)
  (setvar "MEASUREINIT" 1)
  (setvar "MEASUREMENT" 1)
  (setvar "hpassoc" 1)   ;控制填充图案是否关联(1:是；0:否)
  (princ
    "\n快捷填充，请选择填充区域：(跳过则为拾取内部点填充）"
  )
  (if (setq s1 (ssget))
     (progn
       (while(/= s1 nil)
         (progn
    (command "layer"  "m"      "TJ-填充统计"
      "c"  "11"      ""   "lw"
      "0.13"  ""      "l"  "Continuous"
      ""   ""      "_.bhatch"  "p"
      "SOLID"  "40"      "45"  "s"
      s1          ""      ""
     )(princ "\n请选择填充...")
      (setq s1 (ssget))
      )(print)
     )
       )
    (progn
      (princ "\n请拾取填充内部点：")
      (setq dian (getpoint))
      (while(/= dian nil)
        (progn
          (IF (vl-cmdf "layer"  "m"      "TJ-填充统计"
      "c"  "11"      ""   "lw"
      "0.13"  ""      "l"  "Continuous"
      ""   ""
             "_.bhatch" dian "p"  "SOLID" "40" "95" "")
     (princ "\n请选择填充...")
     )(setq dian (getpoint))
          )(print)
        )
      )
  )
(princ)
)

yjpyjp

yjpyjp

求来个热心群众

xyp1964

1. (defun c:tt ()
   
2.   (defun abc ()
   
3.     (princ "\n填充面积 = ")
   
4.     (princ (rtos (vla-get-area (vlax-ename->vla-object (entlast))) 2 2))
   
5.   )
   
6.   (setvar "hpassoc" 1)
   
7.   (command "layer" "m" "TJ-填充统计" "c" "11" "" "")
   
8.   (princ "\n选择填充区域<退出改选点>: ")
   
9.   (if (setq s1 (ssget))
   
10.     (while s1
    
11.       (command "_.bhatch" "p" "SOLID" "s" s1 "" "")
    
12.       (abc)
    
13.       (princ "\n请选择填充<退出>: ")
    
14.       (setq s1 (ssget))
    
15.     )
    
16.     (while (setq dian (getpoint "\n请拾取填充内部点<退出>: "))
    
17.       (command "_.bhatch" dian "p" "SOLID" "")
    
18.       (abc)
    
19.     )
    
20.   )
    
21.   (princ)
    
22. )

(defun c:tt ()<br />   (defun abc ()<br />     (princ "\n填充面积 = ")<br />     (princ (rtos (vla-get-area (vlax-ename->vla-object (entlast))) 2 2))<br />   )<br />   (setvar "hpassoc" 1)<br />   (command "layer" "m" "TJ-填充统计" "c" "11" "" "")<br />   (princ "\n选择填充区域<退出改选点>: ")<br />   (if (setq s1 (ssget))<br />     (while s1<br />       (command "_.bhatch" "p" "SOLID" "s" s1 "" "")<br />       (abc)<br />       (princ "\n请选择填充<退出>: ")<br />       (setq s1 (ssget))<br />     )<br />     (while (setq dian (getpoint "\n请拾取填充内部点<退出>: "))<br />       (command "_.bhatch" dian "p" "SOLID" "")<br />       (abc)<br />     )<br />   )<br />   (princ)<br /> )