求优化。画焊缝的程序，图形大时执行很慢。谢谢

ly8zx2109 · 发表于 2015-5-21 15:06:50

本帖最后由 ly8zx2109 于 2015-5-21 16:20 编辑

求优化。画焊缝的程序，图形大时执行很慢。谢谢

(defun err (s)
      (if (/= s "Function cancelled")
            (princ (strcat "\nError: " s))
      )
      (setq sset nil)
      (setq *error* olderr)
      (princ)
)

(defun c:hf()
  (setvar "cmdecho" 0)
  (setq oldoffsetdist (getvar "offsetdist"))
  (setq oldosmode (getvar "osmode"))
  (setvar "dimzin" 0)
  (setq olderr *error*
            *error* err)
  (command "undo" "group")
  (setq pt1 (getpoint"\n请选择要添加焊缝上的直线上的焊缝起点："))
  (setq pt2 (getpoint"\n请选择要添加焊缝上的直线上的焊缝终点："))
  (setq pt3 (getpoint"\n请选择要添加焊缝的一侧："))

  (setvar "osmode" 0)

  (setq hfjl (distance pt1 pt2))
  (command "line" pt1  pt2 "")
  (setq en1 (entlast))
  (command "offset" "0.466666666666667" en1 pt3 "")
  (setq en2 (entlast))
  (setq en11 (entget en1))
  (setq en22 (entget en2))

  (setq qd11 (cdr (assoc 10 en11)))

  (setq qd22 (cdr (assoc 10 en22)))

  (command "line" qd11 qd22 "")
  (setq en3 (entlast))
  (command "offset" "0.4" en3 pt2 "")
  (setq en4 (entlast))

  (setq n (/ hfjl 0.533333333333333333))
  (setq n (fix n))
  (setq m 1)
  (while (>= n m)
(setq jl1 (* m 0.5333333333333))
(command "offset" jl1 en4 pt2 "")
(setq m (+ 1 m))
  )
  (command "erase" en1 en2 en3 "")
  (command "undo" "end")
  (setvar "osmode" oldosmode)
  (setvar "offsetdist" oldoffsetdist)
  (setvar "cmdecho" 1)
  (setq *error* olderr)
  (princ)
)

夏生生 · 发表于 2015-5-21 15:06:51

(vl-load-com)
(defun c:pp (/ en1 pt pt1 pt2 Deriv ang ang1 ang2 l n i)
(setvar "cmdecho" 0)
(command "undo" "group")
(setq en1 (entsel "\n选择焊件：")
pt (cadr en1)
en1 (car en1)
pt1 (vlax-curve-getClosestPointTo en1 pt)
Deriv (vlax-curve-getSecondDeriv
en1
(vlax-curve-getParamAtPoint en1 pt1)
)
ang1 (angle pt1 pt)
ang2 (angle pt1 (mapcar '+ pt1 Deriv))
l (vlax-curve-getdistatPoint en1 (vlax-curve-getendPoint en1))
n (fix(/ (- l 0.4) 0.533333))
i 0
)
(repeat (1+ n)
(setq pt (vlax-curve-getPointAtDist en1 (+ 0.4 (* 0.53333 i)))
i (1+ i)
)
(if (equal Deriv '(0. 0. 0.) 1e-6)
(entmake (list '(0 . "line")
(cons 10 pt)
(cons 11 (polar pt ang1 0.46666666666))
)
)
(if (equal ang1 ang2 1e-6)
(entmake
(list
'(0 . "line")
(cons 10 pt)
(cons
11
(polar pt
(angle pt
(mapcar '+
pt
(vlax-curve-getSecondDeriv
en1
(vlax-curve-getParamAtPoint en1 pt)
)
)
)
0.46666666666
)
)
)
)
(entmake
(list
'(0 . "line")
(cons 10 pt)
(cons
11
(polar
pt
(+ pi
(angle pt
(mapcar '+
pt
(vlax-curve-getSecondDeriv
en1
(vlax-curve-getParamAtPoint en1 pt)
)
)
)
)
0.46666666666
)
)
)
)
)
)
)
(command "undo" "end")
(princ)
)

(vl-load-com) 
(defun c:pp (/ en1 pt pt1 pt2 Deriv ang ang1 ang2 l n i) 
  (setvar "cmdecho" 0) 
  (command "undo" "group") 
  (setq        en1   (entsel "\n选择焊件：") 
        pt    (cadr en1) 
        en1   (car en1) 
        pt1   (vlax-curve-getClosestPointTo en1 pt) 
        Deriv (vlax-curve-getSecondDeriv 
                en1 
                (vlax-curve-getParamAtPoint en1 pt1) 
              ) 
        ang1  (angle pt1 pt) 
        ang2  (angle pt1 (mapcar '+ pt1 Deriv)) 
        l     (vlax-curve-getdistatPoint en1 (vlax-curve-getendPoint en1)) 
        n     (fix(/ (- l 0.4) 0.533333)) 
        i     0 
  ) 
  (repeat (1+ n) 
    (setq pt (vlax-curve-getPointAtDist en1 (+ 0.4 (* 0.53333 i))) 
          i  (1+ i) 
    ) 
    (if        (equal Deriv '(0. 0. 0.) 1e-6) 
      (entmake (list '(0 . "line") 
                     (cons 10 pt) 
                     (cons 11 (polar pt ang1 0.46666666666)) 
               ) 
      ) 
      (if (equal ang1 ang2 1e-6) 
        (entmake 
          (list 
            '(0 . "line") 
            (cons 10 pt) 
            (cons 
              11 
              (polar pt 
                     (angle pt 
                            (mapcar '+ 
                                    pt 
                                    (vlax-curve-getSecondDeriv 
                                      en1 
                                      (vlax-curve-getParamAtPoint en1 pt) 
                                    ) 
                            ) 
                     ) 
                     0.46666666666 
              ) 
            ) 
          ) 
        ) 
        (entmake 
          (list 
            '(0 . "line") 
            (cons 10 pt) 
            (cons 
              11 
              (polar 
                pt 
                (+ pi 
                   (angle pt 
                          (mapcar '+ 
                                  pt 
                                  (vlax-curve-getSecondDeriv 
                                    en1 
                                    (vlax-curve-getParamAtPoint en1 pt) 
                                  ) 
                          ) 
                   ) 
                ) 
                0.46666666666 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (command "undo" "end") 
  (princ) 
)

夏生生 · 发表于 2015-5-22 16:45:53

不知道是否需要考虑起弧落弧

夏生生 · 发表于 2015-5-23 10:08:08

本帖最后由夏生生于 2015-5-23 10:23 编辑

什么专业画焊缝这么画啊？随便写的，比较随意，选择框中心在线的哪一边就画在哪一边，可用于直线与圆弧，代码见楼下

ly8zx2109 · 发表于 2015-5-23 17:41:33

好的，谢谢。如调整线的长度和间距需调哪些数据。谢谢

夏生生 · 发表于 2015-5-24 08:59:19

里面的0.4,0,466,0.533

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

求优化。画焊缝的程序，图形大时执行很慢。谢谢

最佳答案

相关帖子

本帖子中包含更多资源