scr_mod.lsp

plc设计编程软件

(defun load_fun()
  (load "screwlib")
  (load "cap_cst")
  (load "cap_zst")
  (load "set_cst")
  (load "set_zst")
  (load "flat_cst")
  (load "flat_zst")
)
  
;------------------------------------------------------------------------------------;
(defun sedit( / la_old 		os_old 		lt_old		st_old		co_old	
		chin		desc 		spec 		spec_new	rep    	
		rep_new 	if_h_v		m_b 	 	dcl_id d	d_new 	
		pw_old		all_set		ent_count	ent_name  	k	
		orgpt		what_next	mb		zc		scd_id	
		if_del_lb	INU		err_msg)
  (setvar "cmdecho" 0)
  (command "undo" "m")
  (setq la_old (getvar "clayer")
	os_old (getvar "osmode")
	la_old (getvar "clayer")
	lt_old (getvar "celtype")
	co_old (getvar "cecolor")
	pw_old (getvar "plinewid")
	st_old (getvar "textstyle")
	orgpt  (getvar "ucsorg")
  )

  (if (not (tblsearch "layer" "screw"))
    (command "layer" "n" "screw" "c" "white" "screw" "l" "continuous" "screw" "")
    (command "_.layer" "thaw" "screw" "on" "screw" "unlock" "screw" "")
  )
  (setvar "clayer" "screw")
  (setvar "plinewid" 0)
  (ini_useri2)

  (if (not (and scr_lib
	   	cap_cst
	   	cap_zst
	   	cap_zst
	   	set_cst
	   	set_zst
	   	flat_cst
           	flat_zst
	   )
      )
      (load_fun)
  )
  (setq INU T)
  (while INU
    (setq screw_ent (entsel))
    (if (not screw_ent)
      (setq screw_ent (entsel))
      (progn
        (setq screw_ent (car screw_ent))
        (if (assoc -3 (entget screw_ent '("screw")))
          (if (/= "screw" (car (cadr (assoc -3 (entget screw_ent '("screw"))))))
            (princ "\nIt is not a screw item!\n")
	    (setq INU nil)
	  )
	)
      )
    )
  )
  (setq screw_data (cdr (cadr (cadr (assoc -3 (entget screw_ent '("screw")))))))
  (setq screw_data (strtolst screw_data))
  (progn
     (setq rep_old  (nth 0 screw_data)
	   mb       (nth 6 screw_data)
	   type_old (nth 2 screw_data)
	   len_old  (nth 3 screw_data)
	   zc       (nth 1 screw_data)
           if_h_v   (nth 4 screw_data)
           typ_old  (nth 5 screw_data)
           spec_old (strcat type_old "X" len_old)
     )
     (if (= "C" zc)
       (setq ang (atof (nth 7 screw_data)))
     )
     (cond
       ((= "CAP" typ_old)
	(setq chin "杯头螺丝")
	(setq desc "S.H.C.S")
       )
       ((= "SET" typ_old)
	(setq chin "无头螺丝")
	(setq desc "S.H.S.S")
       )
       ((= "FLAT" typ_old)
	(setq chin "平头螺丝")
	(setq desc "F.H.C.S")
       )
     )
  )
  (setq scd_id (load_dialog "screw.dcl"))
  (setq edit_next 1)
  (while (= 1 edit_next) 
    (if (not (new_dialog "screditdlg" scd_id))
      (exit)
    )
    (set_tile  "rep"   rep_old)
    (set_tile  "chin"  chin)
    (set_tile  "desc"  desc)
    (set_tile  "cot"   spec_old)
    (mode_tile "desc" 1)
    (mode_tile "chin" 1)
    (if err_msg
      (set_tile "MSG" err_msg)
    )
    (action_tile "accept" "(rep_get) (done_dialog 2)")
    (action_tile "E_DEL"  "(rep_get) (done_dialog 4)")
    (action_tile "rep"    "(setq rep_r  $reason) (valid_verify)")
    (action_tile "cot"    "(setq spec_r $reason) (valid_verify)")
    (action_tile "cancel" "(done_dialog 3)")
    (setq what_next (start_dialog))
    (cond
      ((= 2 what_next)
        (setq if_del_lb 0)
        (setq edit_next 0)
        (if (and (or rep_new spec_new)
	         (or (/= rep_old rep_new) (/= spec_old spec_new))
	         (not err_msg)
            )
          (if (= 1 if_all_lb)
            (progn
	      (princ "\nAnalyzing entity, Please wait a moment...")
              (setq all_set (ssget "X" '((0 . "INSERT") (-3 ("screw")))))
  	      (setq ent_count (sslength all_set))
  	      (setq i 0)
  	      (while (< i ent_count)
	        (setq ent_name (ssname all_set i))
	        (screw_modify ent_name)
	        (setq i (+ i 1))
	      )
            )
            (screw_modify screw_ent)
          )
          (setq edit_next 1)
        )
      )
      ((= 3 what_next)
        (setq edit_next 0)
      )
      ((= 4 what_next)
        (setq if_del_lb 1)
        (setq edit_next 0)
        (if (= 1 if_all_lb)
          (progn
	    (princ "\nAnalyzing entity, Please wait a moment...")
            (setq all_set (ssget "X" '((0 . "INSERT") (-3 ("screw")))))
  	    (setq ent_count (sslength all_set))
  	    (setq i 0)
  	    (while (< i ent_count)
	      (setq ent_name (ssname all_set i))
              (screw_del ent_name)
	      (setq i (+ i 1))
	    )
          )
          (screw_del screw_ent)
        )
      )
    )
  )
  (unload_dialog scd_id)
  (ac_lxy_set)
  (princ "done")
  (prin1)
)
;------------------------------------------------------------------------------------;	

;------------------------------------------------------------------------------------;	
(defun rep_get()
  (if (= "1" (get_tile "if_all"))
	(setq if_all_lb 1)
	(setq if_all_lb 0)
  )
) 


;------------------------------------------------------------------------------------;	
(defun screw_modify(ent_name / con_lb)
  (setq screw_data (cdr (cadr (cadr (assoc -3 (entget ent_name '("screw")))))))
  (setq screw_data (strtolst screw_data))
  (progn
    (setq rep      (nth 0 screw_data)
	  mb       (nth 6 screw_data)
	  typ_cur  (nth 2 screw_data)
	  len      (nth 3 screw_data)
	  zc       (nth 1 screw_data)
          if_h_v   (nth 4 screw_data)
          typ      (nth 5 screw_data)
          spec     (strcat typ_cur "X" len)
    )
    (if (= "C" zc)
      (setq ang    (atof (nth 7 screw_data))
	    l12    (atof (nth 8 screw_data))
      )
    )
    ;(setq pt   (wtou (cdr (assoc 10 (entget ent_name)))))
    (setq pt   (cdr (assoc 10 (entget ent_name))))
    (if (= -1.0 (cdr (assoc 41 (entget ent_name))))
      (progn
        (setq ang_mirr (cdr (assoc 50 (entget ent_name))))
        (setq ang_mirr (/ ang_mirr 2))
        (setq ang_mirr (+ ang_mirr (/ pi 2)))
        (if (< pi ang_mirr)
          (setq ang_mirr (- ang_mirr pi))
        )
        (if (= "C" zc)
          (progn
	    (setq ang_mirr (- (- ang (* (fix (/ ang pi)) pi)) ang_mirr))
	    (setq ang (- ang (* 2 ang_mirr)))
          )
        )
      )
      (if (= "C" zc)
        (setq ang (+ ang (cdr (assoc 50 (entget ent_name)))))
      )
    )
    (if (= "C" zc)
      (progn
        (if (> ang (* pi 2))
          (setq ang (- ang (* pi 2)))
        )
        (if (< ang 0)
          (setq ang (+ ang (* 2 pi)))
        )
      )
    )
  )
  (if (= rep rep_old)
    (progn
      (if (/= spec spec_old)
        (progn
          (redraw ent_name 3)
          (command "zoom" "c" pt 50)
          (setq con_lb (yn  (strcat "发现不同规格" spec "! 更新?")))
          (if (/= typ_old typ)
            (progn
              (if (= 1 con_lb)
                (alert "发现不同类型螺丝, 无法更新!")
              )
              (setq con_lb 0)
            )
            (if (= 0 con_lb)
              (redraw ent_name 4)
            )
          )
	  (command "zoom" "p")
        )
        (progn
          (setq con_lb 1)
          (if (/= typ_old typ)
            (progn
              (redraw ent_name 3)
              (command "zoom" "c" pt 50)
              (alert (strcat "发现" rep "编号中有不同类型螺丝!"))
              (setq con_lb 0)
            )
          )
        )
      )
      (if (= 1 con_lb)
        (progn
          (entdel ent_name)
          (setq rep rep_new)
          (setq app_typ "OLD")
          (cond
	    ((= "C" zc)
	      (cond
		((= "CAP" typ)
		  (cap_cst)
		)
		((= "SET" typ)
		  (set_cst)
		)
		((= "FLAT" typ)
		  (flat_cst)
		)
	      )
	    )
	    ((= "Z" zc)
              (setq cenpt pt)
	      (cond
		((= "CAP" typ)
		  (cap_zst)
		)
		((= "SET" typ)
		  (set_zst)
		)
		((= "FLAT" typ)
		  (flat_zst)
		)
	      )
            )
          )
        ) 
      )
    )
  )
)

(defun screw_del(ent_name / con_lb)
  (setq screw_data (cdr (cadr (cadr (assoc -3 (entget ent_name '("screw")))))))
  (setq screw_data (strtolst screw_data))
  (progn
    (setq rep      (nth 0 screw_data)
	  mb       (nth 6 screw_data)
	  typ_cur  (nth 2 screw_data)
	  len      (nth 3 screw_data)
	  zc       (nth 1 screw_data)
          if_h_v   (nth 4 screw_data)
          typ      (nth 5 screw_data)
          spec     (strcat typ_cur "X" len)
    )
    (if (= "C" zc)
      (setq ang (atof (nth 7 screw_data)))
    )
  )
  (if (= rep rep_old)
    (progn
      (if (/= spec spec_old)
        (progn
          (redraw ent_name 3)
          (command "zoom" "c" pt 50)
          (if (/= typ_old typ)
            (setq con_lb (yn  (strcat "发现不同类型螺丝! 删除?")))
            (setq con_lb (yn  (strcat "发现不同规格" spec "! 删除?")))
          )
          (command "zoom" "p")
        )
        (progn
          (setq con_lb 1)
          (if (/= typ_old typ)
            (progn
              (redraw ent_name 3)
              (command "zoom" "c" pt 50)
              (setq con_lb (yn  (strcat "发现不同类型螺丝! 删除?")))
              (command "zoom" "p")
            )
          )
        )
      )
      (if (= 1 con_lb)
        (entdel ent_name)
        (redraw ent_name 4)
      )
    )
  )
)



(defun valid_verify()
  (if (or (= 2 rep_r) (= 2 spec_r))
    (progn
;--------------------------------------------------
;Verify item number
;--------------------------------------------------
      (setq rep_new (lxy_trim (get_tile "rep")))
      (if (> 2 (strlen rep_new))
        (setq err_msg "Invalid item number!")
        (if (/= "V" (substr rep_new 1 1))
          (setq err_msg "Invalid item number!")
          (if (= 0.0 (atof (substr rep_new 2)))
            (setq err_msg "Invalid item number!")
            (setq err_msg nil)
          )
        )
      )
;---------------------------------------------------
;Verify screw specification
;---------------------------------------------------
      (setq spec_new (lxy_trim (get_tile "cot")))
      (if (not (lxy_word spec_new "X"))
	(setq err_msg "Invalid screw specification!")
        (progn
          (setq screw_type (substr spec_new 1 (- (lxy_word spec_new "X") 1))
	   	screw_len  (substr spec_new (+ (lxy_word spec_new "X") 1) (- (strlen spec_new) (lxy_word spec_new "X")))
    	  )
          (cond
            ((= "CAP" typ_old)
	      (setq lib1 (strcat "SHCS" mb)
	            n    (xh_get screw_type (scr_lib lib1 "spec")))
	      (if (not n)
	        (setq err_msg "Invalid screw specification!")
                (progn
	          (setq d  (nth n (scr_lib lib1 "d_ct"))
	                hd (nth n (scr_lib lib1 "d_ch"))
	                s  (nth n (scr_lib lib1 "cs"))
	                b  (nth n (scr_lib lib1 "cb"))
	                m  (xh_get screw_len (nth n (scr_lib lib1 "cl")))
                  )
	          (if (not m)
	            (setq err_msg "Invalid screw specification!")
	            (if (= "B" mb)
                      (setq l  (nth m (nth n (scr_lib lib1 "cll")))
	    	            l  (* l 25.4)
	    	            d  (* d 25.4)
	    	            s  (* s 25.4)
	    	            b  (* b 25.4)
	    	            hd (* hd 25.4)
                      )
     	              (setq l (atof screw_len))
                    )
                  )
                )
              )
            )
            ((= "FLAT" typ_old)
	      (setq lib1 (strcat "SHFS" mb)
	            n    (xh_get screw_type (scr_lib lib1 "spec")))
	      (if (not n)
	        (setq err_msg "Invalid screw specification!")
                (progn
	          (setq d  (nth n (scr_lib lib1 "d_ct"))
	                hd (nth n (scr_lib lib1 "d_ch"))
	                s  (nth n (scr_lib lib1 "cs"))
	                k  (nth n (scr_lib lib1 "ck"))
	                m  (xh_get screw_len (nth n (scr_lib lib1 "cl")))
                  )
	          (if (not m)
	            (setq err_msg "Invalid screw specification!")
	            (if (= "B" mb)
                      (setq l  (nth m (nth n (scr_lib lib1 "cll")))
	    	            l  (* l 25.4)
	    	            d  (* d 25.4)
	    	            s  (* s 25.4)
	    	            k  (* k 25.4)
	    	            hd (* hd 25.4)
                      )
     	              (setq l (atof screw_len))
                    )
                  )
                )
              )
            )
            ((= "SET" typ_old)
	      (setq lib1 (strcat "SHSS" mb)
	            n    (xh_get screw_type (scr_lib lib1 "spec")))
	      (if (not n)
	        (setq err_msg "Invalid screw specification!")
                (progn
	          (setq d  (nth n (scr_lib lib1 "d_ct"))
	                s  (nth n (scr_lib lib1 "cs"))
	                z  (nth n (scr_lib lib1 "cz"))
	                m  (xh_get screw_len (nth n (scr_lib lib1 "cl")))
                  )
	          (if (not m)
	            (setq err_msg "Invalid screw specification!")
	            (if (= "B" mb)
                      (setq l  (nth m (nth n (scr_lib lib1 "cll")))
	    	            l  (* l 25.4)
	    	            d  (* d 25.4)
	    	            s  (* s 25.4)
	    	            z  (* z 25.4)
                      )
     	              (setq l (atof screw_len))
                    )
                  )
                )
              )
            )
          )
        )
      )
    )
  )
  (if err_msg 
    (set_tile "MSG" err_msg)
  )
)