ac_lxy.lsp

plc设计编程软件

              pt2_temp nil)
      )
    )
    ((= 1 ver_lb)
      (setq b (car point1))
      (setq a0 1)
      (setq b0 (- 0 (* 2 (cadr pt_cen))))
      (setq c0 (- (+ (* (cadr pt_cen) (cadr pt_cen)) 
		     (* (- b (car pt_cen)) (- b (car pt_cen)))
                  ) 
                  (* cir cir)))
      (setq temp (- (* b0 b0) (* 4 a0 c0)))
      (if (>= temp 0)
        (progn
 	  (setq y1 (/ (+ (- 0 b0) (sqrt temp)) (* 2 a0)))
 	  (setq x1 b)
 	  (setq y2 (/ (- (- 0 b0) (sqrt temp)) (* 2 a0)))
 	  (setq x2 b)
 	  (setq pt1_temp (list x1 y1))
 	  (setq pt2_temp (list x2 y2))
 	  (if (= 0 temp)
	    (setq pt2_temp nil)
	  )
        )
        (setq pt1_temp nil
              pt2_temp nil)
      )
    )
  )
  (if pt1_temp
    (if (not pt2_temp)
      (list pt1_temp)
      (list pt1_temp pt2_temp)
    )
  )    
)
;********************************* End of function *********************************;


;************************* Get intersection point function4 ************************;
;get intersection point between line and pline
;point1 and point2 are two point on a line
;pline_ent is pline entity
;if    having intersection point and the point is on the side of point2
;then  return the point
;else  return nil
;***********************************************************************************;
(defun pline_int(point1 point2 pline_ent mtrptlst / intpt i pt_list
)

  (setq pt_list (ep_list (entget pline_ent)))
  (cond 
    ((= "L" (car pt_list))
      (if (not mtrptlst)
        ;(setq intpt (line_int (wtou (nth 1 pt_list)) (wtou (nth 2 pt_list)) point1 point2))
	(PROGN
	
	(setq intpt (line_int (nth 1 pt_list) (nth 2 pt_list) point1 point2))
	(print "not mtrptlst")
	)
	(PROGN 
	
        (setq intpt (line_int (mtou (nth 1 pt_list) mtrptlst)
			      (mtou (nth 2 pt_list) mtrptlst)
			      point1 point2)
        )
	(PRInt "NOT XXX\N")
	)
      )
    )
    ((= "C" (car pt_list))
      (if mtrptlst
        (setq intpt (circ_int point1 point2 
			      (mtou (nth 1 pt_list) mtrptlst)
			      (* (nth 2 pt_list) (caddr (last mtrptlst))))
        )
        ;(setq intpt (circ_int point1 point2 (wtou (nth 1 pt_list)) (nth 2 pt_list)))
	(setq intpt (circ_int point1 point2 (nth 1 pt_list) (nth 2 pt_list)))
      )
    )
    ((= "A" (car pt_list))
      (if mtrptlst
        (setq intpt (arc_int (mtou (nth 1 pt_list) mtrptlst) 
	                     (mtou (nth 2 pt_list) mtrptlst) 
			     (mtou (nth 3 pt_list) mtrptlst)
		             point1 point2)
        )
        ;(setq intpt (arc_int (wtou (nth 1 pt_list)) (wtou (nth 2 pt_list)) (wtou (nth 3 pt_list)) point1 point2))
	(setq intpt (arc_int (nth 1 pt_list) (nth 2 pt_list) (nth 3 pt_list) point1 point2))
      )
    )
    ((= "PL" (car pt_list))
      (setq pt_count (- (length pt_list) 1))
      (setq i 1)
      (while (and (not intpt) (<= i pt_count))
        (setq intpt (nth i pt_list))
        (if mtrptlst
	  (cond
	    ((= "A" (car intpt))
              (setq intpt (arc_int (mtou (nth 1 intpt) mtrptlst) 
				   (mtou (nth 2 intpt) mtrptlst) 
				   (mtou (nth 3 intpt) mtrptlst) 
			           point1 point2)
              )
              (if intpt
	        (setq intpt (car intpt))
              )
            )
            ((= "L" (car intpt))
              (setq intpt (line_int (mtou (nth 1 intpt) mtrptlst)
              			    (mtou (nth 2 intpt) mtrptlst)				
			            point1 point2)
              )
            )
            ((= intpt (nth i pt_list))
              (setq intpt nil)
            )
          )
	  (cond
	    ((= "A" (car intpt))
              (setq intpt (arc_int (wtou (nth 1 intpt)) (wtou (nth 2 intpt)) (wtou (nth 3 intpt)) point1 point2))
              (if intpt
	        (setq intpt (car intpt))
              )
            )
            ((= "L" (car intpt))
              ;(setq intpt (line_int (wtou (nth 1 intpt)) (wtou (nth 2 intpt)) point1 point2))
		(setq intpt (line_int (nth 1 intpt) (nth 2 intpt) point1 point2))
            )
            ((= intpt (nth i pt_list))
              (setq intpt nil)
            )
          )
        )
        (setq i (+ i 1))
      )
    )
  )
  intpt
)
;************************************* End of function *************************************;


