焊缝标注【grread样式】
本帖最后由 尘缘一生 于 2018-2-8 17:26 编辑;;;;*************************焊缝【grread方式】***************************
;;;;----------------非现场相同焊缝----------------
(defun C:fxth()
(hanf 1)
)
;;;;----------------现场相同焊缝----------------
(defun C:xth()
(hanf 2)
)
;;;;---------------
(defun hanf (k / p1 p2 gr grr %k z$ennext)
(setq p1 (getpoint "\n焊缝位置 give the place point:"))
(Setq z$ (getstring "\n焊缝高度:(6.0)"))
(if(= z$ "")(setq z$ "6"))
(setq %k t) ;循环条件
(while %k
(setq grr (grread t 4 0);;取得鼠标操作及坐标
gr (car grr) ;;鼠标操作
p2 (cadr grr) ;;鼠标坐标
)
(if (= gr 5) ;;移动时
(progn
(if (= k 1)
(progn
(command "LAYER" "S" "MM" "")
(fxth-1 p1 p2 z$ 1);非现场相同焊缝|;
(command "LAYER" "S" "0SX" "")
)
)
(if (= k 2)
(progn
(command "LAYER" "S" "MM" "")
(fxth-1 p1 p2 z$ 2);现场相同焊缝|;
(command "LAYER" "S" "0SX" "")
)
)
)
)
(if (= gr 3)
(setq %k nil)
);;3表示左键;结束循环
(if (= gr 2);;2表示空格
(setq %k nil)
)
)
(print)
)
;;;;---------------
(defun fxth-1(p1 p2 z$ k$ / p n p3 p4 p5 p7 p8 ang p9 p11 p12 p13 p20 p21 p22 p23);;;;--------非现场 (现场) 相同焊缝------
(if ennext
(progn
(setq p (sslength ennext))
(setq n 0)
(while (< n p)
(entdel (ssname ennext n))
(setq n (+ 1 n))
)
)
)
(if (> (car p2) (car p1))
(setq p3 (polar p2 0 20))
(setq p3 (polar p2 pi 20))
)
(if (> (car p2) (car p1))
(setq p4 (list (+ (car p2) 13) (+ (cadr p2) 3)))
(setq p4 (list (- (car p2) 8) (+ (cadr p2) 3)))
)
(setq p5 (list (car p4) (- (cadr p4) 3)))
(setq p7 (list (+ (car p5) 3) (cadr p5)))
(setq p8 (list (- (car p5) 8) (+ (cadr p2) 1.2)))
(setq ang (angle p1 p2))
(setq p9 (polar p1 ang 4))
(setq p11 (polar p2 (+ Pi ang) 2))
(if (> (car p2) (car p1))
(setq p12 (list (+ (car p2) 2) (cadr p2)))
(setq p12 (list (- (car p2) 2) (cadr p2)))
)
(if (> (cadr p2) (cadr p1))
(setq p13 (list (car p2) (+ (cadr p2) 2)))
(setq p13 (list (car p2) (- (cadr p2) 2)))
)
(if (= k$ 2)
(progn
(setq p20 (list (car p2) (+ (cadr p2) 10)))
(setq p21 (list (car p20) (- (cadr p20) 3)))
(setq p23 (list (+ (car p21) 5) (cadr p21)))
(setq p22 (polar p20 (angle p20 p23) 3))
(setq ennext (ssadd))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
'(90 . 5) (cons 10 p2) (cons 10 p20)
)
)
(ssadd (entlast) ennext)
(entmakex (list (cons 0 "SOLID") (cons 100 "AcDbEntity")
(cons 100"AcDbTrace") (cons 10 p20)
(cons 11 p21) (cons 12 p22) (cons 13 p23)
)
)
(ssadd (entlast) ennext)
)
)
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
'(90 . 5) (cons 10 p1) (cons 10 p2) (cons 10 p3)
)
)
(if (= k$ 1)(setq ennext (ssadd)))
(ssadd (entlast) ennext)
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
'(90 . 5) (cons 10 p4) (cons 10 p5)
)
)
(ssadd (entlast) ennext)
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
'(90 . 5) (cons 10 p4) (cons 10 p7)
)
)
(ssadd (entlast) ennext)
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
'(90 . 5) (cons 10 p1)'(40 . 0)'(41 . 0.8) (cons 10 p9) '(40 . 0.8)'(41 . 0.8)
)
)
(ssadd (entlast) ennext)
(command "arc" p11 p13 p12)
(ssadd (entlast) ennext)
(entmake (list '(0 . "text")
(cons 1 z$)
(cons 10 p8)
(cons 40 3)
)
)
(ssadd (entlast) ennext)
)
;;;;*************************焊缝【grread方式】***************************
程序在输入焊缝高度前，要移动鼠标在第一点之外外，这点比较遗憾，希望大家能完善改写。
支持一个！ 不好用，真的不好用 希望楼主能完善一下
页:
[1]