在网上找的几个比较有用的lisp小程序

wen1234

谢谢呀


输入的列表有缺陷

机械工程师

不少排版错误。附上修正版本
;4.      将CAD文字导入Excel表格
(defun c:Q2()
        (setq ffn(getfiled "写出文件" "" "xls" 1))
        (princ"\n选取文字...")
        (setq ss(ssget))
        (setq ff(open ffn "w"))
        (setq i 0)
        (repeat(sslength ss)
                (setq ssn(ssname ss i))
                (setq ssdata(entget ssn))
                (setq sstyp(cdr (assoc 0 ssdata)))
                (if (or (= sstyp "TEXT") (= sstyp "MTEXT"))
                        (progn
                                (setq txt(cdr (assoc 1 ssdata)))
                                (princ txt ff)
                                (princ"\n" ff)
                        )
                )
                (setq i (1+ i))      
        )
        (close ff)
        (princ(strcat "\n写出文件: " ffn))
        (prin1)
)

机械工程师

;1.      计算所有线段总长度(加载后只需框选所有线
(defun c:LL()
        (setvar"cmdecho" 1)
        (setq en(ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))
        (setq i 0)
        (setq ll 0)
        (repeat(sslength en)  
                (setq ss(ssname en i))  
                (setq endata(entget ss))  
                (command"lengthen" ss "")  
                (setq dd(getvar "perimeter"))
                (setq ll (+ dd ll))  
                (setq i (1+ i))
        )  
        (princ "\nThe total length is:")(princ ll)(princ)
)

;3.      连续打断程序
(defun c:br1()  
        (command "break" pause "f" pause "@")
)

机械工程师

;2.      标注所有线段(加载后只需框选所有线段便可
(defun c:LLL()
        (COMMAND"UCS" "")
        (setvar"cmdecho" 1)
        (SETVAR"OSMODE" 0)
        (setq    AcadObject  (vlax-get-acad-object)  AcadDocument (vla-get-ActiveDocument Acadobject)   mSpace      (vla-get-ModelSpace Acaddocument))
        ;;选取需要测量的样条曲线、圆弧、直线、椭圆
        (setq en(ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))
        (setq i 0)
        ;;获取系统参数textsize
        (setq shh (getvar "textsize"))
        (setq str_hh(strcat "\n文字高度 <" (rtos shh 2) ">: "))
        (setq hh(getdist str_hh))
        (while hh
        (setvar "textsize" hh)
        (setq hh nil))
        ;;输入标注文字高度
        ;;循环开始
        (repeat(sslength en)  
        (setq ss(ssname en i))  
        (setq endata(entget ss))  
        (command "lengthen" ss "")  
        (setq dd(getvar "perimeter"))  
        (princ(strcat "\n长度=" (rtos dd 2)))  
        ;;寻找代表图层的字符串
        (setq aa(assoc 0 endata))  
        ;;获取图层名称
        (setq aa1(cdr aa))  
        ;;判断线条种类
        (cond    ((= aa1 "SPLINE")   
        ;;如果是spline   
        (progn   
        (setq arcObj(VLAX-ENAME->VLA-OBJECT ss))   
        (setqstartPnt1 (vla-get-ControlPoints arcObj))   
        (setq p1      
        (vlax-safearray->list(vlax-variant-value startPnt1))   
        )   
        (setq x1 (car p1))   
        (setq y1(cadr p1))   
        (setq z1(caddr p1))   
        (setq pp1(list x1 y1 z1))   
        (repeat (- (/(length p1) 3) 1)      
        ;;循环，寻找最后一个控制点      
        (setq p1(cdddr p1))      
        (setq x2 (car p1))      
        (setq y2(cadr p1))      
        (setq z2(caddr p1))   
        )   
        (setq pp2(list x2 y2 z2))   
        )   
        )   
        ((= aa1"LWPOLYLINE")   
        ;;如果是LWPOLYLINE   
        (progn   
        (setq arcObj(VLAX-ENAME->VLA-OBJECT ss))  
        (setqstartPnt1 (vla-get-Coordinates arcObj))  
        (setq p1      
        (vlax-safearray->list(vlax-variant-value startPnt1))  
        )   
        (setq x1 (car p1))   
        (setq y1(cadr p1))   
        (setq z1(caddr p1))   
        (setq pp1(list x1 y1 z1))   
        (repeat (- (/(length p1) 3) 1)      
        ;;循环，寻找最后一个控制点      
        (setq p1(cdddr p1))      
        (setq x2 (carp1))      
        (setq y2(cadr p1))      
        (setq z2(caddr p1))   
        )   
        (setq pp2(list x2 y2 z2))   
        )   
        )   
        (t   
        ;;如果是其他种类线条   
        (progn   
        (setq arcObj(VLAX-ENAME->VLA-OBJECT ss))   
        (setq startPnt1 (vla-get-StartPoint arcObj))   
        ;;获取起点   
        (setq endPnt1(vla-get-EndPoint arcObj))   
        ;;获取终点   
        (setq pp1       (vlax-safearray->list(vlax-variant-value startPnt1))   
        )   
        (setq      
        pp2(vlax-safearray->list (vlax-variant-value endPnt1))   
        )   
        )   
        )  
        )  
        (setq x1 (car pp1))  
        (setq y1(cadr pp1))  
        (setq z1(caddr pp1))  
        (setq x2 (car pp2))  
        (setq y2(cadr pp2))  
        (setq z2(caddr pp2))  
        (setq x (/ (+ x1 x2) 2))  
        (setq y (/ (+ y1 y2) 2))  
        (setq z (/ (+ z1 z2) 2))  
        (setq pt(list x y z))  
        ;;取得线段两端的中点
        (setq ang(angle pp1 pp2))  
        ;;获取角度
        (if    (> (* (/ ang pi) 180) 180)   
        (setq ang (+ ang pi))  
        )  
        (command "text"      
        "j"      
        "bc"      
        pt      
        ""      
        (* (/ ang pi) 180)      
        (strcat "" (rtos dd 2))      
        ""  
        )  
        (setq i (1+ i)))
        (prin1)
)
(prompt"\n <>在图中直接写出长度")
(prin1)

机械工程师

论坛有吞空格行为。
放上lsp文件。

lifenwei

不错的说。。

iszc

机械工程师 发表于 2014-4-23 14:47
不少排版错误。附上修正版本
;4.      将CAD文字导入Excel表格
(defun c:Q2()

这个好用，不知能不能直接输出到当前打开的txt记事本上，或当前打开的xls上

ymcui

谢谢楼主的分享！很有用

guerearou

这必须感谢啊，连下载都不用，学习了

zh878766930

机械工程师 发表于 2014-4-23 14:53
;2.      标注所有线段(加载后只需框选所有线段便可
(defun c:LLL()
        (COMMAND"UCS" "")

不能测量多线段，要能测多线段就好了