neue Folder LAYOUT MENU und MODULE dazu
This commit is contained in:
@@ -0,0 +1,421 @@
|
||||
(IF SPECIAL
|
||||
(SPECIAL '(olde ptest cavar bell prna))
|
||||
(DEFUN SPECIAL (x) nil)
|
||||
)
|
||||
(DEFUN pstart (tit qust setv / xlen xpos xvar)
|
||||
(SETQ olde *ERROR*
|
||||
*ERROR* (IF ptest NIL errhan)
|
||||
cavar (APPEND '(("CLAYER")("CMDECHO"))
|
||||
setv)
|
||||
xlen (LENGTH cavar)
|
||||
xpos 0
|
||||
)
|
||||
(REPEAT xlen
|
||||
(SETQ xvar (CAR (NTH xpos cavar))
|
||||
cavar (SUBST (CONS xvar (GETVAR xvar))
|
||||
(NTH xpos cavar) cavar)
|
||||
xpos (1+ xpos)
|
||||
)
|
||||
)
|
||||
(SETVAR "CMDECHO" 0)
|
||||
(COMMAND "_undo" "_G")
|
||||
(GRAPHSCR)
|
||||
(PROMPT (STRCAT "\n***** " tit " *****\n\n " qust))
|
||||
(PRINC)
|
||||
)
|
||||
(DEFUN pend (/ xpos xlen xvar)
|
||||
(IF cavar
|
||||
(PROGN
|
||||
(COMMAND)
|
||||
(COMMAND "_undo" "_E")
|
||||
(SETQ xpos 1
|
||||
xlen (LENGTH cavar)
|
||||
)
|
||||
(IF (/= (GETVAR "CLAYER") (CAAR cavar))
|
||||
(COMMAND "_LAYER" "_SE" (CDAR CAVAR) "")
|
||||
)
|
||||
(REPEAT (1- xlen)
|
||||
(SETQ xvar (NTH xpos cavar)
|
||||
xpos (1+ xpos)
|
||||
)
|
||||
(SETVAR (CAR xvar)(CDR xvar))
|
||||
)
|
||||
)
|
||||
)
|
||||
(IF olde (SETQ *ERROR* olde))
|
||||
(PRINC)
|
||||
)
|
||||
(DEFUN errhan (em)
|
||||
(IF (= em "Function cancelled")
|
||||
(PRINC)
|
||||
(PRINC em)
|
||||
)
|
||||
(GRTEXT)
|
||||
(COMMAND)
|
||||
(COMMAND)
|
||||
(pend)
|
||||
)
|
||||
(DEFUN ques (dial defa) ;Std Abfrage
|
||||
(IF defa
|
||||
(PROGN
|
||||
(INITGET 1 "Ja Nein Ja")
|
||||
(= (GETKWORD (STRCAT "\n" dial " J/N <J>: ")) "Nein")
|
||||
)
|
||||
(PROGN
|
||||
(INITGET 1 "Ja Nein Nein")
|
||||
(= (GETKWORD (STRCAT "\n" dial " J/N <N>: ")) "Ja")
|
||||
)
|
||||
)
|
||||
)
|
||||
(DEFUN emsg (etxt)
|
||||
(IF (NOT bell)(PROMPT "\007"))
|
||||
(TERPRI)
|
||||
(PROMPT etxt)
|
||||
(TERPRI)
|
||||
)
|
||||
(DEFUN ques (dial defa) ;Std Abfrage
|
||||
(IF defa
|
||||
(PROGN
|
||||
(INITGET 1 "Ja Nein Ja")
|
||||
(= (GETKWORD (STRCAT "\n" dial " J/N <J>: ")) "Nein")
|
||||
)
|
||||
(PROGN
|
||||
(INITGET 1 "Ja Nein Nein")
|
||||
(= (GETKWORD (STRCAT "\n" dial " J/N <N>: ")) "Ja")
|
||||
)
|
||||
)
|
||||
)
|
||||
(DEFUN renv (envn prnn / penv)
|
||||
(IF (SETQ penv (GETENV envn))
|
||||
(EVAL (STRCAT penv "" prnn))
|
||||
(EVAL prnn)
|
||||
)
|
||||
)
|
||||
(DEFUN C:PRG (/ nprg cprg prna)
|
||||
(SETQ nprg (GETSTRING)
|
||||
cprg (STRCAT "C:" nprg)
|
||||
prna (renv "ACADLSP" nprg)
|
||||
)
|
||||
(IF (NULL (EVAL (READ cprg)))
|
||||
(PROGN
|
||||
(PRINC " loading...!\n")
|
||||
(COND
|
||||
((FINDFILE (STRCAT prna ".BI4"))
|
||||
(LOAD prna ".BI4"))
|
||||
((FINDFILE (STRCAT prna ".BI2"))
|
||||
(LOAD prna ".BI2"))
|
||||
((FINDFILE (STRCAT prna ".LSP"))
|
||||
(LOAD prna ".LSP"))
|
||||
( T (emsg "File not found"))
|
||||
)
|
||||
)
|
||||
)
|
||||
(PRINC)
|
||||
)
|
||||
(DEFUN C:ed (/ prnn)
|
||||
(IF (NULL prna)
|
||||
(SETQ prna "")
|
||||
)
|
||||
(SETQ prnn (GETSTRING
|
||||
(STRCAT "Programname <" prna ">: ")))
|
||||
(IF (AND (= (STRLEN prna) 0)(= (STRLEN prnn) 0))
|
||||
(emsg "Name not allowed...")
|
||||
(PROGN
|
||||
(IF (> (STRLEN prnn) 0)
|
||||
(SETQ prna (renv "ACADLSP" prnn))
|
||||
)
|
||||
(COMMAND "SHELL" (STRCAT "ED " prna ))
|
||||
(INITGET 1 "Ja Nein Ja")
|
||||
(IF (NOT (ques "Load the program" T))
|
||||
(LOAD prna)
|
||||
)
|
||||
)
|
||||
)
|
||||
(PRINC)
|
||||
)
|
||||
;----------- Block einfuegen mit Layergenerierung ----2.8.92 AW
|
||||
; KEINE DREHMOEGLICHKEIT !!!
|
||||
(DEFUN c:symplac ( / einp); / einp ebene symname)
|
||||
(SETQ einp (GETPOINT "\nInsert-Point: "))
|
||||
(COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "")
|
||||
(COMMAND "_insert" symname einp "" "" "0")
|
||||
)
|
||||
;----------- Block einfuegen mit Layergenerierung ----14.8.92 AW
|
||||
; MIT DREHMOEGLICHKEIT !!!
|
||||
(DEFUN c:sympl_dr ( / einp); / einp ebene symname)
|
||||
(SETQ einp (GETPOINT "\nInsert-Point: "))
|
||||
(COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "")
|
||||
(COMMAND "_insert" symname einp "" "" pause)
|
||||
)
|
||||
;----------- Block einfuegen mit Layergenerierung ---16.9.93 AW
|
||||
; MIT DREHMOEGLICHKEIT UND URSPRUNG NACH DEM SETZEN !!!
|
||||
(DEFUN c:sympldr2 ( / einp drehung groesse)
|
||||
(setq groesse "1")
|
||||
(SETQ einp (GETPOINT "\nInsert-Point: "))
|
||||
(SETQ drehung (GETSTRING "\nRotation: "))
|
||||
(SETQ groesse (GETSTRING "\nScale: "))
|
||||
(COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "")
|
||||
(COMMAND "_insert" symname einp groesse groesse drehung)
|
||||
(COMMAND "_explode" "_last")
|
||||
)
|
||||
;----------- Block einfuegen mit Layergenerierung ---21.11.93 AW
|
||||
; ABFRAGE: SKALIERUNG/ DREHMOEGLICHKEIT UND URSPRUNG NACH DEM SETZEN !!!
|
||||
(DEFUN c:sympldr1 ( / einp drehung)
|
||||
(SETQ einp (GETPOINT "\nEinfuege-Punkt: "))
|
||||
(SETQ drehung (GETSTRING "\nDrehung: "))
|
||||
(COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "")
|
||||
(COMMAND "_insert" symname einp "" "" drehung)
|
||||
(COMMAND "_explode" "_last")
|
||||
)
|
||||
;----------- Block einfuegen mit Layergenerierung und Skalierung ---12.2.93 AW
|
||||
(DEFUN c:sym_scal ( / einp p1 p2); / einp ebene symname)
|
||||
(SETQ einp (GETPOINT "\nInsert-Point: "))
|
||||
(SETQ p1 (GETREAL "\nX-Scale: "))
|
||||
(SETQ p2 (GETREAL "\nY-Scale: "))
|
||||
(COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "")
|
||||
(COMMAND "_insert" symname einp p1 p2 "0")
|
||||
)
|
||||
|
||||
;------------ Farbe aendern - AUFRUF aus POP2--------------------------
|
||||
(DEFUN c:alt_farb ( / sst_obj neuefarb)
|
||||
(setq sst_obj (ssget) neuefarb (getstring "\nNew-Color: "))
|
||||
(command "_change" sst_obj "" "_prop" "_co" neuefarb "")
|
||||
)
|
||||
;--------------------------------------------------------------------
|
||||
|
||||
(defun block-op (PT0 szoeg auswahl-satz / komponente1 komponente2
|
||||
seconds element-name gefunden)
|
||||
;------------------
|
||||
; Block definieren
|
||||
;-----------------------------------------------------------
|
||||
; PT0 - Origin der Baugruppe
|
||||
; szoeg - Einfuegewinkel
|
||||
; auswahl-satz - Elemente des Blockes in Auswahlsatz
|
||||
;------------------------------------------------------------
|
||||
(setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0))))
|
||||
(itoa (abs (fix (caddr PT0))))))
|
||||
(setq komponente2 szoeg)
|
||||
(setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9))
|
||||
(setq element-name (strcat komponente1 komponente2 seconds))
|
||||
(princ)
|
||||
(princ (strcat komponente1 "\n"))
|
||||
(princ (strcat komponente2 "\n"))
|
||||
(princ (strcat seconds "\n"))
|
||||
(princ)
|
||||
(princ (strcat "\n" element-name "\n"))
|
||||
(princ)
|
||||
(setq gefunden (tblsearch "block" element-name))
|
||||
(if (not gefunden)
|
||||
(progn
|
||||
(princ)
|
||||
(command "_block" element-name PT0 auswahl-satz "")
|
||||
(command "_insert" element-name PT0 "" "" szoeg)
|
||||
)
|
||||
(alert "\nBlockname existiert. Bitte A. Walz benachrichtigen. Das Programm
|
||||
muá ge„ndert werden !")
|
||||
)
|
||||
)
|
||||
|
||||
(defun bl-name (PT0 / komponente1 seconds)
|
||||
; 14.4.94
|
||||
; Verwendung bei Baugruppen, deren Bestandteile aufgelistet
|
||||
; werden m�ssen.
|
||||
; Name eines Blockes gleich am Anfang des Programmes festlegen
|
||||
; - die Einzelkomponenten werden in "C" mit diesem Wert belegt
|
||||
; - dadurch ist eine eindeutige Gruppenzugeh”rigkeit m”glich
|
||||
;
|
||||
(setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0))))
|
||||
(itoa (abs (fix (caddr PT0))))))
|
||||
(setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9))
|
||||
(setq block-kennung (strcat komponente1 seconds))
|
||||
(princ)
|
||||
)
|
||||
|
||||
(defun mach-block (PT0 szoeg auswahl-satz / komponente1 komponente2
|
||||
seconds element-name gefunden)
|
||||
;------------------
|
||||
; Block definieren
|
||||
;-----------------------------------------------------------
|
||||
; PT0 - Origin der Baugruppe
|
||||
; szoeg - Einfuegewinkel
|
||||
; auswahl-satz - Elemente des Blockes in Auswahlsatz
|
||||
;------------------------------------------------------------
|
||||
(setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0))))
|
||||
(itoa (abs (fix (caddr PT0))))))
|
||||
(setq komponente2 szoeg)
|
||||
(setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9))
|
||||
(setq element-name (strcat komponente1 komponente2 seconds))
|
||||
(princ)
|
||||
(princ (strcat komponente1 "\n"))
|
||||
(princ (strcat komponente2 "\n"))
|
||||
(princ (strcat seconds "\n"))
|
||||
(princ)
|
||||
(princ (strcat "\n" element-name "\n"))
|
||||
(princ)
|
||||
(setq gefunden (tblsearch "block" element-name))
|
||||
(if (not gefunden)
|
||||
(progn
|
||||
(princ)
|
||||
(command "_insert" (strcat "*" lw "/acadsst/menu/a") PT0 "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat "*" lw "/acadsst/menu/b") PT0 "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat "*" lw "/acadsst/menu/c") PT0 "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat "*" lw "/acadsst/menu/artinr") PT0 "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat "*" lw "/acadsst/menu/beschr") PT0 "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat "*" lw "/acadsst/menu/menge") PT0 "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat "*" lw "/acadsst/menu/position") PT0 "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat "*" lw "/acadsst/menu/gruppe") PT0 "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat "*" lw "/acadsst/menu/etikette") PT0 "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat "*" lw "/acadsst/menu/aufloese") PT0 "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_block" element-name PT0 auswahl-satz "")
|
||||
(command "_insert" element-name PT0 "" "" szoeg)
|
||||
)
|
||||
(alert "\nBlockname existiert. Bitte A. Walz benachrichtigen. Das Programm
|
||||
muá ge„ndert werden !")
|
||||
)
|
||||
)
|
||||
|
||||
;---------- Attribute aendern - Laenge,Endstueck,Artikel-Nr.--------------------
|
||||
(defun ATTRIBUTE-AENDERN (M_POSITION M_ETIKETTE M_GRUPPE M_A M_B M_C M_ARTINR
|
||||
M_BESCHR M_MENGE M_AUFLOESE / objekt typ
|
||||
attribut-bezeichnung attribut-wert)
|
||||
(setq objekt (entlast))
|
||||
(while (not (equal
|
||||
(cdr (assoc 0 (entget objekt)))
|
||||
"SEQEND"))
|
||||
(setq typ
|
||||
(cdr (assoc 0 (entget objekt))))
|
||||
(if
|
||||
(equal typ "ATTRIB")
|
||||
(progn
|
||||
(setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget objekt))))
|
||||
(setq ATTRIBUT-WERT (cdr (assoc 1 (entget objekt))))
|
||||
|
||||
(if (and (> (strlen M_POSITION) 0) (= ATTRIBUT-BEZEICHNUNG "POSITION"))
|
||||
(entmod (subst (cons 1 M_POSITION) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
(if (and (> (strlen M_ETIKETTE) 0) (= ATTRIBUT-BEZEICHNUNG "ETIKETTE"))
|
||||
(entmod (subst (cons 1 M_ETIKETTE) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
(if (and (> (strlen M_GRUPPE) 0) (= ATTRIBUT-BEZEICHNUNG "GRUPPE"))
|
||||
(entmod (subst (cons 1 M_GRUPPE) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
(if (and (> (strlen M_A) 0) (equal ATTRIBUT-BEZEICHNUNG "A"))
|
||||
(entmod (subst (cons 1 M_A) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
(if (and (> (strlen M_B) 0) (equal ATTRIBUT-BEZEICHNUNG "B"))
|
||||
(entmod (subst (cons 1 M_B) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
(if (and (> (strlen M_C) 0) (equal ATTRIBUT-BEZEICHNUNG "C"))
|
||||
(entmod (subst (cons 1 M_C) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
(if (and (> (strlen M_ARTINR) 0) (equal ATTRIBUT-BEZEICHNUNG "ARTINR"))
|
||||
(entmod (subst (cons 1 M_ARTINR) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
(if (and (> (strlen M_BESCHR) 0) (equal ATTRIBUT-BEZEICHNUNG "BESCHR"))
|
||||
(entmod (subst (cons 1 (strcat ATTRIBUT-WERT M_BESCHR))
|
||||
(assoc 1 (entget objekt)) (entget objekt)))
|
||||
)
|
||||
(if (and (> (strlen M_MENGE) 0) (equal ATTRIBUT-BEZEICHNUNG "MENGE"))
|
||||
(entmod (subst (cons 1 M_MENGE)
|
||||
(assoc 1 (entget objekt)) (entget objekt)))
|
||||
)
|
||||
(if (and (> (strlen M_AUFLOESE) 0) (equal ATTRIBUT-BEZEICHNUNG "AUFLOESE"))
|
||||
(entmod (subst (cons 1 M_AUFLOESE)
|
||||
(assoc 1 (entget objekt)) (entget objekt)))
|
||||
)
|
||||
) ; Ende ----progn
|
||||
) ; Ende ----if
|
||||
(setq objekt (entnext objekt))
|
||||
)
|
||||
(setq objekt objekt)
|
||||
)
|
||||
|
||||
;--- Objekt in der DB suchen und Attribut „ndern ---------------
|
||||
; Parameter:
|
||||
; ref - handle
|
||||
; bezeichnung - Attributbezeichnung, die gesucht ist
|
||||
; wert - neuer Wert
|
||||
; addition = 0 - Attributbezeichnung wird mit "wert" ersetzt
|
||||
; 1 - Attributbezeichnung wird mit "wert" erg„nzt
|
||||
;----------------------------------------------------------------
|
||||
(defun suchen-aendern ( ref bezeichnung wert addition
|
||||
/ typ attribut-bezeichnung attribut-wert)
|
||||
(redraw (handent ref) 3)
|
||||
(obj-suchen ref)
|
||||
(redraw (handent ref))
|
||||
)
|
||||
|
||||
(defun obj-suchen (ref)
|
||||
(setq raus 0)
|
||||
(setq e (entnext))
|
||||
(while e
|
||||
(setq typ (cdr (assoc 0 (entget e))))
|
||||
(setq blockname (cdr (assoc 2 (entget e))))
|
||||
(if
|
||||
(and
|
||||
(equal (cdr (assoc 5 (entget e))) ref)
|
||||
(equal typ "INSERT")
|
||||
(equal (cdr (assoc 66 (entget e))) 1)
|
||||
)
|
||||
(progn
|
||||
(einzel-attr-aendern bezeichnung wert addition)
|
||||
(setq raus 1) ; rausspringen !!!
|
||||
)
|
||||
)
|
||||
(setq e (entnext e))
|
||||
(if (= RAUS 1)
|
||||
(setq e NIL)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun einzel-attr-aendern (BEZEICHNUNG WERT ADDITION)
|
||||
(while (not (= (cdr (assoc 0 (entget e))) "SEQEND"))
|
||||
(setq typ (cdr (assoc 0 (entget e))))
|
||||
(if
|
||||
(equal typ "ATTRIB")
|
||||
(progn
|
||||
(setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget e))))
|
||||
(setq ATTRIBUT-WERT (cdr (assoc 1 (entget e))))
|
||||
(if (= ADDITION 0) ; Attributwert GANZ ersetzen
|
||||
(progn
|
||||
(if (equal ATTRIBUT-BEZEICHNUNG BEZEICHNUNG)
|
||||
(entmod (subst (cons 1 WERT)
|
||||
(assoc 1 (entget e)) (entget e)))
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= ADDITION 1) ; Attributwert ERGAENZEN
|
||||
(progn
|
||||
(if (equal ATTRIBUT-BEZEICHNUNG BEZEICHNUNG)
|
||||
(entmod (subst (cons 1 (strcat ATTRIBUT-WERT WERT))
|
||||
(assoc 1 (entget e)) (entget e)))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
) ; Ende ----progn
|
||||
)
|
||||
(setq e (entnext e))
|
||||
)
|
||||
)
|
||||
;--------------------------------------------------------------------------
|
||||
|
||||
|
||||
Reference in New Issue
Block a user