焊缝标注【grread样式】

尘缘一生 · 发表于 2018-2-8 17:21

本帖最后由尘缘一生于 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方式】***************************

;;;;*************************焊缝【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焊缝高度<img src="static/image/smiley/default/sad.gif" smilieid="2" border="0" alt="" />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方式】***************************

程序在输入焊缝高度前，要移动鼠标在第一点之外外，这点比较遗憾，希望大家能完善改写。

panliang9 · 发表于 2018-2-9 15:39

支持一个！

彳余 · 发表于 2018-3-9 10:54

不好用，真的不好用

bai2000 · 发表于 2019-3-5 18:11

希望楼主能完善一下

账号		自动登录	找回密码
密码			注册

[源码] 焊缝标注【grread样式】

本帖子中包含更多资源