[求助]：如何快速求出路基横断面的填挖方面积

yansf

我用CAD2002画好了每20米桩的横断面的地面线和设计线，就差求出各个横断面的填挖方面积，我画地面线时用的时L命令，如果直接用AREA求面积要一个点一个点的围过去，有点麻烦，而且要几个面积相加时更不方便。有没有什么更简单的方法可用呢？或哪里有二次开发的CAD小程序可以解决这个问题？

ch007

(DEFUN C:MA( / PT NAME HIGH-TEXT AREA-TEXT XX YY CHAR NO-CHAR)                              
                                                                                             
  (SETQ PT "" NAME nil HIGH-TEXT nil AREA-TEXT nil)                                          
  (IF (= (SUBSTR (GETVAR "ACADVER") 1 2) "16")                                               
     (SETQ HIGH-TEXT (GETREAL "標示字高 <1.0> : "))                                          
     (SETQ HIGH-TEXT (GETREAL "TEXT Height <1.0> : "))                                       
  );; IF                                                                                    
  (IF (NOT HIGH-TEXT) (SETQ HIGH-TEXT 1.0))                                                  
                                                                                             
  (WHILE PT                                                                                 
     (IF (= (SUBSTR (GETVAR "ACADVER") 1 2) "16")                                            
         (SETQ PT (GETPOINT "標示位置 : "))                                                  
         (SETQ PT (GETPOINT "Pick Point For Mark : "))                                       
     );; IF                                                                                 
     (SETQ XX (CAR PT))                                                                     
     (SETQ YY (CADR PT))                                                                     
     (IF (= (SUBSTR (GETVAR "ACADVER") 1 2) "16")                                            
         (SETQ NAME (BPOLY PT))                                                              
         (SETQ NAME (C:BPOLY PT))                                                            
     );; IF                                                                                 
     (IF NAME                                                                                
         (PROGN                                                                              
            (COMMAND "REDRAW")                                                               
            (COMMAND "AREA" "E" NAME)                                                        
            (SETQ TEXT-AREA (STRCAT (RTOS (GETVAR "AREA") 2 2) "M"))                        
            (SETQ I 1 NO-CHAR 0)                                                            
            (WHILE (AND (SETQ CHAR (SUBSTR TEXT-AREA I 1)) (/= CHAR ""))                     
               (SETQ NO-CHAR (+ NO-CHAR 1) I (+ I 1))                                       
            );; WHILE                                                                        
            (ENTMAKE (LIST (CONS 0 "TEXT")                                                   
                           (LIST 10                                                         
                                 (- XX (* HIGH-TEXT (/ NO-CHAR 2.0)) (/ HIGH-TEXT 2.0))      
                                 (- YY (/ HIGH-TEXT 2.0))                                    
                           );; LIST                                                         
                           (CONS 40 HIGH-TEXT)                                               
                           (CONS 1 TEXT-AREA)                                                
                           (CONS 71 0)                                                      
                           (CONS 72 4)                                                      
                           (CONS 11 PT)                                                      
                     );; LIST                                                               
            );; ENTMAKE                                                                     
            (ENTMAKE (LIST (CONS 0 "TEXT")                                                   
                           (LIST 10                                                         
                                 (+ XX (* (+ NO-CHAR 1.0) (/ HIGH-TEXT 2.0)))               
                                 (+ YY (* HIGH-TEXT 0.5))                                    
                           );; LIST                                                         
                           (CONS 40 (/ HIGH-TEXT 2.0))                                       
                           (CONS 1 "2")                                                      
                           (CONS 71 0)                                                      
                           (CONS 72 4)                                                      
                           (LIST 11                                                         
                                 (+ XX (* HIGH-TEXT (/ NO-CHAR 2.0)))                        
                                 (+ YY (* HIGH-TEXT 0.75))                                   
                           );; LIST                                                         
                     );; LIST                                                               
            );; ENTMAKE                                                                     
            (ENTDEL NAME)                                                                    
         );; PROGN                                                                           
     );; IF                                                                                 
  );; WHILE                                                                                 
);;

linvv

二楼的DX，怎么用能否说明一下下，我是只菜鸟，呵呵......

yansf

怎么使用，源程序我看不懂，可不可以把它转为应用程序后在重新上传呢？谢谢

wcost2000

我也一直在找这样的东东。海地。纬地里都有。但是。那些软件要设置一大堆东西。LISP我看不懂。