CAD算量插件

    (vl-load-com)
    (vl-load-all "RainMan")
    (RainMan)

    (princ "\n程序:如何使用请看帮助文档")
    (defun c:js (/ autolong1 longmin ss autolong1 i len en)
    (SETQ autolong1 NIL)
    (initget 7)
    (setq longmin (getreal "\n请输入最小值:"))
    (setq longmax (getreal "\n请输入最大值:"))

    (if (setq autolong (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
    (progn
    (setq i -1 autolong1 (ssadd))

    (repeat (sslength autolong)
    (command ".lengthen" (setq en(ssname autolong (setq i (1+ i)))) 0.0 "")
    (setq len(getvar "perimeter"))
    (if (and (> len longmin) (< len longmax))
    (ssadd en autolong1)
    );end if
    );end repeat
    );end progn
    )
    (sssetfirst nil autolong1)
    (princ)
    )
    (defun C:suml (/ CURVE TLEN SS N SUMLEN) (vl-load-com) (setq SUMLEN 0) (setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC")))) (setq N 0) (repeat (sslength SS) (setq CURVE (vlax-ename->vla-object (ssname SS N))) (setq TLEN (vlax-curve-getdistatparam CURVE (vlax-curve-getendparam CURVE))) (setq SUMLEN (+ SUMLEN TLEN)) (setq N (1+ N)) ) (princ (strcat "\n共选择 " (itoa (sslength SS)) " 条线段. 线段总长: " (rtos SUMLEN 2 3) " .")) (princ) )

    ;面积求和
    (defun c:mj (/ olderr oldcmdecho errexit undox restore ss1 nr en tot_area)
    (defun errexit (s)
    (restore)
    )

    (defun undox ()
    (command "._undo" "_E")
    (setvar "cmdecho" oldcmdecho)
    (setq *error* olderr)
    (princ)
    )

    (setq olderr *error*
    restore undox
    *error* errexit
    )
    (setq oldcmdecho (getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (command "._UNDO" "_BE")
    (if (setq ss1 (ssget '((-4 . "<OR")
    (0 . "POLYLINE")
    (0 . "LWPOLYLINE")
    (0 . "CIRCLE")
    (0 . "ELLIPSE")
    (0 . "SPLINE")
    (0 . "REGION")
    (-4 . "OR>")
    )
    )
    )
    (progn
    (setq nr 0)
    (setq tot_area 0.0)
    (setq en (ssname ss1 nr))
    (while en
    (command "._area" "_O" en)
    (setq tot_area (+ tot_area (getvar "area")))
    (setq nr (1+ nr))
    (setq en (ssname ss1 nr))
    )
    (princ "\nTotal Area = ")
    (princ tot_area)
    )
    )
    (restore)
    )

    ;=============================Sum function=============================
    ;==================使用方法:先X炸开然后再选取计算=====================
    (
    Defun C:sumn( / cmdmode sset ssl nsset temp ssl1 total)
    (if *error* quit) ;Exit CAD when error exists
    (setq cmdmode (getvar "cmdecho")) ;store the content of "cmdecho" in variable cmdmode
    (setvar "cmdecho" 0);
    (prompt "\nSelect numbers : ")
    (setq sset (ssget))
    (if (null sset)
    (progn
    (princ "\nError: Nothing selected!\n")
    (princ)
    )
    (progn
    (setq ssl (sslength sset)) ; return the length of sset
    (setq nsset (ssadd)) ; construct a new null selections set
    (while (> ssl 0)
    (setq temp (ssname sset (setq ssl(1- ssl))))
    ;assign the ss1th member name of sset to temp
    (if (= (cdr (assoc 0 (entget temp))) "TEXT")
    (ssadd temp nsset) ; add temp to nsset
    )
    )
    (setq ssl (sslength nsset))
    (print ssl)
    (princ "text entities are found.")
    (setq total 0)
    (setq ssl1 ssl)
    (while (> ssl 0)
    (setq temp (ssname nsset (setq ssl (1- ssl))))
    (setq number (atof(cdr(assoc 1 (entget temp)))))
    (if (= 0 number)
    (setq ssl1 (1- ssl1))
    (setq total (+ total number))
    )
    )
    (princ "\nThe Sum of the ")
    (princ ssl1)
    (princ " numbers selected is ")
    (princ total)
    )
    )
    (setq cmdecho cmdmode)
    (princ)

    )
    ;=============================End=======================================

    转载请注明:RAIN MAN » CAD算量插件

    喜欢 0
标签: ,

还没有人抢沙发呢~