用lisp写的计算线长的程式

zylaser 发表于 2003-4-14 17:36:00

本帖最后由作者于 2006-4-26 19:48:20 编辑 明经通道的计算线长程式一次只能选一条线，极不方便，这是我用lisp写的计算线长的程式，非常好用 (defun c:abk () (setvar "cmdecho" 0) (command "layer" "S" "0" "") (setq p  (/ pi 2.0)       g (+ pi p))    (setq aa (ssget))   (setq i 0)    (setq ab (ssadd))    (repeat (sslength aa)     (setq aab (ssname aa i))      (setq bb (cdr (assoc 0 (entget aab))))      (cond ((= bb "LINE")            (setq pd (list aab (cdr (assoc 10 (entget aab)))))      ))      (cond ((= bb "CIRCLE")            (setq pd (list aab (cdr (assoc 10 (entget aab)))))      ))      (cond ((= bb "ARC")            (setq pd (list aab (cdr (assoc 10 (entget aab)))))      ))     (cond ((= i 0) (setq j 0) (cond ((= j 0) (cond ((/= bb "LINE") (setq aad 0))) (cond ((/= bb "CIRCLE") (setq bad 0))) (cond ((/= bb "ARC") (setq cad 0))))))) (setq j (+ j 1)) (cond ((= bb "LINE") (setq st (cdr (assoc 11 (entget aab)))) (setq qed (cdr (assoc 10 (entget aab)))) (setq ad (distance st qed)) (cond ((= i 0) (setq aad ad))) (cond ((>= i 1) (setq aad (+ ad aad)))) ))             (cond ((= bb "CIRCLE")   (setq aeed (cdr (assoc 40 (entget aab))))   (setq ad (* aeed pi 2.0)) (cond ((= i 0) (setq bad ad))) (cond ((>= i 1) (setq bad (+ ad bad)))) )) (cond ((= bb "ARC")   (setq ast (cdr (assoc 50 (entget aab))))   (setq sst (cdr (assoc 51 (entget aab))))   (setq beed (cdr (assoc 40 (entget aab)))) (cond ((>= ast 0) (cond ((< ast p) (cond ((> ast sst) (cond ((>= (* pi 2.0)) (setq xb (- ast sst)))) (cond ((> sst 0) (setq xb1 (- p ast)) (setq xb (+ g xb1 sst)))))) (cond ((< ast sst) (cond ((>= sst 0) (setq xb1 (- p ast)) (setq xb (+ pi xb1 sst)))) (cond ((< sst (* pi 2.0)) (cond ((< sst p) (setq xb (- sst ast)))) (cond ((< sst pi) (setq xb1 (- p ast)) (setq xb2 (- sst p)) (setq xb (+ xb1 xb2)))) (cond ((< sst g) (setq xb1 (- p ast)) (setq xb2 (- sst pi)) (setq xb (+ xb1 xb2 p)))) (cond ((< sst (* pi 2.0)) (setq xb1 (- p ast)) (setq xb2 (- sst g)) (setq xb (+ xb1 xb2 pi)))) )) )) )))) (cond ((>= ast p) (cond ((< ast pi) (cond ((> ast sst) (cond ((<= sst p) (setq xb1 (- ast p)) (setq xb2 (- p sst)) (setq xb (- (* pi 2.0)xb1 xb2)))) (cond ((> sst p) (setq xb (- (* pi 2.0)(- ast sst))))))) (cond ((< ast sst) (setq xb (- sst ast)))) )))) (cond ((>= ast pi) (cond ((< ast g) (cond ((> ast sst) (cond ((> sst 0) (setq xb2 sst) (setq xb1 (- g ast)) (setq xb (+ xb1 xb2 p)))) (cond ((>= sst p) (setq xb1 (- ast pi)) (setq xb2 (- pi sst)) (setq xb (- (* pi 2.0) xb1 xb2)))) (cond ((>= sst pi) (setq xb1 (- g ast)) (setq xb2 (- sst pi)) (setq xb (+ g xb1 xb2)))) (cond ((> sst g) (setq xb1 (- sst pi)) (setq xb2 (- g ast)) (setq xb (+ xb1 xb2 g)))) )) (cond ((< ast sst) (setq xb (- sst ast)))) )))) (cond ((>= ast g) (cond ((< ast (* pi 2.0)) (cond ((> ast sst) (cond ((>= sst g) (setq xb1 sst) (setq xb2 (- (* pi 2.0)ast)) (setq xb (+ xb1 xb2)))) (cond ((< sst g) (setq xb1 (- sst g)) (setq xb2 (- (* pi 2.0)ast)) (setq xb (+ g xb1 xb2)))) )) (cond ((< ast sst) (setq xb (- sst ast)))) )))) (setq ad (* beed xb)) (cond ((= i 0) (setq cad ad))) (cond ((>= i 1) (setq cad (+ ad cad)))) ))   (setq i (+ 1 i))) (setq aaad (+ aad bad cad)) (setq ai aaad) (setq aai (rtos ai 2 4)) (setq abi "<") (setq aci ">") (setq adi "线段总长为:") (princ (strcat adi abi aai aci)) (command "pickbox" 3) (princ) )

pengfei2010 发表于 2017-10-9 16:20:05

回帖是一种美德！感谢楼主的无私分享谢谢

zylaser 发表于 2003-4-13 14:35:00

我需要意见！

如果这个程式好的话，请大家给我留一下言，不好就请大家给我提一下意见，好让我有所改进，如果大家都看不提意见，我会很失望的，从某些方面讲，明经就是需要大家的意见，这样网站才会有人气，才会兴望，只有不断的交流，大家的知识才会进步，

mccad 发表于 2003-4-13 16:37:00

不错，全部用ALISP写，而没有用到VLISP的函数

但不是对所有的线有效，如样条曲线、多段线、优化多段线等。
这里有一个贴子你看看吧：
http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&RootID=16564&ID=16564
是计算任意曲线的长度，刚好可以补充实用函数栏目中所缺少的内容。

龙龙仔 发表于 2003-4-14 12:42:00

進階到vlisp,會更方便!!

caravaggio 发表于 2003-6-12 15:25:00

polyline 有没有办法？

zpqcq 发表于 2004-12-27 22:23:00

谢谢,好用

AMTONNY 发表于 2008-4-27 20:44:00

偶点个位置

董堃发表于 2008-4-28 19:40:00

本帖最后由作者于 2008-4-28 19:43:46 编辑 (defun c:sj() (princ "\n选取要计算的图元计算线长<总长>:") (setq ss (ssget)) (setq n 0) (setq yy 0) (repeat (sslength ss) (setq ssn (ssname ss n)) (command "lengthen" ssn "") (setq dd (getvar "perimeter")) (setq n (1+ n)) (setq yy(+ yy dd))) (setq pt (getpoint "\n文字位置点: ")) (setq old_hh (getvar "textsize")) (setq str_hh (strcat "\n高度 <" (rtos old_hh 2) ">: ")) (setq hh (getdist pt str_hh)) (if (null hh) (setq hh old_hh)) (command "text" pt hh 0 (strcat "总长=" (rtos yy 2 2) "MM")) (prin1) )

FANGZHENG158 发表于 2008-6-27 19:28:00

谢谢,好用

ayong8397 发表于 2009-5-21 15:13:00

好东西,谢谢了!

页: [1] 2 3

明经CAD社区's Archiver