;*********************************** Make block function ***********************************;
;make block from entities selection
(defun mblk(blk_name blk_intpt blk_sel)
  (command "block" blk_name blk_intpt blk_sel "")
  (command "insert" blk_name blk_intpt "" "" "")
)
;************************************* End of function *************************************;


;******************************** Make block xdata function ********************************;
;add extend data to a entity
(defun mxdata(ent_name xlist / ed)
  (setq ed (entget ent_name))
  (setq ed (append ed xlist))
  (entmod ed)
)
;************************************* End of function *************************************;


;*************************** define private message box function ***************************;
(defun yn(msg / ret yn_id)
  (if (and msg (/= "" msg))
    (progn
      (setq yn_id (load_dialog "yn.dcl"))
      (if (not (new_dialog "yndlg" yn_id))
        (progn
          (alert "系统文件丢失!")
          (exit)
        )
      )
      (set_tile "msg" msg)
      (action_tile "accept" "(done_dialog 1)")
      (action_tile "cancel" "(done_dialog 0)")
      (setq ret (start_dialog))
      (unload_dialog yn_id)
    )
  )
  ret
)
;************************************* End of function *************************************;


;****************** Translate ordinate between WCS mcs and UCS function ********************;
;translate WCS TO UCS: (wtou <point_WCS> )
;translate UCS TO WCS: (utow <point_UCS> )
;translate mCS TO WCS: (mtow <point_MCS> <mtrlst> )
;translate mCS TO UCS: (mtou <point_MCS> <mtrlst> )
;*******************************************************************************************;
(defun wtou(point)
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
  (setq pt (list (- (car point)  (car (command "ucsorg")))
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
                 (- (cadr point) (cadr (command "ucsorg")))
           ))
)
(defun utow(point)
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
  (setq pt (list (+ (car point)  (car (command "ucsorg")))
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
                 (+ (cadr point) (cadr (command "ucsorg")))
            ))
)
(defun mtow(point mtrlst)
	
  (setq m00 (nth 0 (nth 0 mtrlst))
	m01 (nth 1 (nth 0 mtrlst))
	m02 (nth 2 (nth 0 mtrlst))
	m10 (nth 0 (nth 1 mtrlst))
	m11 (nth 1 (nth 1 mtrlst))
	m12 (nth 2 (nth 1 mtrlst))
	m20 (nth 0 (nth 2 mtrlst))
	m21 (nth 1 (nth 2 mtrlst))
	m22 (nth 2 (nth 2 mtrlst))
	m30 (nth 0 (nth 3 mtrlst))
	m31 (nth 1 (nth 3 mtrlst))
	m32 (nth 2 (nth 3 mtrlst))
  )

  (if (>= (length point) 2)
    (progn

      (if (= 2 (length point))
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
        (setq point (append point (list (caddr (command "ucsorg")))))
      )
      (setq point (list (+ (* (car point) m00) (* (cadr point) m10) (* (caddr point) m20) m30)
	                (+ (* (car point) m01) (* (cadr point) m11) (* (caddr point) m21) m31)
	                (+ (* (car point) m02) (* (cadr point) m12) (* (caddr point) m22) m32)
                  )
      )
    )

    (setq point nil)
  )
  point
)
(defun mtou(point mtrlst)
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
  (setq point (list (- (car  (mtow point mtrlst))  (car (command "ucsorg")))
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
                    (- (cadr (mtow point mtrlst))  (cadr (command "ucsorg")))
            ))
)
;************************************* End of function *************************************;


