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算量插件

喜欢 4