熔断线画法（开源） 希望对大家有用 新手

qcw911

熔断线
lisp部分
(defun c:hf()
(sub_chk_layer)

(dcl_hf)
(command "LAYERP" )
(reset)
(prin1)
)
(defun dcl_hf()
  (setq dcl_id (load_dialog "C:\\lisp\\050\\hf.dcl"))
  (new_dialog "hf" dcl_id)
  
  (def_hf)
  (mode_tile "krad" 2)
  (action_tile "kimage" "(setq ddd 1)")
  (action_tile "accept" "(ok_hf)(done_dialog 1)")
  (setq ddd (start_dialog))
  (if (= ddd 1)
         
          (draw)
    )
  )
(defun ok_hf()
  (setq rad (atof(get_tile"krad")))
  )
         
(defun def_hf()
   (set_tile "krad" "1.5")
   
   (show_sld  "kimage" "C:\\lisp\\050\\kimage.sld")
  )  
(defun show_sld(key sld)
   (setq x (dimx_tile key))
   (setq y (dimy_tile key))
   (start_image key)
   (fill_image 0 0 x y -2)
   (slide_image 0 0 x y sld)
   (end_image)
)

(defun draw()


;;;  (setq rad (getreal"\n請輸入半徑<1>:"))
;;;  (if (null rad) (setq rad 1))
  (setq pts (getpoint"\n 請輸入起點:"))
  (setq pte (getpoint pts"\n 請輸入終點:"))
  (ini)
  (setq ang (angle pts pte))
  (setq pt2 (polar pts (+ ang 0) (* rad 2)))
  (setq pt1 (polar pts (+ ang (/ pi 4)) (* rad (sqrt 2))))
  (setq dd (distance pts pte))
  (setq  nn (fix (/ dd rad)))
     (command "_arc" pts pt1 pt2)
    (setq en1 (entlast))
    (setq pt3 (polar pts (+ ang 0) rad))
    (setq pt4 (polar pt2 (+ ang 0) rad))
    (setq pt5 (polar pt1 (+ ang 0) rad))
    (repeat  (- nn 2)
       (command "_arc" pt3 pt5 pt4)
       (setq en2 (entlast))
       (command "_TRIM" en1"" (list en2 pt3 ) "")
       (setq  en1 en2)
       (setq pt3 (polar pt3 (+ ang 0) rad))
       (setq pt4 (polar pt4 (+ ang 0) rad))
       (setq pt5 (polar pt5 (+ ang 0) rad))
    )
)
(defun ini()
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq oldos (getvar "osmode")
        olderror *error*
  )
  (setvar "osmode" 0)
  (setq *error* interror)
)
(defun reset()
        (setvar "osmode" oldos)
        (setq *error* olderror)
        (princ)
        (command "undo" "e")
        (setvar "cmdecho" 1)
        (princ)
)
(defun sub_chk_layer()
   (setq chklay (tblsearch "layer" "TOS_S3"))
   (if (= chklay nil)
     (progn
       (alert "没有新建TOS_S3，確定新建！")
       (command "_layer" "N" "TOS_S3" "c"  "21" "TOS_S3" "")
       )
   )
     (setvar "clayer" "TOS_S3")
)


dcl部分
hf:dialog {
    label = "縫線    教育G 仇" ;
     initial_focus="edit_box";
    :boxed_column {
        label = "設計參數" ;
        :image_button{
            key="kimage";
            color= -2;
            width=30;
            aspect_ratio = 0.66;
            allow_accept= true;
            }
        :edit_box {
            label = "縫線半徑（R）" ;
            key = "krad" ;
           
        }
    }
    spacer_1;
    ok_cancel;
}

xhq1954425

谢谢分享呀！