;****************************** Trim space from string function ****************************;
;(lxy_trim <string> )
; Trims leading and trailing spaces from strings.
;*******************************************************************************************;
(defun lxy_trim (string)
  (cond 
    ((/= (type string) 'str) nil)
    (t (lxy_l_trim (lxy_r_trim string)))
  )
)
(defun lxy_l_trim (string)
  (cond 
    ((eq string "") string)
    ((/= " " (substr string 1 1)) string)
    (t (lxy_l_trim (substr string 2)))
  )
)
(defun lxy_r_trim (string)
  (cond 
    ((eq string "") string)
    ((/= " " (substr string (strlen string) 1)) string)
    (t (lxy_r_trim (substr string 1 (1- (strlen string)))))
  )
)
;************************************* End of function *************************************;

;******************************** Get word sequence function *******************************;
; (lxy_word <string> <word> )
; Get word's sequence in string
;*******************************************************************************************;
(defun lxy_word(string word / i count_i)
  (if (/= (type string) 'str)
    nil
    (progn
      (setq i 0)
      (while (<= (+ i (strlen word)) (strlen string))
	(if (= word (substr string (+ i 1) (strlen word)))
	  (setq count_i (+ i 1))
	)
	(setq i (+ i 1))
      )
      (if count_i count_i nil)
    )
  )
)
;************************************* End of function *************************************;

;******************************** Get word sequence function *******************************;
; (ini_useri2)
; Initializing "useri2" system variable
;*******************************************************************************************;
(defun ini_useri2(/ strtmp	epin_count pin_count)
  (setq block_list '())
  (setq new_search nil)
  (while (setq new_search (tblnext "BLOCK" (not block_list)))
    (if new_search
      (setq block_list (cons (cdr (assoc 2 new_search)) block_list))
    )
  )
  (if block_list 
    (foreach str block_list
      (progn
        (setq i (strlen str))
        (if (> i 10)
	  (progn
            (setq strtmp (substr str 1 10))
	    (if (= "AC_LXY_BLK" (strcase strtmp))
	      (if useri2_count 
		(if (> (atoi (substr str 11)) useri2_count)
		  (setq useri2_count (atoi (substr str 11)))
		)
		(setq useri2_count (atoi (substr str 11)))
	      )
	    )
	  )
        )
      )
    )  
  )
  (if useri2_count
    (setvar "useri2" (+ 1 useri2_count))
    (setvar "useri2" 0)
  )
)
;************************************* End of function *************************************;

;*********************************** Translate real to char ********************************;
(defun RemZeroR(num / temp)
  (cond
    ((= 'REAL (type num))
      (if (equal 0.0 num 0.00001)
        (setq temp "0.0")
        (progn
          (setq temp (rtos num 2 5))
 	  (if (lxy_word temp ".")
            (while (= "0" (substr temp (strlen temp) 1))
	      (setq temp (substr temp 1 (- (strlen temp) 1)))
	    )
          )
	  (if (= "." (substr temp (strlen temp) 1))
	    (setq temp (substr temp 1 (- (strlen temp) 1)))
	  )
        )
      )
    )
    ((= 'INT (type num))
      (setq temp (itoa num))
    )
    ((= 'STR (type num))
      (setq temp (lxy_trim num))
    )
    ((not num) (setq temp ""))
  )
  temp
)
;************************************* End of function *************************************;

;************************************ Convert ASCII Code to Char ***************************;
(defun char(num / Arry1 Arry2)
  (setq Arry1 '("a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t"
		"u" "v" "w" "x" "y" "z"))
  (if (and (>= num 65) (<= num 90))
    (setq temp (strcase (nth (- num 65) Arry1)))
    (if (and (>= num 97) (<= num 126))
      (setq temp (nth (- num 97) Arry1))
      (setq temp nil)
    )
  )
  temp
)
;************************************* End of function *************************************;