AutoLisp 源代码 实用程序7_rev3

;=========================================== (defun 7inputI ()
(setvar "osmode" os)
(PRINC "\n")
(PRINC FNUM)
(setq st (getstring "\nCan i help you OR End the process
<Y/S/P/C>"))
(if (or (= st "y") (= st "Y"))
(progn
(command "find")
(setq st (getstring "\nCan i help you OR End the process
<Y/S/P/C>"))
)
)
(if (or (= st "S") (= st "s"))
(progn
(setq sca (getint "\nSpecify the scale of view: "))
(setq
st (getstring "\nCan i help you OR End the process
<Y/P/C>")
)
)
)
(if (or (= st "c") (= st "C"))
(setq whinum 200)
)
;=======================
(if (or (= st "p") (= st "P"))
(progn
(setq p0 (getpoint "\nSpecify the first point: ")
p1 (getpoint "\nSpecify the second point: ")
p2 (getpoint "\nSpecify the first point: ")
p3 (getpoint "\nSpecify the second point: ")
)
(if (> (* sca (distance p0 p1)) (* sca (distance p2
p3)))
(progn
(setq di (* sca (distance p0 p1)))
(setq dii (* sca (distance p2 p3)))
)
(progn
(setq dii (* sca (distance p0 p1)))
(setq di (* sca (distance p2 p3)))
)
)
(if (or (= unit 2) (and (= unit 4) (> di 24))) (setq inch (strcat " x " (rtos di unit prec) " LG.")) )
(if (and (= unit 4) (<= di 24))
(setq inch (strcat " x " (rtos di 5 prec) "\"" " LG.")) )
(if (or (= unit 2) (and (= unit 4) (> dii 24))) (setq inchi (strcat " x " (rtos dii unit prec)))
)
(if (and (= unit 4) (<= dii 24))
(setq inchi (strcat " x " (rtos dii 5 prec) "\""))
)
(setq inch (strcat inchi inch " FlatBar?"))
(setvar "osmode" 1024)
(command "text" pt1 "" fnum)
(command "chprop" (entlast) "" "la" "Defpoints" "")
(command "text" pt1a "" inch)
(command "chprop" (entlast) "" "la" "Defpoints" "")
)
)
;=======================
(if (= st "")
(progn
(setq p0 (getpoint "\nSpecify the first point: ") p1 (getpoint "\nSpecify the second point: ")
)
(setq di (* sca (distance p0 p1)))
(if (or (= unit 2) (and (= unit 4) (> di 24)))
(setq inch (strcat " x " (rtos di unit prec) " LG."))
)
(if (and (= unit 4) (<= di 24))
(setq inch (strcat " x " (rtos di 5 prec) "\"" " LG."))
)
(setvar "osmode" 1024)
(command "text" pt1 "" fnum)
(command "chprop" (entlast) "" "la" "Defpoints" "")
(command "text" pt1a "" inch)
(command "chprop" (entlast) "" "la" "Defpoints" "")
(princ di)
(princ "\n")
(princ (rtos di unit prec))
)
)
(if (or (= st "e")(= st "E"))
(progn
(entdel (entlast))
(entdel (entlast))
(setq fnum (- fnum 2))
(setq pt1 (polar pt1 (* pi 0.5) (* 2 thc)))
)
)
)
;=========================================== (defun c:7 (/ whinum sht unit prec th
thc pdx pdy
chkn chkna fnum pt0 pt1
pt1a chkd chknum sca
st p0 p1 p2 p3 dii di
inch inchi os
)
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(princ "\nCheck the length of material")
(setq whinum 0)
(setq sht (getstring "\nSpecify the name of sheet: ")) (setq unit (getvar "lunits")
prec (getvar "LUPREC")
)
(if (= unit 2)
(progn (setq th 3)
(setq thc 5)
(setq pdx 215)
(setq pdy 2)
(setq prec 0)
)
(progn (setq th 0.125)
(setq thc 0.2756)
(setq pdx 8.5)
(setq pdy 0.0625)
)
)
(command "style" "STD70" "" th "" "" "" "" "")
(setq chkn (ssget "x"
(list '(0 . "TEXT")
'(8 . "Defpoints")
'(7 . "STD70")
;;; (cons 410 (strcat "SHT " sht)) )
)
)
(setq chkna (ssget "x"
(list '(0 . "TEXT")
'(7 . "STD70")
;;; (cons 410 (strcat "SHT " sht)) )
)
)
(if (= chkna nil)
(progn (setq whinum 200)
(princ "\nPlease change name of sheet (SHT X)")
)
(progn
(if (= chkn nil)
(progn
(setvar "osmode" os)
(setq fnum (atoi (strcat sht "01")))
(setq pt0 (getpoint "\nSpecify the fix point:"))
(setvar "osmode" 1024)
(setq pt1 (polar (polar pt0 0 pdx) (/ pi 2) pdy))
(setq pt1a (polar pt1 0 (* 6 pdy)))
)
(progn
(setq chkna (ssget "x"
(list '(0 . "TEXT")
'(8 . "Defpoints")
'(7 . "STD70")
(cons 1 (strcat sht "01"))
(cons 410 (strcat "SHT " sht))
)
)
)
(setq chkd (entget (ssname chkna 0)))
(setq chknum (sslength chkn))
(setq fnum (+ (atoi (strcat sht "01")) (/ chknum 2))) (setq pt0 (cdr (assoc 10 chkd)))
(setvar "osmode" 1024)
(setq pt1 (polar pt0 (* pi 1.5) (* (/ chknum 2) thc))) (setq pt1a (polar pt1 0 (* 6 pdy)))
)
)
(setq sca (getint "\nSpecify the scale of view: "))
(while (< whinum 200)
(7inputI)
(setvar "osmode" 1024)
(setq pt1 (polar pt1 (* pi 1.5) thc))
(setq pt1a (polar pt1 0 (* 6 pdy)))
(setq fnum (1+ fnum))
)
(princ "\nCheck Done")
)
)
(command "style" "STD85" "" th "" "" "" "" "")
(setvar "osmode" os)
(princ)
)
(defun c:ee (/ unit os cl st ld ld_os ld_oe lsx lsy lex ley ld_ns ld_ne p0 p01 p1 p2 ra)
(setq unit (getvar "lunits"))
(setq os (getvar "osmode"))
(if (= unit 2) (setq ra 3) (setq ra 0.118))
;(SETQ cl (getvar "CLAYER"))
(princ "\nSelect the circle")
(setq cir (entget (car (entsel))))
(princ "\nSelect the line")
(setq lin (entget (car (entsel))))
(if (= (cdr (assoc 0 cir)) "CIRCLE") (setq p0 (cdr (assoc 10 cir))))
(if (= (cdr (assoc 0 cir)) "TEXT") (setq p0 (cdr (assoc 11 cir))))
(if (= (cdr (assoc 0 lin)) "LINE")
(progn
(setq p1 (cdr (assoc 10 lin)))
(setq leo (assoc 11 lin))
)
)
(setq ang (angle p0 p1))
(setq len (cons 11 (polar p0 ang ra)))
(entmod (subst len leo lin))
(princ)
);end defun。