[转帖]完善实时显示钢筋面积源码

hdlyt11 · 发表于 2010-8-25 09:43:00

在网上看到这段源码，我觉得对在设计院工作做结构的还是蛮有用处的，但是源码里面有不少错误，自己试着更了一下，还剩几个警告和错误没有处理掉，求高手帮忙看一下。
源码如下：

(DEFUN C:mmkl ()
(SETQ SS (SSGET "X" '((0 . "TEXT")))
I 0)
(REPEAT (SSLENGTH SS)
(SETQ ENT (ENTGET (SSNAME SS I))
STR (CDR (ASSOC 1 ENT))
SL (STRLEN STR)
J 1 I (I 1))
(IF (AND (NOT (WCMATCH STR "*/*")) (WCMATCH STR "*!*")) (PROGN
(WHILE (AND (= (SETQ ST (SUBSTR STR J 1)) "0") (= (SETQ ST (SUBSTR STR J 1)) "0") (= (/ pi 2) ang 0) (list pi ( pi (/ pi 2)) 1))
((>= pi ang (/ pi 2)) (list 0 ( pi (/ pi 2)) 1))
((>= ( pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
((>= (* 2 pi) ang ( pi (/ pi 2))) (list pi (/ pi 2) 0))
)
)
)
)
)
(defun add_solid(p1 p2 p3 p4)
(entmakex (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 62 250) (cons 100 "AcDbTrace")
(cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)
)
)
)
(defun add_text(pt h ang txt style jus)
(entmakex (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 2) (cons 100 "AcDbText") (if (= jus 0) (cons 10 pt) (list 10 0.0 0.0 0.0)) (cons 40 h)
(cons 1 txt) (cons 50 ang) (cons 7 style) (cons 72 (cond ((= jus 0) 0) ((= jus 1) 1) ((= jus 2) 1) ((= jus 3) 2))) (if (= jus 0)
(list 11 0.0 0.0 0.0) (cons 11 pt)) (cons 100 "AcDbText") (cons 73 (cond ((= jus 0) 0) ((= jus 1) 2) ((= jus 2) 3) ((= jus 3) 2)))
)
)
)
(defun dis (ent / obj laynm name st1 st2 st3 lst h ang n)
(setq obj (vlax-ename->vla-object ent))
(setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 1))
;;;;;;首先取得文字容
;(setq tc_txt (vla-get-textstring obj))
(cond
((wcmatch (STRCASE (dxf ent 1)) "#`%`[0-4]##,##`%`[0-4]##,##`%`[0-4]##")
(progn
;(setq tc_mj (tc_tctc1 name))
(setq lst (list "====纵筋面积====" laynm
;(strcat "钢筋标注:" (vla-get-textstring obj))
(strcat "钢筋面积:" (rtos (/ (tc_tctc1 (vla-get-textstring obj)) 100) 2 3)) "cm^2"
;(strcat "钢筋面积:" (rtos (vla-get-ScaleFactor obj) 2 1))
))
)
)
((wcmatch (STRCASE (dxf ent 1)) "#`%`[0-4]##/#`%`[0-4]##,#`%`[0-4]##/##`%`[0-4]##,##`%`[0-4]##/#`%`[0-4]##;##`%`[0-4]##/##`%`[0-4]##")
(progn
(setq lst (list "====纵筋面积====" laynm
;(strcat "钢筋标注:" (vla-get-textstring obj))
(strcat "钢筋面积:" (rtos (/ (tc_tctc2 (vla-get-textstring obj)) 100) 2 3)) "cm^2"
))
)
)
((wcmatch (STRCASE (dxf ent 1)) "`%`*[50-250]")
(progn
(setq lst (list "====板筋面积====" laynm
;(strcat "钢筋标注:" (vla-get-textstring obj))
(strcat "钢筋面积:" (rtos (tc_tctc3 (vla-get-textstring obj)) 2 3)) "mm^2"
))
)
)
;;;;调试部分
((wcmatch (STRCASE (dxf ent 1)) "`%`*[50-250]`(*`)")
(progn
(setq lst (list "====箍筋面积====" laynm
;(strcat "钢筋标注:" (vla-get-textstring obj))
(strcat "钢筋面积:" (rtos(/ (tc_tctc5 (vla-get-textstring obj)) 100) 2 3) "/"
(rtos (/ (/ (* (tc_tctc5 (vla-get-textstring obj)) tc_t8)tc_t9a) 100) 2 3)) "cm^2"
))
)
)
;;;;调试部分
((wcmatch (STRCASE (dxf ent 1)) "#`%`[0-4]## #`%`[0-4]##,#`%`[0-4]## ##`%`[0-4]##,##`%`[0-4]## #`%`[0-4]##;##`%`[0-4]## ##`%`[0-4]##")
(progn
(setq lst (list "====纵筋面积====" laynm
;(strcat "钢筋标注:" (vla-get-textstring obj))
(strcat "钢筋面积:" (rtos (/ (tc_tctc4 (vla-get-textstring obj)) 100) 2 3)) "cm^2"
))
)
)
);end cond
(setq ss (ssadd) h (/ (getvar "viewsize") 35))
(setq ang (fx (angle (getvar "viewctr") pt)))
(setq n (* 1.4 (1+ (/ (apply 'max (mapcar 'strlen lst)) 2.0))))
(ssadd (add_solid pt (polar pt (car ang) (* n h)) (setq pt (polar pt (cadr ang) ( h (* 1.8 h (length lst))))) (polar pt (car ang) (* n h))) ss)
(setq pt (polar pt (car ang) (/ (* n h) 2)))
(if (= (caddr ang) 0)
(setq pt (polar pt (/ pi 2) (* 0.4 h)))
(setq pt (polar pt (/ pi 2) ( (* 1.4 h) (* 1.8 h (length lst)))))
)
(setq n -1)
(repeat (length lst)
(ssadd (add_text (setq pt (polar pt ( pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (n 1)) lst) "钢筋显示" 1) ss)
)
(vl-load-com)
(command "_.undo" "_m")
(prompt "\n***移动鼠标掠过对象查看信息！***")
(setq olderr *error* *error* myerr)
(setq oldos (getvar "osmode"))
(setq oldfill (getvar "fillmode"))
(setvar "osmode" 0)
(setvar "fillmode" 1)
(setvar "cmdecho" 0)
(tc_jzhz)
(setq ss (ssadd))
(while (not pd)
(while (not (progn
(setq gr (grread T 1))
(if (= (car gr) 5)
(setq pt (cadr gr)
ent (nentselp pt)
ent (if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
(car ent)
)
)
(setq pd T)
)
))
)
(if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
(progn
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
(redraw ent 3)
(dis ent)
(setq entold ent)
)
)
)
(if entold (redraw entold 4))
(if ss (command "_.erase" ss ""))
(setvar "osmode" oldos)
(setvar "fillmode" oldfill)
(setq *error* olderr)
(princ)
)
(princ)
;;下列程序与这程序类似!
;;转贴自从XDCAD,作者忘了!是你嗎?
;;当鼠标移动到满足过滤条件的像素上时，像素会闪动
;;USAGECS_EntSel "\n请选Polyline物件: " '((0 . "*Polyline")))
(defun CS_ENTSEL (STR FILTER / PT SS_NAME SS)
(if (/= (type STR) 'STR)
(progn
(princ "\n变量类型不对，STR应为字符串。\n")
(eval NIL)
)
(progn
(if (/= (type FILTER) 'list)
(progn
(princ "\n变量类型不对，FILTER应为表。\n")
(eval NIL)
)
(progn
(princ STR)
(setq PT (grread t 4 2))
(while (/= 3 (car PT))
(if (= 5 (car PT))
(progn
(setq PT (cadr PT))
(setq SS (ssget PT FILTER))
(if SS_NAME
(redraw SS_NAME 4)
)
(setq SS_NAME NIL)
(if SS
(progn
(setq SS_NAME (ssname SS 0))
(redraw SS_NAME 3)
)
)
)
(setq PT (grread t 4 2))
)
)
(setq PT (cadr PT))
(setq SS (ssget PT FILTER))
(if SS_NAME
(redraw SS_NAME 4)
)
(setq SS_NAME NIL)
(if SS
(progn
(setq SS_NAME (ssname SS 0))
(list SS_NAME PT)
)
(eval CS_NAME)
)
)
)
)
)
)
(defun set-description (a d / b e)
(if (car (atoms-family 1 '("vl-load-com"))) (vl-load-com))
(setq a (vlax-ename->vla-object a))
(setq b (vla-get-Hyperlinks a))
(vlax-for item b
(vla-delete item)
)
(setq b (vla-get-Hyperlinks a))
(setq e (vla-add b "DescriptionOnly"))
(vla-put-URLDescription e d)
(command "redraw")
)
;;;;;;=========================================
;;;;;;tc_makestyle 加载字体并作当前字体样式====
;;;;;;=========================================
(defun tc_jzhz ()
(if (not (tblobjname "style" "钢筋显示"))
(entmake
'((0 . "STYLE")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbTextStyleTableRecord")
(2 . "钢筋显示")
(70 . 0)
(40 . 0)
(41 . 0.6)
(50 . 0)
(71 . 0)
(42 . 0.2)
(41 . 1)
(3 . "黑体")
;(4 . "常规")
)
)
)
(setvar "textstyle" "钢筋显示")
)
;;;;;;;;第一种钢筋面积显示已完成
(defun tc_tctc1 (txt3 / N1 t1 t2 TC_GJMJ1)
(setq n1 (vl-string-search "%" txt3)) ;在字符串中搜索指定子串的位置编号
(setq t1 (atoi (substr txt3 1 n1))
t2 (atoi (substr txt3 6 n1)))
(setq tc_gjmj1 (* t1 (/ (* t2 t2 3.1415926) 4)))
)
;;;;;;;
(defun tc_tctc2 (txt3 / N2 t3 t4 TC_GJMJ2)
(setq n2 (vl-string-search "/" txt3)) ;在字符串中搜索指定子串的位置编号
(setq t3 (substr txt3 1 n2)
t4 (substr txt3 2 n2))
(setq tc_gjmj2 ( (tc_tctc1 t3) (tc_tctc1 t4)))
)
;;;;;;
(defun tc_tctc3 (txt3 / N3 N4 T5 T6 TC_GJMJ3 )
(setq n3 (vl-string-search "%" txt3)) ;在字符串中搜索指定子串的位置号
(setq n4 (vl-string-search "@" txt3))
(setq t5 (atof (substr txt3 (1 n3) (1- n3)))
t6 (atof (substr txt3 (2 n4) (1- n4)))
)
(setq tc_gjmj3 (* (/ 1000 t6) (/ (* t5 t5 3.1415926) 4)))
)
;;;;;;
(defun tc_tctc4 (txt3 / N2 t3 t4 TC_GJMJ4)
(setq n2 (vl-string-search " " txt3)) ;在字符串中搜索指定子串的位置编号
(setq t3 (substr txt3 1 n2)
t4 (substr txt3 2 n2))
(setq tc_gjmj4 ( (tc_tctc1 t3) (tc_tctc1 t4)))
)
;;;;;;
(defun tc_tctc5 (txt3 / N5 N5A N6 N6A N7 N7A N8 N8A N9A TC_AREA1 TC_AREA2 TC_GJMJ5 TC_NUM1 TC_T10A TC_T7 TC_T7A TC_T9)
(setq tc_num1 (vl-string-search "/" txt3))
(if (= tc_num1 nil)
(progn
(setq n5 (vl-string-search "%" txt3)) ;在字符串中搜索指定子串的位置号
(setq n6 (vl-string-search "@" txt3))
(setq n7 (vl-string-search "(" txt3))
(setq n8 (vl-string-search ")" txt3))
(setq tc_t7 (atoi (substr txt3 (5 n5) (- n6 (5 n5)))))
(setq tc_t8 (atoi (substr txt3 (2 n6) (- n7 (1 n6))))
tc_t9 (atoi (substr txt3 (2 n7) (- n8 (1 n7))))
)
(setq tc_t9a tc_t8)
(setq tc_area1 (/ (* tc_t7 tc_t7 3.1415926) 4))
(setq tc_gjmj5 (/ (* tc_area1 200 tc_t9) tc_t8))
(if (>= tc_t7 10)
(setq tc_gjmj5 (/ (* tc_gjmj5 300) 210))
(setq tc_gjmj5 tc_gjmj5)
) ;_ 结束if
(progn
(setq n5a (vl-string-search "%" txt3)) ;在字符串中搜索指定子串的位置号
(setq n6a (vl-string-search "@" txt3))
(setq n7a (vl-string-search "/" txt3))
(setq n8a (vl-string-search "(" txt3))
(setq n9a (vl-string-search ")" txt3))
(setq tc_t7a (atoi (substr txt3 (6 n5a) (- n6a (5 n5a)))))
(setq tc_t8 (atoi (substr txt3 (2 n6a) (- n7a (1 n6a))))
tc_t9a (atoi (substr txt3 (2 n7a) (- n8a (1 n7a))))
tc_t10a (atoi (substr txt3 (2 n8a) (- n9a (1 n8a))))
)
(setq tc_area2 (/ (* tc_t7a tc_t7a 3.1415926) 4))
(setq tc_gjmj5 (/ (* tc_area2 200 tc_t10a) tc_t8))
(if (>= tc_t7a 10) (setq tc_gjmj5 (/ (* tc_gjmj5 300) 210)))
;(setq tc_gjmj6 (/ (* tc_area 200 tc_t10) tc_t9))
;(if (>= tc_t7 10) (setq tc_gjmj6 (/ (* tc_gjmj6 300) 210)))
)))
)

(DEFUN C:mmkl () 
(SETQ SS (SSGET "X" '((0 . "TEXT"))) 
       I 0) 
(REPEAT (SSLENGTH SS) 
  (SETQ ENT (ENTGET (SSNAME SS I)) 
       STR (CDR (ASSOC 1 ENT)) 
       SL (STRLEN STR) 
      J 1 I (I  1)) 
  (IF (AND (NOT (WCMATCH STR "*/*")) (WCMATCH STR "*!*")) (PROGN 
   (WHILE (AND (= (SETQ ST (SUBSTR STR J 1)) "0") (= (SETQ ST (SUBSTR STR J 1)) "0") (= (/ pi 2) ang 0) (list pi (  pi (/ pi 2)) 1))
     ((>= pi ang (/ pi 2)) (list 0 (  pi (/ pi 2)) 1))
    ((>= (  pi (/ pi 2)) ang pi) (list 0 (/ pi 2) 0))
     ((>= (* 2 pi) ang (  pi (/ pi 2))) (list pi (/ pi 2) 0))
   )
  )
)
  )
  )
  (defun add_solid(p1 p2 p3 p4)
    (entmakex (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 62 250) (cons 100 "AcDbTrace")
                    (cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4)
              )
    )
  )
  (defun add_text(pt h ang txt style jus)
    (entmakex (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 2) (cons 100 "AcDbText") (if (= jus 0) (cons 10 pt) (list 10 0.0 0.0 0.0)) (cons 40 h)
                    (cons 1 txt) (cons 50 ang) (cons 7 style) (cons 72 (cond ((= jus 0) 0) ((= jus 1) 1) ((= jus 2) 1) ((= jus 3) 2))) (if (= jus 0)
                    (list 11 0.0 0.0 0.0) (cons 11 pt)) (cons 100 "AcDbText") (cons 73 (cond ((= jus 0) 0) ((= jus 1) 2) ((= jus 2) 3) ((= jus 3) 2)))
              )
    )
  )
 
 
  
  (defun dis (ent / obj laynm name st1 st2 st3 lst h ang n)
    (setq obj (vlax-ename->vla-object ent))
    (setq laynm (strcat "图层:" (dxf ent 8)) name (dxf ent 1))
 
    ;;;;;;首先取得文字容
    ;(setq tc_txt (vla-get-textstring obj))
  (cond
      ((wcmatch (STRCASE (dxf ent 1)) "#`%`[0-4]##,##`%`[0-4]##,##`%`[0-4]##")
        (progn
          ;(setq tc_mj (tc_tctc1 name))
        (setq lst (list "====纵筋面积====" laynm
                        ;(strcat "钢筋标注:" (vla-get-textstring obj))
                        (strcat "钢筋面积:" (rtos (/ (tc_tctc1 (vla-get-textstring obj)) 100) 2 3)) "cm^2"
                         ;(strcat "钢筋面积:" (rtos (vla-get-ScaleFactor obj) 2 1))
                                        
        ))
      )
      )
      ((wcmatch (STRCASE (dxf ent 1)) "#`%`[0-4]##/#`%`[0-4]##,#`%`[0-4]##/##`%`[0-4]##,##`%`[0-4]##/#`%`[0-4]##;##`%`[0-4]##/##`%`[0-4]##")
        (progn
        (setq lst (list "====纵筋面积====" laynm
                        ;(strcat "钢筋标注:" (vla-get-textstring obj))
                        (strcat "钢筋面积:" (rtos (/ (tc_tctc2 (vla-get-textstring obj)) 100) 2 3)) "cm^2"
                                        
        ))
      )
      )
 
      
      ((wcmatch (STRCASE (dxf ent 1)) "`%`*[50-250]")
        (progn
        (setq lst (list "====板筋面积====" laynm
                        ;(strcat "钢筋标注:" (vla-get-textstring obj))
                        (strcat "钢筋面积:" (rtos (tc_tctc3 (vla-get-textstring obj))  2 3)) "mm^2"
                                        
        ))
      )
      )
 
;;;;调试部分
      ((wcmatch (STRCASE (dxf ent 1)) "`%`*[50-250]`(*`)")
        (progn
        (setq lst (list "====箍筋面积====" laynm
                        ;(strcat "钢筋标注:" (vla-get-textstring obj))
                        (strcat "钢筋面积:" (rtos(/ (tc_tctc5 (vla-get-textstring obj)) 100) 2 3) "/"
                        (rtos (/ (/ (* (tc_tctc5 (vla-get-textstring obj)) tc_t8)tc_t9a) 100) 2 3)) "cm^2"
                                        
        ))
      )
      )
;;;;调试部分
      
       ((wcmatch (STRCASE (dxf ent 1)) "#`%`[0-4]## #`%`[0-4]##,#`%`[0-4]## ##`%`[0-4]##,##`%`[0-4]## #`%`[0-4]##;##`%`[0-4]## ##`%`[0-4]##")
        (progn
        (setq lst (list "====纵筋面积====" laynm
                        ;(strcat "钢筋标注:" (vla-get-textstring obj))
                        (strcat "钢筋面积:" (rtos (/ (tc_tctc4 (vla-get-textstring obj)) 100) 2 3)) "cm^2"
                                        
        ))
      )
      )
      );end cond 
 
 
    
    (setq ss (ssadd) h (/ (getvar "viewsize") 35))
    (setq ang (fx (angle (getvar "viewctr") pt)))
    (setq n (* 1.4 (1+ (/ (apply 'max (mapcar 'strlen lst)) 2.0))))
    (ssadd (add_solid pt (polar pt (car ang) (* n h)) (setq pt (polar pt (cadr ang) (  h (* 1.8 h (length lst))))) (polar pt (car ang) (* n h))) ss)
    (setq pt (polar pt (car ang) (/ (* n h) 2)))
    (if (= (caddr ang) 0)
      (setq pt (polar pt (/ pi 2) (* 0.4 h)))
      (setq pt (polar pt (/ pi 2) (  (* 1.4 h) (* 1.8 h (length lst)))))
    )
    (setq n -1)
    (repeat (length lst)
      (ssadd (add_text (setq pt (polar pt (  pi (/ pi 2)) (* 1.8 h))) h 0 (nth (setq n (n  1)) lst) "钢筋显示" 1) ss)
    )
 
  (vl-load-com)
  (command "_.undo" "_m")
  (prompt "\n***移动鼠标掠过对象查看信息！***")
  (setq olderr *error* *error* myerr)
  (setq oldos (getvar "osmode"))
  (setq oldfill (getvar "fillmode"))
  (setvar "osmode" 0)
  (setvar "fillmode" 1)
  (setvar "cmdecho" 0)
  (tc_jzhz)
  (setq ss (ssadd))
  (while (not pd)
    (while (not (progn
                  (setq gr (grread T 1))
    (if (= (car gr) 5)
      (setq pt (cadr gr)
            ent (nentselp pt)
            ent (if (and ent (= (type (last (last ent))) 'ename))
                  (last (last ent))
                  (car ent)
                )
      )
      (setq pd T)
    )
         ))
    )
    (if (and (not pd) (not (equal ent entold)) (not (ssmemb ent ss)))
      (progn
        (if entold (redraw entold 4))
        (if ss (command "_.erase" ss ""))
        (redraw ent 3)
(dis ent)
(setq entold ent)
      )
    )
  )
  (if entold (redraw entold 4))
  (if ss (command "_.erase" ss ""))
  (setvar "osmode" oldos)
  (setvar "fillmode" oldfill)
  (setq *error* olderr)
  (princ)
)
(princ) 
 
;;下列程序与这程序类似!
;;转贴自从XDCAD,作者忘了!是你嗎?
;;当鼠标移动到满足过滤条件的像素上时，像素会闪动
;;USAGECS_EntSel "\n请选Polyline物件: " '((0 . "*Polyline")))
(defun CS_ENTSEL (STR FILTER / PT SS_NAME SS)
  (if (/= (type STR) 'STR)
    (progn
      (princ "\n变量类型不对，STR应为字符串。\n")
      (eval NIL)
    )
    (progn
      (if (/= (type FILTER) 'list)
(progn
   (princ "\n变量类型不对，FILTER应为表。\n")
   (eval NIL)
)
(progn
   (princ STR)
   (setq PT (grread t 4 2))
   (while (/= 3 (car PT))
     (if (= 5 (car PT))
       (progn
  (setq PT (cadr PT))
  (setq SS (ssget PT FILTER))
  (if SS_NAME
    (redraw SS_NAME 4)
  )
  (setq SS_NAME NIL)
  (if SS
    (progn
      (setq SS_NAME (ssname SS 0))
      (redraw SS_NAME 3)
    )
  )
       )
       (setq PT (grread t 4 2))
     )
   )
   (setq PT (cadr PT))
   (setq SS (ssget PT FILTER))
   (if SS_NAME
     (redraw SS_NAME 4)
   )
   (setq SS_NAME NIL)
   (if SS
     (progn
       (setq SS_NAME (ssname SS 0))
       (list SS_NAME PT)
     )
     (eval CS_NAME)
   )
)
      )
    )
  )
)
 
 
 
  (defun set-description (a d /  b e)
    (if (car (atoms-family 1 '("vl-load-com"))) (vl-load-com))
    (setq a (vlax-ename->vla-object a))
    (setq b (vla-get-Hyperlinks a))
    (vlax-for item b
      (vla-delete item)
    )  
    (setq b (vla-get-Hyperlinks a))
    (setq e (vla-add b "DescriptionOnly"))
    (vla-put-URLDescription e d)
    (command "redraw")
  )
 
 
 
 
;;;;;;=========================================
;;;;;;tc_makestyle 加载字体并作当前字体样式====
;;;;;;=========================================
(defun tc_jzhz ()
  (if (not (tblobjname "style" "钢筋显示"))
    (entmake
      '((0 . "STYLE")
        (100 . "AcDbSymbolTableRecord")
        (100 . "AcDbTextStyleTableRecord")
        (2 . "钢筋显示")
        (70 . 0)
        (40 . 0)
        (41 . 0.6)
        (50 . 0)
        (71 . 0)
        (42 . 0.2)
        (41 . 1)
        (3 . "黑体")
        ;(4 . "常规")
       )
    )
  )
  (setvar "textstyle" "钢筋显示")
)
;;;;;;;;第一种钢筋面积显示已完成
(defun tc_tctc1 (txt3 / N1 t1 t2 TC_GJMJ1)
   (setq n1 (vl-string-search "%"  txt3)) ;在字符串中搜索指定子串的位置编号
      (setq t1 (atoi (substr txt3 1 n1))            
            t2 (atoi (substr txt3 6 n1)))
  
    (setq tc_gjmj1 (* t1 (/ (* t2 t2 3.1415926) 4)))
  )
 
 
;;;;;;;
(defun tc_tctc2 (txt3 / N2 t3 t4 TC_GJMJ2)
   (setq n2 (vl-string-search "/"  txt3)) ;在字符串中搜索指定子串的位置编号
      (setq t3 (substr txt3 1 n2)            
            t4 (substr txt3 2 n2))
  
    (setq tc_gjmj2 (  (tc_tctc1 t3) (tc_tctc1 t4)))
  )
 
 
;;;;;;
(defun tc_tctc3 (txt3 / N3 N4 T5 T6 TC_GJMJ3 )
   (setq n3 (vl-string-search "%"  txt3)) ;在字符串中搜索指定子串的位置号
   (setq n4 (vl-string-search "@"  txt3))
      (setq t5 (atof (substr txt3 (1 n3) (1- n3)))            
            t6 (atof (substr txt3  (2 n4) (1- n4)))
)
    (setq tc_gjmj3 (* (/ 1000 t6) (/ (* t5 t5 3.1415926) 4)))
  )
;;;;;;
(defun tc_tctc4 (txt3 / N2 t3 t4 TC_GJMJ4)
   (setq n2 (vl-string-search " "  txt3)) ;在字符串中搜索指定子串的位置编号
      (setq t3 (substr txt3 1 n2)            
            t4 (substr txt3 2 n2))
  
    (setq tc_gjmj4 (  (tc_tctc1 t3) (tc_tctc1 t4)))
  )
 
 
;;;;;;
(defun tc_tctc5 (txt3 / N5 N5A N6 N6A N7 N7A N8 N8A N9A TC_AREA1 TC_AREA2 TC_GJMJ5 TC_NUM1 TC_T10A TC_T7 TC_T7A TC_T9)
  (setq tc_num1 (vl-string-search "/"  txt3))
  (if (= tc_num1 nil)
    (progn
  (setq n5 (vl-string-search "%"  txt3)) ;在字符串中搜索指定子串的位置号
  (setq n6 (vl-string-search "@"  txt3))
  (setq n7 (vl-string-search "("  txt3))
  (setq n8 (vl-string-search ")"  txt3))
      (setq tc_t7 (atoi (substr txt3  (5 n5) (- n6 (5 n5)))))
      (setq tc_t8 (atoi (substr txt3  (2 n6) (- n7 (1 n6))))
            tc_t9 (atoi (substr txt3  (2 n7) (- n8 (1 n7))))
)
  (setq tc_t9a tc_t8)
  (setq tc_area1 (/ (* tc_t7 tc_t7 3.1415926) 4))
  (setq tc_gjmj5 (/ (* tc_area1 200 tc_t9) tc_t8))
(if (>= tc_t7 10)
(setq tc_gjmj5 (/ (* tc_gjmj5 300) 210))
(setq tc_gjmj5 tc_gjmj5)
) ;_ 结束if
(progn
  (setq n5a (vl-string-search "%"  txt3)) ;在字符串中搜索指定子串的位置号
  (setq n6a (vl-string-search "@"  txt3))
  (setq n7a (vl-string-search "/"  txt3))
  (setq n8a (vl-string-search "("  txt3))
  (setq n9a (vl-string-search ")"  txt3))
   
        (setq tc_t7a (atoi (substr txt3 (6  n5a) (- n6a (5  n5a)))))
      (setq tc_t8 (atoi (substr txt3  (2  n6a) (- n7a (1  n6a))))
            tc_t9a (atoi (substr txt3  (2  n7a) (- n8a (1  n7a))))
            tc_t10a (atoi (substr txt3  (2  n8a) (- n9a (1  n8a))))
)
 
  (setq tc_area2 (/ (* tc_t7a tc_t7a 3.1415926) 4))
     (setq tc_gjmj5 (/ (* tc_area2 200 tc_t10a) tc_t8))
     (if (>= tc_t7a 10) (setq tc_gjmj5 (/ (* tc_gjmj5 300) 210)))
     ;(setq tc_gjmj6 (/ (* tc_area 200 tc_t10) tc_t9))
     ;(if (>= tc_t7 10) (setq tc_gjmj6 (/ (* tc_gjmj6 300) 210)))
   )))
  )

hdlyt11 · 发表于 2010-8-25 09:49:00

[检查文字 gjmj.lsp 正在加载...]
....
; 警告: 用作函数的局部变量: H
; 警告: 用作函数的局部变量: N
.......
; 错误: 表达式中有错误函数: (1 N3)
..
; 错误: 表达式中有错误函数: (5 N5)
; 检查完成.

vitalgg · 发表于 2021-9-29 19:58:32

如果无法播放，请点击此处在新窗口打开

结构绘图工具，查钢筋面积等。

http://atlisp.cn/package-info?name=at-structure&edition=stable

尘缘一生 · 发表于 2021-9-26 23:11:31

把代码弄个压缩文件发下，这一大片很难整理。。。。

hdlyt11 · 发表于 2010-8-25 09:48:00

[检查文字 gjmj.lsp 正在加载...]
....
; 警告: 用作函数的局部变量: H
; 警告: 用作函数的局部变量: N
.......
; 错误: 表达式中有错误函数: (1 N3)
..
; 错误: 表达式中有错误函数: (5 N5)
; 检查完成.

vvcd · 发表于 2010-9-10 14:09:00

哎，就是很管用哈，不过还有其他的高手有类似的插件

freeok · 发表于 2012-11-15 08:04:29

继续努力...

有来有去 · 发表于 2012-11-23 23:01:37

这个是源码，高手来出手啊

shanquanr · 发表于 2022-2-2 15:30:15

把一楼的代码整理了下

风叶翔龙 · 发表于 2023-3-14 12:36:47

初入宝地，都太厉害了

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

[转帖]完善实时显示钢筋面积源码

点评

本帖子中包含更多资源