求面积计算lsp

inhoo

就是这样的功能：步骤
1：在cad里面画条PL线，将其放在“基底面积”图层上。
2：同样再画条PL线，将其放在“住宅建筑面积”图层上。
3：用某个命令（就是要求LSP程序），直接到入excel中。
结果是：基底面积           （面积)
              住宅建筑面积     （面积)

inhoo

自己先顶一个

革天明

你去看看我的一个代码，你修改下

inhoo0

革天明 发表于 2011-10-6 08:11
你去看看我的一个代码，你修改下

你的代码在哪里呀

革天明

;;;面积求和
;YTM,2011.2
(defun c:DE(/ OS-OLD SS1 NR1 TOT_AREA1 EN1 TXT1 SS2 NR2 TOT_AREA2 EN2 TXT2 TMP Y M D TXT012 FP MY001 MJN TXT001 KEHUHAO

SHAHAO JT ZHONGGUO EN001 P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 P13 SPOINT MJ SS11 SS12 SS13)
(SETQ OS-OLD(GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(command "-style" "mystyle" "Times New Roman" 5 1 0 "N" "N")
;--------------------------------------------------------------
  (PROMPT "\n请选择第一部分的面积")
  ;(if (setq ss1 (ssget '((0 . "*LINE,CIRCLE,ELLIPSE,REGION"))))
  ;去掉这些限定可以选择实体了，以前选择不了实体
  (if (setq ss1 (ssget '()))
    (progn
      (setq nr1             0
            tot_area1 0.0
            en1             (ssname ss1 nr1)
            TXT1     ""
      )
      (while en1
        (command "._area" "_O" en1)
        (setq tot_area1 (+ tot_area1 (ATOF(RTOS (getvar "area") 2 2)))
              nr1       (1+ nr1)
              en1       (ssname ss1 nr1)
              TXT1      (STRCAT TXT1 "+" (RTOS (getvar "area") 2 2) )
        )
      )
      
    )
  )
;-------------------------------------------------------------
  (PROMPT "\n请选择第二部分的面积")
  (if (setq ss2 (ssget '()))
    (progn
      (setq nr2             0
            tot_area2 0.0
            en2             (ssname ss2 nr2)
            TXT2     ""
      )
      (while en2
        (command "._area" "_O" en2)
        (setq tot_area2 (+ tot_area2 (ATOF(RTOS (getvar "area") 2 2)))
              nr2       (1+ nr2)
              en2       (ssname ss2 nr2)
              TXT2      (STRCAT TXT2 "+" (RTOS (getvar "area") 2 2) )
        )
      )
      
    )
  )
  ;------------------------------------------------------------------
  ;itoa函数将一个【整数】转换成【字符串】，并将该字符串返回
  ;rtos函数将一个【实数】转换成【字符串】,并将该字符串返回
  ;atof将一个【字符串】转换成【实数】,并将该字符串返回
  ;strcat将多个字符串拼接成一个长字符串后返回
  ;substr将一个字符串按要求取出其中的字符
(setq        tmp (rtos (getvar "cdate") 2 8)          ;用于生成制图日期
        y   (rtos (atof (substr tmp 1 4)) 2 0)
        m   (rtos (atof (substr tmp 5 2)) 2 0)
        d   (rtos (atof (substr tmp 7 2)) 2 0)
        txt012 (strcat "日期：" y "年" m "月" d "日")
  )

;--------------------------------------------------------------------------------
(SETQ spoint (GETPOINT "\012请选择放置点：")
               
        tp     (list (car spoint) (- (cadr spoint) 8))
        ddp    (list (car tp) (- (cadr tp) 8))
        RQP    (list (car DDp) (- (cadr DDp) 8))
        MYTXT001P    (list (car RQP) (- (cadr RQP) 2))
        CKDLP  (list (car RQp) (- (cadr RQp) 8))
    )
   (SETQ MJ (RTOS(- tot_area1 tot_area2)))
   (SETQ SS11 (STRCAT "S1=" (SUBSTR TXT1 2)))
   (SETQ SS12 (STRCAT "S2=" (SUBSTR TXT2 2)))
   (SETQ SS13 (STRCAT "S=" MJ))
   ;(COMMAND "_STYLE" "USER3" "TXT.SHX,GBCBIG.SHX" "5" "1" "0" "N" "N" "N" )
   (command "-style" "mystyle" "Times New Roman" 5 1 0 "N" "N")
    ;---------------------------------------------------------------
   (if (> (cdr(assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0)
   (command "text" spoint "" SS11 "text" "" SS12
            "text" "" SS13 "text" "" TXT012 "text" "" CKDL)
   (command "text" spoint "5" "" SS11 "text" "" SS12
            "text" "" SS13 "text" "" TXT012 "text" "" CKDL)
   )
   ;---------------------------------------------------------------

   (command "text" spoint "5" "" SS11)
   (command "text" tp "" "" SS12)
   (command "text" ddp "" "" SS13)
   (command "text" RQp "" "" TXT012)
   (command "text" CKDLp "" "" CKDL)
   (PRINC (- tot_area1 tot_area2))
   (SETVAR "OSMODE" 16383)

   (PRINC)
   (GC)
);命令完成

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

inhoo0

谢谢 研究一哈  

潘阳科

想法很好，顶起