[求助]清角的LISP程序？

shengqin5151

好功能呀，

先进者

yxl88168 发表于 2011-3-31 21:36
谢谢楼主，这个很好，有没有画接刀的lsp呀

;大家互相帮助啊,这个是我以前的老大写的画接刀的lisp,很好用,希望那个大哥完善一下加直边
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(DEFUN C:ING()  ;craft 1 绘制接刀口
    (COMMAND "OSNAP" "NEA")
    (setq pot   (getpoint "\n 请输入过切直线段的第一点:"))
    (setq pot1 (getpoint "\n 请输入过切直线段的第二点:"))  
    (setq ingh (getreal "过切的深度值<0.15>:"))
    (if (equal ingh nil)(setq ingh 0.15))
    (setq ang (/ pi 2))
    (setq ang1 (angle pot pot1))
    (setq pot2 (polar pot1 (+ ang1 ang) (- 0.5 ingh)))
    (setq pot3 (polar pot2 ang1 0.5))  
    (setq pot4 (polar pot1 (- ang1 ang) ingh))
    (setq pot5 (polar pot1 (+ ang1 pi) (sqrt (- (* 0.625 ingh) (* 0.390625 ingh ingh))) ))
    (setq pot6 (polar pot5  (- ang1 ang) (* 0.375 ingh) ))
    (setq pot7 (polar pot5  (+ ang1 pi) (* 0.6 (sqrt (- (* 0.625 ingh) (* 0.390625 ingh ingh)))) ))   
    (setq pot8 (polar pot7 (- ang1 ang) 0.3))
    (setvar "osmode" 0)
    (command "pline" pot3 "a" "s" pot4 pot6 "ce" pot8 pot7 "")
   (SETVAR "OSMODE" 183)
    )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(DEFUN C:INT()  ;craft 2 绘制接刀口
    (SETVAR "OSMODE" 0)
    (setq ss1 (entsel "First line:"))
    (SETQ ENT1 (CAR ss1)
          PT1  (OSNAP (CADR ss1) "nea")
    )
    (setq pt1_end (osnap pt1 "end"))
    (setq ss2 (entsel "second line:"))
    (SETQ ENT2 (CAR ss2)
          PT2  (OSNAP (CADR ss2) "nea")
    )
    (setq pt2_end (osnap pt2 "end"))
    (setq pt_intersection (inters pt1 pt1_end pt2 pt2_end nil))
    (setq inth (getreal "过切的深度值<0.15>:"))
    (if (equal inth nil)(setq inth 0.15))
    (COMMAND "UCS" "N" "3" pt_intersection pt1 pt2)
    (setq pt3 (list (- 0.5 inth) 0)  pt4 (list (* inth -1) 0.5)

sdwy196912

看看这个程序

ming1789_55399

感謝分享                  

my258

哪位能帮把Z版，改成支持多段线的和能连续选择空格退出的，谢谢
code="lisp] ;选择直线圆弧清角 明经 ZZXXQQ 2009.7.16 (defun c:tt () (setvar "CMDECHO" 0) (setq oldos (getvar "OSMODE")) (if (and (setq r (getdist "\n圆弧半径 :"))           (setq s1 (entsel "\n选择第一条直线 :"))           (setq ent (entget(car s1)))           (= (cdr(assoc 0 ent)) "LINE"))   (if (and (setq s2 (entsel "\n选择第二条直线 :"))            (setq ent1 (entget(car s2)))            (= (cdr(assoc 0 ent1)) "LINE")) (progn    (setq p1 (cdr(assoc 10 ent)) p2 (cdr(assoc 11 ent))          p3 (cdr(assoc 10 ent1)) p4 (cdr(assoc 11 ent1)))    (if (setq p5 (inters p1 p2 p3 p4 nil)) (progn     (if (< (distance p1 p5) (distance p2 p5))   (setq p1 (polar p5 (angle p1 p2) r) p12 p2            ent (subst (cons 10 p1) (assoc 10 ent) ent))      (setq p2 (polar p5 (angle p2 p1) r) p12 p1            ent (subst (cons 11 p2) (assoc 11 ent) ent))     )     (entmod ent) (if (< (distance p3 p5) (distance p4 p5))   (setq p3 (polar p5 (angle p3 p4) r) p34 p4            ent1 (subst (cons 10 p3) (assoc 10 ent1) ent1))   (setq p4 (polar p5 (angle p4 p3) r) p34 p3            ent1 (subst (cons 11 p4) (assoc 11 ent1) ent1))     )     (entmod ent1)     (setq p6 (polar p12 (angle p12 p34) (/ (distance p12 p34) 2)))     (command "circle" p5 r "trim" s1 s2 "" "F" p5 p6 "" "")    ))   )) ) (setvar "OSMODE" oldos) (setvar "CMDECHO" 1) (princ) ) [/code]

zhangtieliang

谢谢，看到那么好的程序

fangseng

sdwy196912，你的东东有时间限制，已过期！！！！

xiaobailou

特别好的东西，顶

不语勿语

收藏备用。。