[编程交流] plz chk计划和建议m

 
(DEFUN C:dr2 (/ lu a b c d e f g pt pp pt1 pt2 p ang1 tz wl ds wt sw ang2
pt3 pt4 ang3 pl2 pl3 pl4 pl5 pl6 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt13 pt14 pt15)
;--------------------------------------------
(setq oldCM (getvar "CMDECHO")
oldos (getvar "OSMODE")
)
(defun *error* (msg)
(if oldCM (setvar "CMDECHO" oldCM))
(if oldos (setvar "OSMODE" oldos))
(princ msg)
(princ)
)
(setvar "CMDECHO" 0)
(setvar "osmode" 0)
;|(setq bmode (getvar "BLIPMODE")
omode (getvar "OSMODE"))
(mapcar 'setvar '("BLIPMODE" "OSMODE") (list (BMODE OMODE))|;
;---------------------------------------
(setq lu (getvar "lunits"))
(if (= lu 2) (setq a 75 b 82 c 15 d 38 e 60 f 120 g 150)
(setq a 3 b 3.5 c 0.5 d 1.5 e 2.5 f 5 g 6))
(if (null DRlay) 
(progn
(setq DRlay "DR")
(setq DRlayer (tblsearch "layer" DRlay))
(if (null DRlayer)
(progn
(setq DRlay (getstring "\nLayer name for TEXT : "))
(setq DRclr (getstring (strcat "\nColor for " DRlay " layer: ")))
(command "layer" "m" DRlay "c" DRclr "" "")
) 
(prompt "\nDOOR ON DR LAYER")
)
)
) 
(SETQ PT (entsel "\nPICK WALL LINE:"))
(setq pp (CDR (ASSOC 11 (ENTGET (CAR PT)))))
(setvar "osmode" 128 )
(SETQ PT1 (GETPOINT PP "\nEnter Insertion Point:"))
(SETQ PT2 (GETPOINT PT1 "\nPick Opposite Wall Line:"))
(SETVAR "OSMODE" 512)
(SETQ p (GETpoint PT2 "\nPICK THE SIDE FOR OPENING:"))
(setq ang1 (angle pt2 p))
(IF (null DZ) (SETQ DZ "900"))
(SETQ TZ (STRCASE (GETSTRING (STRCAT "\nENTER SIZE OF OPENING <" DZ ">: ")) t))
(IF (/= TZ "") (SETQ DZ TZ))
(SETVAR "BLIPMODE" 0)
;---------------------------------------------
(setq wl (cdr (assoc 8 (entget (car pt))))
DS (Atof DZ)
WT (DISTANCE PT1 PT2)
SW (- DS f)
ANG2 (ANGLE PT1 PT2)
PT3 (POLAR PT1 ANG1 DS)
PT4 (POLAR PT3 ANG2 WT)
ANG3 (ANGLE PT3 PT1)
PL2 (POLAR PT1 ANG1 a)
PL3 (POLAR PL2 ANG2 b)
PL4 (POLAR PL3 ANG3 c)
PL5 (POLAR PL4 ANG2 d)
PL6 (POLAR PL5 ANG3 e)
PT5 (POLAR PT1 ANG1 (/ DS 2))
PT6 (POLAR PT5 ANG2 f)
PT7 (POLAR PL5 ANG1 SW)
PT12 PT7 PT13 PL5)
;-------------------------------------------
(SETVAR "OSMODE" 0)
(COMMAND "BREAK" Pt "F" PT1 PT3)
(COMMAND "BREAK" P "F" PT2 PT4)
(COMMAND "LAYER" "s" WL "")
(COMMAND "LINE" PT1 PT2 "")
(COMMAND "LINE" PT3 PT4 "")
(COMMAND "COLOR" "BYLAYER")
(COMMAND "LAYER" "t" drlay "on" drlay "s" drlay "")
(COMMAND "PLINE" PT1 PL2 PL3 PL4 PL5 PL6 "")
(COMMAND "MIRROR" PL2 "" PT5 PT6 "")
(SETVAR "ORTHOMODE" 0)
(SETQ PT11 (GETPOINT PT5 "\nPICK THE SIDE FOR SHUTTER:"))
(IF (> (DISTANCE PT11 PL5)(DISTANCE PT7 PT11)) (SETQ PL5 PT7 PT12 PT13))
(SETQ PT8 (POLAR PL5 (ANGLE PL5 PT6) d))
(SETQ PT9 (POLAR PT8 ANG2 SW))
(SETQ PT10 (POLAR PT9 (ANGLE PT6 PL5) d))
(COMMAND "PLINE" PL5 PT8 PT9 PT10 PL5 "")
(COMMAND "ARC" PT12 PT9 PT10)
(COMMAND "CHPROP" "L" "" "LT" "HIDDEN2" "")
(setq pt14 (polar pl3 ang1 (- ds g)))
(setq pt15 (polar pl2 ang1 (- ds g)))
(if (and (>= ds 100) (<= ds 750)) (command "line" pl3 pt14 ""))
(if (>= ds 910) (command "line" pl2 pt15 "")) 
(if (<= ds 32) (command "line" pl3 pt14 ""))
(if (and (>= ds 37) (< ds 100)) (command "line" pl2 pt15 ""))
)
;; Reset System Variables:
(setvar "cmdecho" oldCM)
(setvar "osmode" oldos)
(princ)

(defun c:chkbrk (/ opf bkt chekdfile rdctl wkfile currentln wln ltr ncln)
(setvar "cmdecho" 0)
(prompt "\nlook at end of line")
;(setq chekdfile (getstring "enter name of file :"))
(SETQ chekdfile (getfiled "Enter file name:" " " "LSP" 4))
(setq opf (open chekdfile "r"))
(setq bkt 0)
(setq blkl 0)
(setq rdctl 1)
(setq wkfile (open "c:/wow.lsp" "w"))
(setq currentln "a")
(while (/= blkl 6)
(setq currentln (read-line opf))
(if (= currentln nil)(setq currentln ""))
(if (= currentln "")(setq blkl (+ 1 blkl))(setq blkl 1))
(setq wln currentln)                                                        
(while (/= wln "")
       (setq ltr (substr wln 1 1))
       (setq wln (substr wln 2))
       (cond ((= (ascii ltr) 34) (if (= rdctl 0)(setq rdctl 1)(setq rdctl 0)))
               ((and (= ltr "(")(= rdctl 1))(setq bkt (+ bkt 1)))
               ((and (= ltr ")")(= rdctl 1))(setq bkt (- bkt 1)))
               ((and (= ltr ";")(= rdctl 1))(setq wln ""))
               ;(t (prompt ltr))
       )
)
(setq ncln (strcat currentln ";" (itoa bkt)
(princ (itoa bkt))
(if (= rdctl 0) "string open" "")))
(if (/= currentln "")(write-line ncln wkfile))
)
(close wkfile)
(close opf)
(prompt (strcat "open brakets= " (itoa bkt) "."))
)
(setq ang1 nil
     pt1 nil
     pt2 nil
     pt3 nil
     pt4 nil
     pt5 nil)
(princ)