;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;幕匠LISP实验室;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;程序功能：画焊缝   [备注：]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:hf (/ old cmdold lyold)
   (setq old *error*)
   (defun *error* (msg)
       (if 
         (or 
           (/= msg "Function cancelled")
           (= msg "quit / exit abort") 
         )
         (princ)
         (princ (strcat "\nError: " msg))
       )
       (setq *error* old)
       (setvar "clayer" lyold)
       (setvar "blipmode" bpmold)
       (setq old nil base nil cmdold nil lyold nil bpmold nil *error* nil)
       (princ)
   );defun error
   (setq welayer "焊缝")
   (setq cmdold (getvar "cmdecho"))
   (setq lyold (getvar "clayer"))
   (setq bpmold (getvar "blipmode"))
   (setvar "CMDECHO" 0)
;;; default value routine
  (if (= wsz nil) (setq wsz 4.0))
  (princ (strcat "\n输入焊缝厚度 <" (rtos wsz 2 2) ">: "))
  (setq a (getreal))
  (if (= a nil) (setq a wsz))
  (setq wsz a)
  (vl-cmdf ".undo" "be")
  (initget "Sideweld Planweld Circle")
  (setq select (getkword "\n焊缝符号<S>/圆焊缝<C>/直线焊缝<P>:<直线焊缝> "))
  (cond	((= SELECT "Sideweld") (WELD_SECT))
	((= SELECT "Planweld") (WELD_PLAN))
	((= SELECT "Circle") (WELD_CIRCLE wsz))
	(t (WELD_PLAN))
  )
  (setq old nil)
  (setvar "CMDECHO" CMDOLD)
  (setvar "blipmode" 0)
  (setvar "clayer" lyold)
  (vl-cmdf ".undo" "end")
  (princ)
); end
;;; weld section routine
(defun weld_sect (/ ipt weld-lay)
   (setvar "blipmode" 1)
   (setq ipt (getpoint "\n 指定插入点: "))
   (setq weld-lay (tblsearch "layer" welayer))
        (if (= weld-lay nil)
            (command ".layer" "N" welayer "c" "1" welayer "")
        )
   (setvar "clayer" welayer)
   (command ".insert" "焊缝符号" ipt wsz "" pause)
   (command ".explode" (entlast))
   (command ".chprop" "p" "" "la" welayer "")
)
;;; new weld plan routine
(defun weld_plan (/ pt1 pt2 pt3 pt4 weld-l weld-n weld-ang)
  (if (= (tblsearch "layer" welayer) nil)
      (command ".layer" "N" welayer "c" "1" welayer "")
  )
  (setvar "clayer" welayer)
  (setvar "blipmode" 1)
  (command "ucs" "w")
  (princ "\n焊缝按顺时针围绕被焊物体.")
  (setq pt1 (getpoint "\指定第一点:")
	pt2 (getpoint pt1 "\n指定第二点 :")
	weld-l (distance pt1 pt2)
	weld-n (fix (/ weld-l wsz))
	weld-ang (angle pt1 pt2)
	pt3 pt1
  )
  (setq os_save (getvar "osmode"))
  (setvar "osmode" 0)
  (command ".pline" pt1 "a")
  (repeat (- weld-n 2)
    (command "ce" (setq pt4 (polar pt3 weld-ang wsz)) "a" "-120")
    (command "d" pt3 pt4)
    (setq pt3 pt4)
  )
  (command "ce" (setq pt4 (polar pt3 weld-ang wsz)) "a" "-180" "")
  (command "ucs" "p")

  (setvar "osmode" os_save)
  (setq os_save nil)
); end weld_plan

(defun WELD_CIRCLE (wsz / cent cent-r cent-c cent-q 1st-ang 1st-pt arc-ang) 
  (if (= (tblsearch "layer" welayer) NIL)
    (vl-cmdf ".layer" "N" welayer "c" "1" welayer "")
  )
  (setvar "clayer" welayer)
  (setvar "blipmode" 1)
  (vl-cmdf "ucs" "w")
  (defun DTR (A) (* pi (/ A 180.0)))
  (defun RTD (A) (/ (* A 180.0) pi))
  (defun ACOS (VAL) (atan (/ (sqrt (- 1.0 (* VAL VAL))) VAL)))
  (defun ^2 (A) (* A A))
  (defun XENTSEL1 (MSG FILTER / EL)
    (if	(and (setq EL (entsel MSG))
	     (= (cdr (assoc 0 (entget (car EL)))) FILTER)
	)
      EL
      NIL
    )
  )
  (setq CENT nil)
  (while (= CENT NIL)
    (setq CENT (entget (car (XENTSEL1 "\n请选择要加焊缝的圆:" "CIRCLE"))))
  )
  (setq	CENT-R	(cdr (assoc 40 CENT))
	CENT-C	(cdr (assoc 10 CENT))
	CENT-Q	(polar CENT-C (DTR 90) CENT-R)
	1ST-ANG	(ACOS (/ (- (^2 WSZ) (* 2 (^2 CENT-R))) (- 0 (* 2 (^2 CENT-R)))))
	1ST-PT	(polar CENT-C (+ 1ST-ANG (dtr 90))CENT-R)
	ARC-ANG	(- (DTR 240) 1ST-ANG)
  )
  (setq OS_SAVE (getvar "osmode"))(rtd 1st-ang)
  (setvar "osmode" 0)
  (vl-cmdf ".arc" "c" cent-q 1st-pt "A" (- (RTD ARC-ANG) 360))
  (vl-cmdf ".array"
	   (entlast)
	   ""
	   "p"
	   CENT-C
	   (atoi (rtos (/ (DTR 360) 1ST-ANG) 2 0))
	   "360"
	   "y"
  )
  (vl-cmdf "ucs" "p")
  (setvar "osmode" OS_SAVE)
  (setq OS_SAVE NIL)
)
(princ)