m.stangl/Walz
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
Walz/MENU/TOOLS.LSP
T

257 lines
8.6 KiB
Common Lisp
Raw Permalink Blame History

;;; ------------------- TOOLS.LSP -------------------
;;;
;;; Einsatz: AutoCAD / Genius allgemein
;;; Funktion: diverse
;;;
;;;
;;; (C) GROB-WERKE Mindelheim, Lisiecki Ch.
;;; Version V1.3
;;; Stand 23:20 21.03.97
;;; -------------------------------------------------
(defun c:TOOLS (/ action)
(setq action 0)
(setq scmde (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(d_menue)
(cond
((= action 1) (c:blkanzahl))
((= action 2) (c:blkentf))
((= action 7) (c:blkscale))
((= action 3) (c:bereinig2))
((= action 4) (c:endd))
((= action 5) (c:txtboxed))
((= action 6) (c:makepart))
(T (prompt "\nKeine Funktion ausgewählt"))
)
(setvar "CMDECHO" scmde)
(princ)
)
; -------------------------------------------------
(defun d_menue ()
(setq dcl_id (load_dialog "c:/tab11/lsp/tools.dcl")) ;Supportpfad
(if (not (new_dialog "tools" dcl_id)) (exit))
(action_tile "b_blkscale" "(setq action 7) (done_dialog)")
(action_tile "b_blkanzahl" "(setq action 1) (done_dialog)")
(action_tile "b_blkentf" "(setq action 2) (done_dialog)")
(action_tile "b_bereinig2" "(setq action 3) (done_dialog)")
(action_tile "b_finish" "(setq action 4) (done_dialog)")
(action_tile "b_txtboxed" "(setq action 5) (done_dialog)")
(action_tile "b_makepart" "(setq action 6) (done_dialog)")
(action_tile "cancel" "(done_dialog)")
(action_tile "accept" "(done_dialog)")
(start_dialog)
(unload_dialog dcl_id)
)
;;; -------------------------------------------------
;;; -------------------------------------------------
(defun C:BLKANZAHL (/ BNAM SS)
(princ "Anzahl der eingefügten Blöcke")
(setq BNAM(getstring"\nBlockname:")
SS(ssget "X" (list(cons 2 BNAM))))
(if(null SS)
(prompt(strcat"\nKeine Einfügungen von " (chr 34)BNAM(chr 34)))
(prompt(strcat"\nEs gibt insgesamt " (itoa(sslength SS))
" Einfügungen von " (chr 34) BNAM(chr 34)))
)
(princ)
)
; -------------------------------------------------
(defun C:BLKENTF (/ BNAM SS)
(princ "Löschen aller Einfügungen eines Blocks")
(setq BNAM(getstring"\nBlockname:")
SS(ssget "X" (list(cons 2 BNAM))))
(if(null SS)
(prompt(strcat"\nKeine Einfügungen von " (chr 34)BNAM(chr 34)))
(prompt(strcat"\nSoll der Block " (chr 34) BNAM(chr 34)
" " (itoa(sslength SS)) "-mal gelöscht werden?"))
)
(setq qjn (getstring " <j>/n ") )
(if (or (= qjn "j") (= qjn "")) (command "_.erase" "_previous" ""))
(princ)
)
; -------------------------------------------------
(defun C:BLKSCALE ()
(initget "Koord Oberfl")
(setq what (getkword "\nWelche Elemente skalieren <Koord.>/Oberfl. "))
(prompt "\nElemente zum Skalieren auswählen ")
(cond
((= what "Oberfl")
(setq ss1 (ssget '((0 . "INSERT")(-4 . "<or")(2 . "GEFROU4")(2 . "GEFROU5")(2 . "GEFROG4")(2 . "GEFROG5")(-4 . "or>") ) ))
(if (not ss1) (princ "\nKeine Elemente ausgewählt")
(progn
(setq scale (getreal "\nSkalierung eingeben: "))
(setq len (sslength ss1))
(setq index 0)
(repeat len
(setq e_dat (entget (ssname ss1 index)))
(command "_.SCALE" (ssadd (ssname ss1 index)) "" (fld 10) (rtos (/ scale (fld 41)) ))
(setq index (1+ index))
)
)
)
)
(T
(setq ss1 (ssget '((0 . "INSERT")(2 . "GENORD")) ))
(if (not ss1) (princ "\nKeine Elemente ausgewählt")
(progn
(setq scale (getreal "\nSkalierung eingeben: "))
(setq len (sslength ss1))
(setq index 0)
(repeat len
(setq e_dat (entget (ssname ss1 index)))
(setq e_dat (subst (cons 41 scale) (assoc 41 e_dat) e_dat))
(setq e_dat (subst (cons 42 scale) (assoc 42 e_dat) e_dat))
(setq e_dat (subst (cons 43 scale) (assoc 43 e_dat) e_dat))
(entmod e_dat)
(setq index (1+ index))
)
)
)
)
)
)
;;; -------------------------------------------------
;;; -------------------------------------------------
(defun C:BEREINIG2 (/ done)
(setq done T)
(command "_.purge" "_a" )
(while (= (getvar "CMDNAMES") "PURGE")
(command "_y" )
(setq done nil)
)
(if (not done) (C:BEREINIG2))
(princ)
)
; -------------------------------------------------
(defun C:ENDD ( / ss1 set_rev more e1 e2 e_dat)
(command "_.LAYER" "_OFF" "9,9N,VIEW"
"_F" "9,9N,VIEW" "")
(command "_.LAYER" "_ON" "0,1,2,3,3A,4,4A,5,6,7,7A,8,0N,1N,2N,3N,3AN,4N,4AN,5N,6N,7N,7AN,8N"
"_T" "0,1,2,3,3A,4,4A,5,6,7,7A,8,0N,1N,2N,3N,3AN,4N,4AN,5N,6N,7N,7AN,8N" "")
(command "_.LAYER" "_S" "0" "")
(setq ss1 (ssget "X" '((8 . "KLIN"))))
(if ss1
(command "_.ERASE" ss1 "")
)
(C:BEREINIG2)
(setvar "TILEMODE" 1)
(command "_.ZOOM" "_E")
(command "_.ZOOM" "0.8x")
(setvar "TILEMODE" 0)
(initget "Nein Ja")
(setq set_rev (getkword "Revisionsstand erhöhen? <N>/J :"))
(setq e1 (entnext))
(while (setq e1 (entnext e1))
(setq e_dat (entget e1))
(if (and (= (fld 0) "INSERT") (= (fld 66) 1))
(progn
(setq e2 e1
e1 (entnext e1)
more T)
(while more
(setq e_dat (entget e1))
(cond
((= (fld 0) "ATTRIB") (fillatt) (setq e1 (entnext e1)))
((= (fld 0) "SEQEND") (setq more nil))
(T (setq e1 (entnext e1)))
)
)
)
)
)
; (entupd e2) ; nicht nötig, da REGEN nachfolgend ausgefuehrt wird
(command "_.ZOOM" "_E")
(command "_.QSAVE")
)
(defun fillatt (/ cdate)
(setq cdate (rtos (getvar "CDATE") 2 6)
cdate (strcat (substr cdate 7 2) "." (substr cdate 5 2) "." (substr cdate 3 2)))
(setq attag (fld 2))
(cond
((= attag "GEN-TITLE-NAME{5}") (f_attmod (getvar "LOGINNAME")))
((= attag "GEN-TITLE-DWG{30}") (f_attmod (getvar "DWGNAME")))
((= attag "GEN-TITLE-PLOT{2.94}") (f_attmod cdate))
((and (= attag "R") (= set_rev "Ja")) (f_attmod (itoa (+ 1 (atoi (fld 1)))) ) )
)
)
(defun f_attmod (att)
(setq e_dat (subst (cons 1 att) (assoc 1 e_dat) e_dat))
(entmod e_dat)
)
(defun fld (num)
(cdr (assoc num e_dat))
)
; -------------------------------------------------
; -------------------------------------------------
(defun C:TXTBOXED (/ center string above below right left)
(princ)
(setq THGT (getvar "TEXTSIZE"))
(prompt "\nZeichnet einen Rahmen um eine Zeichenkette")
(setq center (getpoint "\nMittelpunkt des Rahmens"))
(setq THGT (getdist (strcat "\nTexthöhe <" (rtos THGT) ">:")))
(if (= thgt nil) (setq thgt (getvar "textsize")))
(setq string (getstring T "\nText eingeben : "))
(setq lgth (strlen string)
ontop (+ (cadr center) (* 0.9 THGT))
under (- (cadr center) (* 0.9 THGT))
right (+ (car center) (* 0.5 (* THGT lgth)))
left (- (car center) (* 0.5 (* THGT lgth))))
(command "_.PLINE" (list left under) "_W" "0" "0"
(list right under) (list right ontop) (list left ontop) "_C")
(command "_.TEXT" "_M" center THGT "0" string
)
(princ)
)
;;; -------------------------------------------------
;;; -------------------------------------------------
(defun C:MAKEPART ( ;|/ fname lname file count path|;)
(setvar "cmdecho" 0)
(setq base "5000,5000,0")
(setq path (getstring "\nPfad für DXF-Dateien, Format: d:\\TEMP\\ <akt.>: "))
(command "sh" (strcat "dir " path "*.dxf /b > c:\\temp.$$$" ))
(setq file (open "C:\\temp.$$$" "r"))
(if file
(progn
(while (setq lname (read-line file))
(if (not (member (substr lname 1 1) '("" " " ".")))
(progn
(setq count 1)
(while (/= (substr lname count 1) ".")
(setq count (1+ count))
)
(setq lname (substr lname 1 (1- count)))
(prompt (strcat "\nWorking...\t" path lname ".dxf"))
(command "_.erase" (ssget "X")) ; evtl "" hinzu
(command "_.dxfin" (strcat path lname))
; evtl. Mach Layer PART
(command "eigändr" (ssget "X") "" "LA" "PART" "")
(command "_.zoom" "_e")
(command "_.mslide" (strcat path lname) )
(command "_.wblock" (strcat path lname) "" base "alle" "")
;(command "shell" (strcat "del " (strcat path dxfname) ".dxf"))
)
)
)
)
)
(close file)
;(command "sh" "del temp.$$$")
(setvar "cmdecho" 1)
(prompt "\n Alle Dateien im angegebenen Pfad bearbeitet.")
(princ)
)
;;; -------------------------------------------------
;;; -------------------------------------------------
(princ)
(prompt "\n---------------------------------------------")
(prompt "\nTOOLS geladen ... by Lisiecki Ch.")
(prompt "\nZeichnung abschliessen auch mit ENDD moeglich")
(princ)
Reference in New Issue View Git Blame Copy Permalink