[下载]工程计算好用的lisp分享

lqss

下着试了，不知干什么用的。

jialiang168

谢谢楼主啦。不错哦。真的很多好用的呢。

qingtao210

谢谢

tctabc

来去使用看看

swomsdh

请问楼主有哪些实用程序

kkt123

收藏了

谢谢

zgssd

下了，但不会用，也没有说明

 

hful668

谢谢了，很有用的东西

Q1241274614

汉字部分都是乱码，这是干什么用的程序？

Michael527

;~~~~~~~~~~~~~~~~~~~get 取得图元串列资讯~~~~~~~~~~~~~~~
(defun c:get(/ )
(setq a(entsel))
(setq b(entget (car a)))
)
;~~~~~~~~~~~~~~~~~~~get 取得图元串列资讯~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~~~将所有dimension 炸开~~~~~~~~~~~~~~~~~~~~
(defun c:d1(/ss1 )
(setq ss1(ssget "X" '((0 . "DIMENSION"))))
(command "\n")
(command "explode" ss1 "")
)
;~~~~~~~~~~~~~~~~~~~~将所有dimension 炸开~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~
(defun c:qa(/ inputcode c)
(setq inputcode(getint "\n输入欲查询assoc code: "))
(setq c(assoc inputcode b))
)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~~~副涵式 二点间求中点座标~~~~~~~~~~~~~~~~~~~~
(defun getmidpt(pt1 pt2) ;取得中点座标
     (setq mx (/ (+ (car pt1) (car pt2)) 2))
     (setq my (/ (+ (cadr pt1) (cadr pt2)) 2))
     (list mx my)
)
;~~~~~~~~~~~~~~~~~~~~副涵式 二点间求中点座标~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~~~查询角度~~~~~~~~~~~~~~~~~~~~

(defun c:pi(/ a b)
(setq a(getangle "请输入十进位角度值:"))
(setq b(/ a 3.14159))
(princ (strcat "\n 此角度为" (rtos a)  "径" (rtos b)  "pi") )
(prin1 )
)
;~~~~~~~~~~~~~~~~~~~~快速缩放~~~~~~~~~~~~~~~~~~~~
(defun c:zs()(command "zoom" "0.8x")(prin1))
(defun c:zz()(command "zoom" "1.25x")(prin1))     
(defun c:za()(command "zoom" "a")(prin1))
(defun c:ze()(command "zoom" "e")(prin1))
(defun c:zw()(command "zoom" "w"))
(prompt "直接输入 ZS,ZZ,ZA,ZE 作 ZOOM 快速缩放")
(prin1)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~~~十字游标角度调整~~~~~~~~~~~~~~~~~~~~
(defun c:0() (command "snapang" 0)(prin1))
(defun c:15()(command "snapang" 15)(prin1))
(defun c:30()(command "snapang" 30)(prin1))
(defun c:45()(command "'snapang" 45)(prin1))
(defun c:60()(command "'snapang" 60)(prin1))
(defun c:75()(command "'snapang" 75)(prin1))
(prompt "直接输入 0、15、30、45、60、75十字游标角度调整")
(prin1)
;~~~~~~~~~~~~~~~~~~~~求点位并标柱~~~~~~~~~~~~~~~~~~~~
(defun c:q(/ pa xx yy osnap_v ldf npa )
  (setq pa (getpoint "输入角点:"))
  (setq xx (getdist "\n纵距x:"))
  (setq yy (getdist "\n横距y:"))
  (setq osnap_v(getvar "osmode")) ;取出osnap值
  (setvar "osmode" 0 );并且关闭 以免影响lisp绘图
  (setq ldf(getvar "clayer") )
  (setq npa(list (+ (car pa) xx) (+ (cadr pa) yy) ))
  (command "point" npa)
  (command "layer" "s" "h-dim" "" )
  (if (> xx 0 )
   (if(> yy 0)
   (progn
   (command "dimlinear" pa npa "h" (polar npa 90 50));Horizontal
   (command "dimlinear" pa npa "v" (polar npa 0 50));vertical
    )
   (progn
   (command "dimlinear" pa npa "h" (polar npa 270 50));Horizontal
   (command "dimlinear" pa npa "v" (polar npa 0 50));vertical
   )   
   );end if (yy)
  (if (< yy 0)
   (progn
   (command "dimlinear" pa npa "h" (polar npa 270 50));Horizontal
   (command "dimlinear" pa npa "v" (polar npa 180 50));vertical
   )
   (progn
   (command "dimlinear" pa npa "h" (polar npa 90 50));vertical
   (command "dimlinear" pa npa "v" (polar npa 180 50));vertical
   )
  );end if (yy)
  )
(setvar "osmode" osnap_v );恢复原来抓点模式设定
(setvar "clayer" ldf );还原原来之lyaer设定
(prin1)
)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;~~~~~~~~~~~~~~~~~~~~快速断点(bf)~~~~~~~~~~~~~~~~~~~~
(defun c:BF(/ ob Bp)
(setq ob(entsel "选取断裂物件:"))
(setq Bp(getpoint "输入断裂点:"))
(command "BREAK" ob "F" BP BP)(prin1))
(prompt "直接输入 ZS,ZZ,ZA,ZE 作 ZOOM 快速缩放")
(prin1)
;~~~~~~~~~~~~~~~~~~快速断点(bf)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;~~~~~~~~~~~~~~~~~~档名路径产生器(n)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun c:n(/ NAME NAME1 tpoint1 tpoint2 path nodwg);(/ name name1)
(setq name(getvar "dwgname") )
(setq name1(strcase name) );变成大写
(setq nlens(strlen name1));新字串长度
(setq nodwg(substr name1 1 (- nlens 4) ))
(setq path(getvar "dwgprefix"))
(setq tpoint1 '(353 52.2 0));file name
(setq tpoint2 '(349 0.72 0));path diretory
(command "text" tpoint1 2.5 "" nodwg "")
(command "text" tpoint2 1.5 "" path "")     
(prompt name1)
(prompt path)  
(prin1)
)
;~~~~~~~~~~~~~~~~~~档名路径产生器(n)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;(setq ss1(ssget "X" '((0 . "DIMENSION")))) (0 . "MTEXT")
;~~~~~~~~~~~~~~~~~~改变所有尺寸型式(cd)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun c:cd()
(setq dimstyle(getstring "请输入dimension style:" ))
(setq ss(ssget "X" '((0 . "DIMENSION"))))
(setq i 0)
(repeat (sslength ss)
(setq ssn(ssname ss i))
(setq ssdata(entget ssn))
(setq old_style (assoc 3 ssdata))
(setq new_style (cons 3 dimstyle))
(setq ssdata (subst new_style old_style ssdata))
(entmod ssdata)
(setq i (1+ i))
)   
)
;~~~~~~~~~~~~~~~~~~改变所有尺寸型式(cd)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~            );end repeat 1
         (setq p5 p2); 字串变数p5
        );progn
      
        (progn
         
        );progn
      );end if b


  );end defun