Merge gemacht. Versuch eines Tests der lisp Routinen erstellt
This commit is contained in:
@@ -1,104 +0,0 @@
|
||||
;------------------------------------------------------------------------;
|
||||
; ALU-KOMPONENTEN - HFS_MOD.LSP ;
|
||||
;------------------------------------------------------------------------;
|
||||
; AW 14.06.97 / 15.8.98 ;
|
||||
; 16.08.98 - 2-WAY MODUL eingebaut ;
|
||||
; 06.11.98 - HP-SORT II eingebaut ;
|
||||
;------------------------------------------------------------------------;
|
||||
(defun Dbox (/ Dat)
|
||||
(setq Dat (load_dialog (strcat lw "/acadsst/hfs/HFS_MOD.DCL")))
|
||||
(if (not (new_dialog "HFS_MOD" Dat)) (exit))
|
||||
(set_tile "DWG_NAME" m_DWG_NAME); Blockname
|
||||
(mode_tile "anzeige" 0)
|
||||
(SetDia)
|
||||
(ACTION_TILE "DWG_NAME" "(zeig_dia)")
|
||||
(action_tile "accept" "(SetPara) (done_dialog)")
|
||||
(action_tile "cancel" "(exit) (done_dialog)")
|
||||
(start_dialog)
|
||||
(unload_dialog Dat)
|
||||
)
|
||||
|
||||
(defun SetDia()
|
||||
(setq breite (dimx_tile "anzeige"))
|
||||
(setq hoehe (dimy_tile "anzeige"))
|
||||
(start_image "anzeige")
|
||||
(FILL_IMAGE 0 0 breite hoehe -18)
|
||||
(if (= m_DWG_NAME "0")
|
||||
(slide_image 0 0 breite hoehe "hfs(kmlight)")
|
||||
)
|
||||
(if (= m_DWG_NAME "1")
|
||||
(slide_image 0 0 breite hoehe "hfs(km3000)")
|
||||
)
|
||||
(if (= m_DWG_NAME "2")
|
||||
(slide_image 0 0 breite hoehe "hfs(km5000)")
|
||||
)
|
||||
(if (= m_DWG_NAME "3")
|
||||
(slide_image 0 0 breite hoehe "hfs(hochl)")
|
||||
)
|
||||
(if (= m_DWG_NAME "4")
|
||||
(slide_image 0 0 breite hoehe "hfs(hfsmod02)")
|
||||
)
|
||||
(if (= m_DWG_NAME "5")
|
||||
(slide_image 0 0 breite hoehe "hfs(hochltup)")
|
||||
)
|
||||
(if (= m_DWG_NAME "6")
|
||||
(slide_image 0 0 breite hoehe "hfs(hfsmod01)")
|
||||
)
|
||||
(end_image)
|
||||
)
|
||||
|
||||
(defun zeig_dia()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
(SetDia)
|
||||
)
|
||||
|
||||
(defun setpara()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
)
|
||||
|
||||
(defun datain ()
|
||||
(setq dummy nil)
|
||||
)
|
||||
|
||||
(defun geometrie()
|
||||
(if (= m_DWG_NAME "0")
|
||||
(setq BL_NAME "kmlight")
|
||||
)
|
||||
(if (= m_DWG_NAME "1")
|
||||
(setq BL_NAME "km3000")
|
||||
)
|
||||
(if (= m_DWG_NAME "2")
|
||||
(setq BL_NAME "km5000")
|
||||
)
|
||||
(if (= m_DWG_NAME "3")
|
||||
(setq BL_NAME "hochl")
|
||||
)
|
||||
(if (= m_DWG_NAME "4")
|
||||
(setq BL_NAME "hfsmod02")
|
||||
)
|
||||
(if (= m_DWG_NAME "5")
|
||||
(setq BL_NAME "hochltup")
|
||||
)
|
||||
(if (= m_DWG_NAME "6")
|
||||
(setq BL_NAME "hfsmod01")
|
||||
)
|
||||
(command "_layer" "_m" "H-2" "_c" "2" "" "")
|
||||
(setq P0 (getpoint "\nPick insert point: "))
|
||||
(setq BL_NAME (strcat lw "/acadsst/hfs/" BL_NAME))
|
||||
(command "_insert" BL_NAME P0 "" "" "0")
|
||||
)
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
(defun c:HFS_MOD ( / DWG_NAME BL_NAME P0)
|
||||
(setvar "limcheck" 0)
|
||||
(setvar "CMDECHO" 0)
|
||||
(setvar "BLIPMODE" 0)
|
||||
(setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB
|
||||
(prompt "**** HFS MODULS *******")
|
||||
(prompt "")
|
||||
(if (null m_DWG_NAME)(setq m_DWG_NAME "0")); Anfangssymbolname
|
||||
(Dbox)
|
||||
(prompt "")
|
||||
(datain)
|
||||
(geometrie)
|
||||
)
|
||||
@@ -1,181 +0,0 @@
|
||||
;------------------------------------------------------------------------;
|
||||
; ALU-KOMPONENTEN - ILS_AE_ELEM.LSP ;
|
||||
;------------------------------------------------------------------------;
|
||||
; AW 14.06.97 / 15.8.98 / 20.9.06 ;
|
||||
;------------------------------------------------------------------------;
|
||||
(defun Dbox (/ Dat)
|
||||
(setq Dat (load_dialog (strcat lw "/acadsst/ils2100/ILS_AE_ELEM.DCL")))
|
||||
(if (not (new_dialog "ILS_AE_ELEM" Dat)) (exit))
|
||||
(set_tile "DWG_NAME" m_DWG_NAME); Blockname
|
||||
(set_tile "PNEUM" m_PNEUM)
|
||||
(mode_tile "anzeige" 0)
|
||||
(SetDia)
|
||||
(ACTION_TILE "DWG_NAME" "(zeig_dia)")
|
||||
(action_tile "accept" "(SetPara) (done_dialog)")
|
||||
(action_tile "cancel" "(exit) (done_dialog)")
|
||||
(start_dialog)
|
||||
(unload_dialog Dat)
|
||||
)
|
||||
|
||||
(defun SetDia()
|
||||
(setq breite (dimx_tile "anzeige"))
|
||||
(setq hoehe (dimy_tile "anzeige"))
|
||||
(start_image "anzeige")
|
||||
(FILL_IMAGE 0 0 breite hoehe -18)
|
||||
(if (= m_DWG_NAME "0")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29412018)") ; AS LINKS [BG]
|
||||
)
|
||||
(if (= m_DWG_NAME "1")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29412020)") ; AS RECHTS [BG]
|
||||
)
|
||||
(if (= m_DWG_NAME "2")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29412021)") ; ES LINKS
|
||||
)
|
||||
(if (= m_DWG_NAME "3")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29412017)") ; ES RECHTS
|
||||
)
|
||||
(if (= m_DWG_NAME "4")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29412022)") ; AS LINKS MIT SMC PNEUMATIK
|
||||
)
|
||||
(if (= m_DWG_NAME "5")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29412023)") ; AS RECHTS MIT SMC PNEUMATIK
|
||||
)
|
||||
(end_image)
|
||||
)
|
||||
|
||||
(defun zeig_dia()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
(setq m_PNEUM (get_tile "PNEUM"))
|
||||
(if (or (= m_DWG_NAME "0") (= m_DWG_NAME "1
|
||||
")) ; AS LINKS oder RECHTS als BG
|
||||
(progn
|
||||
(mode_tile "PNEUM_1" 0)
|
||||
(mode_tile "PNEUM_2" 0)
|
||||
)
|
||||
(progn
|
||||
(mode_tile "PNEUM_1" 1)
|
||||
(mode_tile "PNEUM_2" 1)
|
||||
)
|
||||
)
|
||||
(SetDia)
|
||||
)
|
||||
|
||||
(defun setpara()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
(setq m_PNEUM (get_tile "PNEUM"))
|
||||
)
|
||||
|
||||
(defun datain ()
|
||||
(setq dummy nil)
|
||||
)
|
||||
|
||||
(defun geometrie()
|
||||
(if (= m_DWG_NAME "0")
|
||||
(progn
|
||||
(setq BL_NAME "829412018")
|
||||
(setq NEV "AS-ELEMENT LINKS ")
|
||||
(if (= m_PNEUM "PNEUM_1")
|
||||
(progn
|
||||
(setq E_ARTINR "829434103")
|
||||
(setq E_BEZEICHNUNG "BOSCH-PNEUMATIK-SATZ [829434103]")
|
||||
)
|
||||
)
|
||||
(if (= m_PNEUM "PNEUM_2")
|
||||
(progn
|
||||
(setq E_ARTINR "829434123")
|
||||
(setq E_BEZEICHNUNG "SMC-PNEUMATIK-SATZ [829434123]")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "1")
|
||||
(progn
|
||||
(setq NEV "AS-ELEMENT RECHTS ")
|
||||
(setq BL_NAME "829412020")
|
||||
(if (= m_PNEUM "PNEUM_1")
|
||||
(progn
|
||||
(setq E_ARTINR "829434103")
|
||||
(setq E_BEZEICHNUNG "BOSCH-PNEUMATIK-SATZ [829434103]")
|
||||
)
|
||||
)
|
||||
(if (= m_PNEUM "PNEUM_2")
|
||||
(progn
|
||||
(setq E_ARTINR "829434123")
|
||||
(setq E_BEZEICHNUNG "SMC-PNEUMATIK-SATZ [829434123]")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "2")
|
||||
(progn
|
||||
(setq NEV "")
|
||||
(setq BL_NAME "829412021")
|
||||
(setq E_ARTINR "")
|
||||
(setq E_BEZEICHNUNG "")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "3")
|
||||
(progn
|
||||
(setq NEV "")
|
||||
(setq BL_NAME "829412017")
|
||||
(setq E_ARTINR "")
|
||||
(setq E_BEZEICHNUNG "")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "4")
|
||||
(progn
|
||||
(setq NEV "")
|
||||
(setq BL_NAME "829412022")
|
||||
(setq E_ARTINR "")
|
||||
(setq E_BEZEICHNUNG "")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "5")
|
||||
(progn
|
||||
(setq NEV "")
|
||||
(setq BL_NAME "829412023")
|
||||
(setq E_ARTINR "")
|
||||
(setq E_BEZEICHNUNG "")
|
||||
)
|
||||
)
|
||||
(command "_layer" "_m" "ILS-AE-AS" "_c" "4" "" "")
|
||||
(setq P0 (getpoint "\nPick insert point: "))
|
||||
(bl-name P0) ;--> Block-Name definieren -> R�ckgabe: element-name
|
||||
(setq BL_NAME (strcat lw "/acadsst/ils2100/" BL_NAME))
|
||||
(command "_insert" BL_NAME P0 "" "" pause)
|
||||
(attribute-aendern "" "" "" "" "" block-kennung "" "" "" "")
|
||||
|
||||
(if (or (= m_DWG_NAME "0") (= m_DWG_NAME "1")) ; AS-Element als BG
|
||||
(progn
|
||||
(setq AUSWAHL-SATZ (ssget "_L"))
|
||||
(EINZELTEIL E_ARTINR E_BEZEICHNUNG "1")
|
||||
(mach-block P0 "0" AUSWAHL-SATZ)
|
||||
(attribute-aendern "0" "2" "3" "0" "0" block-kennung "333333333" (strcat NEV "MIT " E_BEZEICHNUNG) "1" "")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun EINZELTEIL (E_ARTINR E_BEZEICHNUNG E_MENGE)
|
||||
(command "_layer" "_m" "ILS-COMPONENTS" "_c" "7" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/ils2100/d_einzel") P0 "" "" "0")
|
||||
(attribute-aendern "0" "0" "23" "" "" block-kennung E_ARTINR E_BEZEICHNUNG E_MENGE "")
|
||||
(ssadd (entlast) AUSWAHL-SATZ)
|
||||
)
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
(defun c:ILS_AE_ELEM ( / DWG_NAME BL_NAME P0)
|
||||
(setvar "limcheck" 0)
|
||||
(setvar "CMDECHO" 0)
|
||||
(setvar "BLIPMODE" 0)
|
||||
(setq ALTFANG (getvar "osmode"))
|
||||
(setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB
|
||||
(prompt "**** ILS MODULS *******")
|
||||
(prompt "")
|
||||
(if (null m_DWG_NAME)(setq m_DWG_NAME "0")) ; Anfangssymbolname
|
||||
(if (null m_PNEUM) (setq m_PNEUM "PNEUM_1")) ; Pneumatik
|
||||
(Dbox)
|
||||
(prompt "")
|
||||
(datain)
|
||||
(geometrie)
|
||||
(setvar "osmode" ALTFANG)
|
||||
)
|
||||
@@ -1,243 +0,0 @@
|
||||
;------------------------------------------------------------------------;
|
||||
; ALU-KOMPONENTEN - HFS_MOD.LSP ;
|
||||
;------------------------------------------------------------------------;
|
||||
; AW 14.06.97 / 15.8.98 / 19.9.06 / 11.01.07 ;
|
||||
;------------------------------------------------------------------------;
|
||||
(defun Dbox (/ Dat)
|
||||
(setq Dat (load_dialog (strcat lw "/acadsst/ils2100/ILS_ANBAU_STR.DCL")))
|
||||
(if (not (new_dialog "ILS_ANBAU_STR" Dat)) (exit))
|
||||
|
||||
(set_tile "DWG_NAME" m_DWG_NAME); Blockname
|
||||
(set_tile "PNEUM" m_PNEUM)
|
||||
(set_tile "ANBAU" m_ANBAU)
|
||||
(set_tile "ABHANG" m_ABHANG)
|
||||
|
||||
(mode_tile "anzeige" 0)
|
||||
(SetDia)
|
||||
(ACTION_TILE "DWG_NAME" "(zeig_dia)")
|
||||
(action_tile "accept" "(SetPara) (done_dialog)")
|
||||
(action_tile "cancel" "(exit) (done_dialog)")
|
||||
(start_dialog)
|
||||
(unload_dialog Dat)
|
||||
)
|
||||
|
||||
(defun SetDia()
|
||||
(setq breite (dimx_tile "anzeige"))
|
||||
(setq hoehe (dimy_tile "anzeige"))
|
||||
(start_image "anzeige")
|
||||
(FILL_IMAGE 0 0 breite hoehe -18)
|
||||
(if (= m_DWG_NAME "0")
|
||||
(slide_image 0 0 breite hoehe "ils2100(SEP_EH_A)") ; rapid fire LINKS
|
||||
)
|
||||
(if (= m_DWG_NAME "1")
|
||||
(slide_image 0 0 breite hoehe "ils2100(SEP_EH_B)") ; rapid fire RECHTS
|
||||
)
|
||||
(if (= m_DWG_NAME "2")
|
||||
(slide_image 0 0 breite hoehe "ils2100(SEP_DH_A)") ; Separator Doppel-Hub (Gefälle) LINKS
|
||||
)
|
||||
(if (= m_DWG_NAME "3")
|
||||
(slide_image 0 0 breite hoehe "ils2100(SEP_DH_B)") ; *SONDER* Separator Doppel-Hub (Gefälle) RECHTS
|
||||
)
|
||||
(end_image)
|
||||
)
|
||||
|
||||
(defun zeig_dia()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
(if (or (= m_DWG_NAME "0") (= m_DWG_NAME "1")) ; Einfach-Hub Separator LINKS oder RECHTS
|
||||
(progn
|
||||
(mode_tile "PNEUM" 0)
|
||||
(mode_tile "ANBAU" 1)
|
||||
(mode_tile "ABHANG" 0)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "2") ; Doppel-Hub Separator LINKS
|
||||
(progn
|
||||
(setq m_ANBAU "ANBAU_2")
|
||||
(set_tile "ANBAU" "ANBAU_2")
|
||||
(mode_tile "PNEUM" 0)
|
||||
(mode_tile "ANBAU" 0)
|
||||
(mode_tile "ABHANG" 1)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "3") ; Doppel-Hub Separator SONDER RECHTS
|
||||
(progn
|
||||
(setq m_ANBAU "ANBAU_3")
|
||||
(set_tile "ANBAU" "ANBAU_3")
|
||||
(mode_tile "PNEUM" 0)
|
||||
(mode_tile "ANBAU" 0)
|
||||
(mode_tile "ABHANG" 1)
|
||||
)
|
||||
)
|
||||
(SetDia)
|
||||
)
|
||||
|
||||
(defun setpara()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
(setq m_PNEUM (get_tile "PNEUM"))
|
||||
(setq m_ABHANG (get_tile "ABHANG"))
|
||||
(setq m_ANBAU (get_tile "ANBAU"))
|
||||
)
|
||||
|
||||
(defun datain ()
|
||||
(setq dummy nil)
|
||||
)
|
||||
|
||||
(defun geometrie()
|
||||
(if (= m_DWG_NAME "0")
|
||||
(progn
|
||||
(setq NEV "SEPARATOR 1-HUB LINKS")
|
||||
(setq BL_NAME "829432001A")
|
||||
(PNEUM_SEP)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "1")
|
||||
(progn
|
||||
(setq NEV "SEPARATOR 1-HUB RECHTS")
|
||||
(setq BL_NAME "829432001B")
|
||||
(PNEUM_SEP)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "2")
|
||||
(progn
|
||||
(setq NEV "SEPARATOR 2-HUEBE LINKS")
|
||||
(setq BL_NAME "829432005A")
|
||||
(PNEUM_GEFAELLE)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "3")
|
||||
(progn
|
||||
(setq NEV "SEPARATOR 2-HUEBE RECHTS [*SONDER*]")
|
||||
(setq BL_NAME "829432005B")
|
||||
(PNEUM_GEFAELLE)
|
||||
)
|
||||
)
|
||||
|
||||
(command "_layer" "_m" "ILS-COMPONENTS" "_c" "7" "" "")
|
||||
(setq P0 (getpoint "\nPick insert point: "))
|
||||
(bl-name P0) ;--> Block-Name definieren -> R�ckgabe: element-name
|
||||
(setq BL_NAME (strcat lw "/acadsst/ils2100/" BL_NAME))
|
||||
(command "_insert" BL_NAME P0 "" "" pause)
|
||||
(attribute-aendern "" "" "" "" "" block-kennung "" "" "" "")
|
||||
|
||||
(setq AUSWAHL-SATZ (ssget "_L"))
|
||||
|
||||
;<<< Pneumatik setzen
|
||||
(EINZELTEIL E_ARTINR E_BEZEICHNUNG "1" "0")
|
||||
;<<< Abhänger für Einfach-Hub Separator
|
||||
(if (or (= m_DWG_NAME "0") (= m_DWG_NAME "1"))
|
||||
(ABHAENGER)
|
||||
)
|
||||
;<<< Für Separator in Gefälle immer das gleiche Profil
|
||||
(if (or (= m_DWG_NAME "2") (= m_DWG_NAME "3"))
|
||||
(progn
|
||||
(EINZELTEIL "829434312" "ABHAENGUNG F.SEP.GEFAELLESTRECKE KPL." "1" "20")
|
||||
(setq NEV (strcat NEV "+" "ABH.GEFAELLE"))
|
||||
)
|
||||
)
|
||||
|
||||
;<<< Anbau [LINKS ]für Separator Doppel-Hub
|
||||
(if (or (= m_DWG_NAME "2") (= m_DWG_NAME "3"))
|
||||
(progn
|
||||
(if (= m_ANBAU "ANBAU_2")
|
||||
(progn
|
||||
(EINZELTEIL "829434320" "ANBAU [LINKS] MT-TRAVERSENSTOPPER AN SEP. KPL." "1" "30")
|
||||
(setq NEV (strcat NEV "+" "ANBAU [LINKS] MT"))
|
||||
)
|
||||
)
|
||||
(if (= m_ANBAU "ANBAU_3")
|
||||
(progn
|
||||
(EINZELTEIL "829434321" "ANBAU [RECHTS] MT-TRAVERSENSTOPPER AN SEP. KPL." "1" "30")
|
||||
(setq NEV (strcat NEV "+" "ANBAU [RECHTS] MT"))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(mach-block P0 "0" AUSWAHL-SATZ)
|
||||
(setq NEV (strcat NEV " KPL."))
|
||||
(attribute-aendern "0" "2" "3" "0" "0" block-kennung "333333333" NEV "1" "")
|
||||
|
||||
)
|
||||
|
||||
(defun PNEUM_SEP ()
|
||||
(if (= m_PNEUM "PNEUM_1")
|
||||
(progn
|
||||
(setq E_ARTINR "829434101")
|
||||
(setq E_BEZEICHNUNG "BOSCH-PNEUM.F.EINFACH-HUB KPL.[829434101]")
|
||||
(setq NEV (strcat NEV "+" "BOSCH"))
|
||||
)
|
||||
)
|
||||
(if (= m_PNEUM "PNEUM_2")
|
||||
(progn
|
||||
(setq E_ARTINR "829434121")
|
||||
(setq E_BEZEICHNUNG "SMC-PNEUM.F:EINFACH-HUB KPL.[829434121]")
|
||||
(setq NEV (strcat NEV "+" "SMC"))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun PNEUM_GEFAELLE ()
|
||||
(if (= m_PNEUM "PNEUM_1")
|
||||
(progn
|
||||
(setq E_ARTINR "829434100")
|
||||
(setq E_BEZEICHNUNG "BOSCH-PNEUM.F.DOPPEL-HUB KPL.[829434100]")
|
||||
(setq NEV (strcat NEV "+" "BOSCH"))
|
||||
)
|
||||
)
|
||||
(if (= m_PNEUM "PNEUM_2")
|
||||
(progn
|
||||
(setq E_ARTINR "829434120")
|
||||
(setq E_BEZEICHNUNG "SMC-PNEU.F.DOPPEL-HUB KPL.[829434120]")
|
||||
(setq NEV (strcat NEV "+" "SMC"))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun ABHAENGER ()
|
||||
(if (= m_ABHANG "ABHANG_1") ; Abhängung an Monster-Profil LP
|
||||
(progn
|
||||
(EINZELTEIL "829434310" "ABHAENGUNG F.SEP.AN TRAEGERPROFIL" "1" "10")
|
||||
(setq NEV (strcat NEV "+" "ABH.MONSTER-LP"))
|
||||
)
|
||||
)
|
||||
(if (= m_ABHANG "ABHANG_2") ; Abhängung an Monster-Profil LP für PIN
|
||||
(progn
|
||||
(EINZELTEIL "829434310" "ABHAENGUNG F.SEP.AN TRAEGERPROFIL" "1" "10")
|
||||
(setq NEV (strcat NEV "+" "ABH.MONSTER-LP F.PIN"))
|
||||
)
|
||||
)
|
||||
(if (= m_ABHANG "ABHANG_3") ; Abhängung an LP
|
||||
(progn
|
||||
(EINZELTEIL "829434311" "ABHAENGUNG F.SEP.AN LP KPL." "1" "10")
|
||||
(setq NEV (strcat NEV "+" "ABH.AN LP"))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun EINZELTEIL (E_ARTINR E_BEZEICHNUNG E_MENGE WINKEL)
|
||||
(command "_layer" "_m" "ILS-COMPONENTS" "_c" "7" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/ils2100/d_einzel") P0 "" "" WINKEL)
|
||||
(attribute-aendern "0" "0" "23" "" "" block-kennung E_ARTINR E_BEZEICHNUNG E_MENGE "")
|
||||
(ssadd (entlast) AUSWAHL-SATZ)
|
||||
)
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
(defun c:ILS_ANBAU_STR ( / DWG_NAME BL_NAME P0)
|
||||
(setvar "limcheck" 0)
|
||||
(setvar "CMDECHO" 0)
|
||||
(setvar "BLIPMODE" 0)
|
||||
(setq ALTFANG (getvar "osmode"))
|
||||
(setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB
|
||||
(prompt "**** ILS SEPARATOR/STOPPER *******")
|
||||
(prompt "")
|
||||
(if (null m_DWG_NAME) (setq m_DWG_NAME "0")) ; Anfangssymbolname
|
||||
(if (null m_PNEUM) (setq m_PNEUM "PNEUM_2")) ; SMC Pneumatik
|
||||
(if (null m_ABHANG) (setq m_ABHANG "ABHANG_1")) ; Abhänger
|
||||
(if (null m_ANBAU) (setq m_ANBAU "ANBAU_1")) ; Anbaubaugruppe für Separator Doppelhub
|
||||
|
||||
(Dbox)
|
||||
(prompt "")
|
||||
(datain)
|
||||
(geometrie)
|
||||
(setvar "osmode" ALTFANG)
|
||||
)
|
||||
@@ -1,383 +0,0 @@
|
||||
;------------------------------------------------------------------------;
|
||||
; ILS 2100 ANGEBOT ;
|
||||
;------------------------------------------------------------------------;
|
||||
; AW 18.11.2007 ;
|
||||
; 23.01.2009 Bereinigung und Ergänzung ;
|
||||
;------------------------------------------------------------------------;
|
||||
(defun Dbox (/ Dat)
|
||||
(setq Dat (load_dialog (strcat lw "/acadsst/ils2100/ILS_ANGEBOT.DCL")))
|
||||
(if (not (new_dialog "ILS_ANGEBOT" Dat)) (exit))
|
||||
(set_tile "DWG_NAME" m_DWG_NAME); Blockname
|
||||
(set_tile "RICHT" m_RICHT)
|
||||
(mode_tile "anzeige" 0)
|
||||
(SetDia)
|
||||
|
||||
(ACTION_TILE "DWG_NAME" "(zeig_dia)")
|
||||
(ACTION_TILE "RICHT" "(zeig_dia)")
|
||||
|
||||
(action_tile "accept" "(SetPara) (done_dialog)")
|
||||
(action_tile "cancel" "(exit) (done_dialog)")
|
||||
(start_dialog)
|
||||
(unload_dialog Dat)
|
||||
)
|
||||
|
||||
(defun SetDia()
|
||||
(setq breite (dimx_tile "anzeige"))
|
||||
(setq hoehe (dimy_tile "anzeige"))
|
||||
(start_image "anzeige")
|
||||
(FILL_IMAGE 0 0 breite hoehe -18)
|
||||
|
||||
(if (= m_DWG_NAME "0") ; Antrieb 800
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000010)")
|
||||
)
|
||||
(if (= m_DWG_NAME "1") ; Spannstation 800
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000030)")
|
||||
)
|
||||
(if (= m_DWG_NAME "2") ; Umlenkstation 800
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000050)")
|
||||
)
|
||||
(if (= m_DWG_NAME "3") ; Antrieb 300
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000020)")
|
||||
)
|
||||
(if (= m_DWG_NAME "4") ; Spannstation 300
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000040)")
|
||||
)
|
||||
(if (= m_DWG_NAME "5") ; AS
|
||||
(progn
|
||||
(if (= m_RICHT "LINKS")
|
||||
(slide_image 0 0 breite hoehe "ils2100(B300020L)")
|
||||
(slide_image 0 0 breite hoehe "ils2100(B300020R)")
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "6") ; ES
|
||||
(progn
|
||||
(if (= m_RICHT "LINKS")
|
||||
(slide_image 0 0 breite hoehe "ils2100(B300021L)")
|
||||
(slide_image 0 0 breite hoehe "ils2100(B300021R)")
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "7") ; Separator
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000150)")
|
||||
)
|
||||
(if (= m_DWG_NAME "8") ; Gefälle
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000160)")
|
||||
)
|
||||
(if (= m_DWG_NAME "9") ; Scanner für BM
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000170)")
|
||||
)
|
||||
(if (= m_DWG_NAME "10") ; Scanner manuell für Bekleidung
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000171)")
|
||||
)
|
||||
(if (= m_DWG_NAME "11") ; Scanner automatisch
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000175)")
|
||||
)
|
||||
(if (= m_DWG_NAME "12") ; Beladung
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000320)")
|
||||
)
|
||||
(if (= m_DWG_NAME "13") ; Entladung
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000310)")
|
||||
)
|
||||
(if (= m_DWG_NAME "14") ; AE 30 GRAD rechts/links
|
||||
(progn
|
||||
(if (= m_RICHT "LINKS")
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000340)")
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000345)")
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "15") ; ETF Umlenkung rechts/links
|
||||
(progn
|
||||
(if (= m_RICHT "LINKS")
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000360)")
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000365)")
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "16") ; ETF Antrieb rechts/links
|
||||
(progn
|
||||
(if (= m_RICHT "LINKS")
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000350)")
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000355)")
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "17") ; EE 30 GRAD rechts/links
|
||||
(progn
|
||||
(if (= m_RICHT "LINKS")
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000330)")
|
||||
(slide_image 0 0 breite hoehe "ils2100(B3000335)")
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "18") ; ETF kompl. rechts/links
|
||||
(progn
|
||||
(if (= m_RICHT "LINKS")
|
||||
(slide_image 0 0 breite hoehe "ils2100(ETF_L)")
|
||||
(slide_image 0 0 breite hoehe "ils2100(ETF_R)")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(end_image)
|
||||
)
|
||||
|
||||
(defun zeig_dia()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
(setq m_RICHT (get_tile "RICHT"))
|
||||
|
||||
(if (= m_DWG_NAME "0") ; Antrieb 800
|
||||
(mode_tile "RICHT" 1)
|
||||
)
|
||||
(if (= m_DWG_NAME "1") ; Spannstation 800
|
||||
(mode_tile "RICHT" 1)
|
||||
)
|
||||
(if (= m_DWG_NAME "2") ; Umlenkstation 800
|
||||
(mode_tile "RICHT" 1)
|
||||
)
|
||||
(if (= m_DWG_NAME "3") ; Antrieb 300
|
||||
(mode_tile "RICHT" 1)
|
||||
)
|
||||
(if (= m_DWG_NAME "4") ; Spannstation 300
|
||||
(mode_tile "RICHT" 1)
|
||||
)
|
||||
(if (= m_DWG_NAME "5") ; AS
|
||||
(mode_tile "RICHT" 0)
|
||||
)
|
||||
(if (= m_DWG_NAME "6") ; ES
|
||||
(mode_tile "RICHT" 0)
|
||||
)
|
||||
(if (= m_DWG_NAME "7") ; Separator
|
||||
(mode_tile "RICHT" 1)
|
||||
)
|
||||
(if (= m_DWG_NAME "8") ; Gefälle
|
||||
(mode_tile "RICHT" 1)
|
||||
)
|
||||
(if (= m_DWG_NAME "9") ; Scanner für BM
|
||||
(mode_tile "RICHT" 1)
|
||||
)
|
||||
(if (= m_DWG_NAME "10") ; Scanner manuell für Bekleidung
|
||||
(mode_tile "RICHT" 1)
|
||||
)
|
||||
(if (= m_DWG_NAME "11") ; Scanner automatisch
|
||||
(mode_tile "RICHT" 1)
|
||||
)
|
||||
(if (= m_DWG_NAME "12") ; Beladung
|
||||
(mode_tile "RICHT" 1)
|
||||
)
|
||||
(if (= m_DWG_NAME "13") ; Entladung
|
||||
(mode_tile "RICHT" 1)
|
||||
)
|
||||
(if (= m_DWG_NAME "14") ; AE 30 GRAD rechts/links
|
||||
(mode_tile "RICHT" 0)
|
||||
)
|
||||
(if (= m_DWG_NAME "15") ; ETF Umlenkung rechts/links
|
||||
(mode_tile "RICHT" 0)
|
||||
)
|
||||
(if (= m_DWG_NAME "16") ; ETF Antrieb rechts/links
|
||||
(mode_tile "RICHT" 0)
|
||||
)
|
||||
(if (= m_DWG_NAME "17") ; EE 30 GRAD rechts/links
|
||||
(mode_tile "RICHT" 0)
|
||||
)
|
||||
(if (= m_DWG_NAME "18") ; ETF kompl. rechts/links
|
||||
(mode_tile "RICHT" 0)
|
||||
)
|
||||
|
||||
(SetDia)
|
||||
)
|
||||
|
||||
(defun setpara()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
(setq m_RICHT (get_tile "RICHT"))
|
||||
)
|
||||
|
||||
(defun datain ()
|
||||
(setq dummy nil)
|
||||
)
|
||||
|
||||
(defun geometrie()
|
||||
(setq NEV "")
|
||||
(setq E_ARTINR "")
|
||||
(setq E_BEZEICHNUNG "")
|
||||
|
||||
(if (= m_DWG_NAME "0") ; Antrieb 800
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-ANTRIEB" "_c" "1" "" "")
|
||||
(setq BL_NAME "0_B3000010")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "1") ; Spannstation 800
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-SPANNSTATION" "_c" "2" "" "")
|
||||
(setq BL_NAME "0_B3000030")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "2") ; Umlenkstation 800
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-UMLENKSTATION" "_c" "2" "" "")
|
||||
(setq BL_NAME "0_B3000050")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "3") ; Antrieb 300
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-ANTRIEB" "_c" "1" "" "")
|
||||
(setq BL_NAME "0_B3000020")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "4") ; Spannstation 300
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-SPANNSTATION" "_c" "2" "" "")
|
||||
(setq BL_NAME "0_B3000040")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "5") ; AS
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-AS" "_c" "1" "" "")
|
||||
(if (= m_RICHT "LINKS")
|
||||
(setq BL_NAME "0_B3000200_L")
|
||||
(setq BL_NAME "0_B3000200_R")
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "6") ; ES
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-ES" "_c" "7" "" "")
|
||||
(if (= m_RICHT "LINKS")
|
||||
(setq BL_NAME "0_B3000210_L")
|
||||
(setq BL_NAME "0_B3000210_R")
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "7") ; Separator
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-SP" "_c" "3" "" "")
|
||||
(setq BL_NAME "0_B3000150")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "8") ; Separator Gefälle
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-SP-G" "_c" "4" "" "")
|
||||
(setq BL_NAME "0_B3000160")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "9") ; Scanner für Betriebsmittel
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-SCANNER" "_c" "5" "" "")
|
||||
(setq BL_NAME "0_B3000170")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "10") ; Handscanner
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-SCANNER" "_c" "5" "" "")
|
||||
(setq BL_NAME "0_B3000171")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "11") ; Automatik Scanner für die Ware
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-SCANNER" "_c" "5" "" "")
|
||||
(setq BL_NAME "0_B3000175")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "12") ; Beladung
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-BELADUNG" "_c" "3" "" "")
|
||||
(setq BL_NAME "0_B3000320")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "13") ; Entladung
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-ENTLADUNG" "_c" "4" "" "")
|
||||
(setq BL_NAME "0_B3000310")
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "14") ; AE 30 GRAD rechts/links
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-ETF" "_c" "6" "" "")
|
||||
(if (= m_RICHT "LINKS")
|
||||
(setq BL_NAME "0_B3000340")
|
||||
(setq BL_NAME "0_B3000345")
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "15") ; ETF Umlenkung rechts/links
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-ETF" "_c" "6" "" "")
|
||||
(if (= m_RICHT "LINKS")
|
||||
(setq BL_NAME "0_B3000360")
|
||||
(setq BL_NAME "0_B3000365")
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "16") ; ETF Antrieb rechts/links
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-ETF" "_c" "6" "" "")
|
||||
(if (= m_RICHT "LINKS")
|
||||
(setq BL_NAME "0_B3000350")
|
||||
(setq BL_NAME "0_B3000355")
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "17") ; EE 30 GRAD rechts/links
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-ETF" "_c" "6" "" "")
|
||||
(if (= m_RICHT "LINKS")
|
||||
(setq BL_NAME "0_B3000330")
|
||||
(setq BL_NAME "0_B3000335")
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "18") ; ETF kompl. rechts/links
|
||||
(progn
|
||||
(command "_layer" "_m" "ILS-ETF" "_c" "6" "" "")
|
||||
(if (= m_RICHT "LINKS")
|
||||
(setq BL_NAME "ETF_L")
|
||||
(setq BL_NAME "ETF_R")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(setq P0 (getpoint "\nPick insert point: "))
|
||||
; (bl-name P0) ;--> Block-Name definieren -> R�ckgabe: element-name
|
||||
(setq BL_NAME (strcat lw "/acadsst/ils2100/" BL_NAME))
|
||||
(command "_insert" BL_NAME P0 "" "" pause)
|
||||
; (attribute-aendern "" "" "" "" "" block-kennung "" "" "" "")
|
||||
|
||||
;----------------------------------------------------------------------
|
||||
; (if (or (= m_DWG_NAME "0") (= m_DWG_NAME "1")) ; AS-Element
|
||||
; (progn
|
||||
; (setq AUSWAHL-SATZ (ssget "_L"))
|
||||
; (EINZELTEIL E_ARTINR E_BEZEICHNUNG "1")
|
||||
; (mach-block P0 "0" AUSWAHL-SATZ)
|
||||
; (attribute-aendern "0" "2" "3" "0" "0" block-kennung "333333333" (strcat NEV "MIT " E_BEZEICHNUNG) "1" "")
|
||||
; )
|
||||
; )
|
||||
;----------------------------------------------------------------------
|
||||
)
|
||||
|
||||
;(defun EINZELTEIL (E_ARTINR E_BEZEICHNUNG E_MENGE)
|
||||
; (command "_layer" "_m" "ILS-COMPONENTS" "_c" "7" "" "")
|
||||
; (command "_insert" (strcat lw "/acadsst/ils2100/d_einzel") P0 "" "" "0")
|
||||
; (attribute-aendern "0" "0" "23" "" "" block-kennung E_ARTINR E_BEZEICHNUNG E_MENGE "")
|
||||
; (ssadd (entlast) AUSWAHL-SATZ)
|
||||
;)
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
(defun c:ILS_ANGEBOT ( / DWG_NAME BL_NAME P0)
|
||||
(setvar "limcheck" 0)
|
||||
(setvar "CMDECHO" 0)
|
||||
(setvar "BLIPMODE" 0)
|
||||
(setq ALTFANG (getvar "osmode"))
|
||||
(setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB
|
||||
(prompt "**** ILS ANGEBOT MOULE *******")
|
||||
(prompt "")
|
||||
(if (null m_DWG_NAME)(setq m_DWG_NAME "0")) ; Anfangssymbolname
|
||||
(if (null m_RICHT) (setq m_RICHT "LINKS")) ; Richtung
|
||||
(Dbox)
|
||||
(prompt "")
|
||||
(datain)
|
||||
(geometrie)
|
||||
(setvar "osmode" ALTFANG)
|
||||
)
|
||||
@@ -1,175 +0,0 @@
|
||||
;------------------------------------------------------------------------;
|
||||
; ILS 2100 - ANGEBOTSMODULE ;
|
||||
;------------------------------------------------------------------------;
|
||||
; AW 17.10.06 ;
|
||||
;------------------------------------------------------------------------;
|
||||
(defun Dbox (/ Dat)
|
||||
(setq Dat (load_dialog (strcat lw "/acadsst/ils2100/ILS_ANGEBOT_MODULE.DCL")))
|
||||
(if (not (new_dialog "ILS_ANGEBOT_MODULE" Dat)) (exit))
|
||||
(set_tile "DWG_NAME" m_DWG_NAME); Blockname
|
||||
(set_tile "ART" m_ART)
|
||||
(mode_tile "anzeige" 0)
|
||||
(SetDia)
|
||||
(ACTION_TILE "DWG_NAME" "(zeig_dia)")
|
||||
(action_tile "accept" "(SetPara) (done_dialog)")
|
||||
(action_tile "cancel" "(exit) (done_dialog)")
|
||||
(start_dialog)
|
||||
(unload_dialog Dat)
|
||||
)
|
||||
|
||||
(defun SetDia()
|
||||
(setq breite (dimx_tile "anzeige"))
|
||||
(setq hoehe (dimy_tile "anzeige"))
|
||||
(start_image "anzeige")
|
||||
(FILL_IMAGE 0 0 breite hoehe -18)
|
||||
(if (= m_DWG_NAME "0")
|
||||
(slide_image 0 0 breite hoehe "ils2100(modul1)")
|
||||
)
|
||||
(if (= m_DWG_NAME "1")
|
||||
(slide_image 0 0 breite hoehe "ils2100(modul2)")
|
||||
)
|
||||
(if (= m_DWG_NAME "2")
|
||||
(slide_image 0 0 breite hoehe "ils2100(modul3)")
|
||||
)
|
||||
(if (= m_DWG_NAME "3")
|
||||
(slide_image 0 0 breite hoehe "ils2100(modul4)")
|
||||
)
|
||||
(if (= m_DWG_NAME "4")
|
||||
(slide_image 0 0 breite hoehe "ils2100(modul5)")
|
||||
)
|
||||
(if (= m_DWG_NAME "5")
|
||||
(slide_image 0 0 breite hoehe "ils2100(modul1_3)")
|
||||
)
|
||||
(if (= m_DWG_NAME "6")
|
||||
(slide_image 0 0 breite hoehe "ils2100(modul2_3)")
|
||||
)
|
||||
(end_image)
|
||||
)
|
||||
|
||||
(defun zeig_dia()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
(SetDia)
|
||||
)
|
||||
|
||||
(defun setpara()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
(setq m_ART (get_tile "ART"))
|
||||
)
|
||||
|
||||
(defun datain ()
|
||||
(setq dummy nil)
|
||||
)
|
||||
|
||||
(defun geometrie()
|
||||
(if (= m_DWG_NAME "0")
|
||||
(progn
|
||||
(setq NEV "SEPARATOR LINKS - RAD")
|
||||
(setq BL_NAME "829432001")
|
||||
(PNEUM_SEP)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "1")
|
||||
(progn
|
||||
(setq NEV "SEPARATOR RECHTS - RAD")
|
||||
(setq BL_NAME "829432002")
|
||||
(PNEUM_SEP)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "2")
|
||||
(progn
|
||||
(setq NEV "SEPARATOR LINKS - LP")
|
||||
(setq BL_NAME "829432003")
|
||||
(PNEUM_SEP)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "3")
|
||||
(progn
|
||||
(setq NEV "SEPARATOR RECHTS - LP")
|
||||
(setq BL_NAME "829432004")
|
||||
(PNEUM_SEP)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "4")
|
||||
(progn
|
||||
(setq NEV "SEPARATOR SP")
|
||||
(setq BL_NAME "829432005")
|
||||
(PNEUM_GEFAELLE)
|
||||
)
|
||||
)
|
||||
(if (= m_DWG_NAME "5")
|
||||
(progn
|
||||
(setq NEV "STOPPER - SP")
|
||||
(setq BL_NAME "829432006")
|
||||
(PNEUM_GEFAELLE)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(command "_layer" "_m" "ILS-COMPONENTS" "_c" "8" "" "")
|
||||
(setq P0 (getpoint "\nPick insert point: "))
|
||||
(bl-name P0) ;--> Block-Name definieren -> R�ckgabe: element-name
|
||||
(setq BL_NAME (strcat lw "/acadsst/ils2100/" BL_NAME))
|
||||
(command "_insert" BL_NAME P0 "" "" pause)
|
||||
(attribute-aendern "" "" "" "" "" block-kennung "" "" "" "")
|
||||
|
||||
(setq AUSWAHL-SATZ (ssget "_L"))
|
||||
(EINZELTEIL E_ARTINR E_BEZEICHNUNG "1")
|
||||
(mach-block P0 "0" AUSWAHL-SATZ)
|
||||
(attribute-aendern "0" "2" "3" "0" "0" block-kennung "333333333" (strcat NEV "MIT " E_BEZEICHNUNG) "1" "")
|
||||
|
||||
)
|
||||
|
||||
(defun EINZELTEIL (E_ARTINR E_BEZEICHNUNG E_MENGE)
|
||||
(command "_layer" "_m" "ILS-COMPONENTS" "_c" "8" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/ils2100/d_einzel") P0 "" "" "0")
|
||||
(attribute-aendern "0" "0" "23" "" "" block-kennung E_ARTINR E_BEZEICHNUNG E_MENGE "")
|
||||
(ssadd (entlast) AUSWAHL-SATZ)
|
||||
)
|
||||
|
||||
(defun PNEUM_SEP ()
|
||||
(if (= m_PNEUM "PNEUM_1")
|
||||
(progn
|
||||
(setq E_ARTINR "829 434 101")
|
||||
(setq E_BEZEICHNUNG "BOSCH-PNEUMATIK-SATZ")
|
||||
)
|
||||
)
|
||||
(if (= m_PNEUM "PNEUM_2")
|
||||
(progn
|
||||
(setq E_ARTINR "829 434 121")
|
||||
(setq E_BEZEICHNUNG "SMC-PNEUMATIK-SATZ")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun PNEUM_GEFAELLE ()
|
||||
(if (= m_PNEUM "PNEUM_1")
|
||||
(progn
|
||||
(setq E_ARTINR "829434100")
|
||||
(setq E_BEZEICHNUNG "BOSCH-PNEUMATIK-SATZ")
|
||||
)
|
||||
)
|
||||
(if (= m_PNEUM "PNEUM_2")
|
||||
(progn
|
||||
(setq E_ARTINR "829434120")
|
||||
(setq E_BEZEICHNUNG "SMC-PNEUMATIK-SATZ")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
(defun c:ILS_ANBAU_STR ( / DWG_NAME BL_NAME P0)
|
||||
(setvar "limcheck" 0)
|
||||
(setvar "CMDECHO" 0)
|
||||
(setvar "BLIPMODE" 0)
|
||||
(setq ALTFANG (getvar "osmode"))
|
||||
(setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB
|
||||
(prompt "**** ILS SEPARATORS/STOPPER *******")
|
||||
(prompt "")
|
||||
(if (null m_DWG_NAME)(setq m_DWG_NAME "0")) ; Anfangssymbolname
|
||||
(if (null m_PNEUM) (setq m_PNEUM "PNEUM_1")) ; Pneumatik
|
||||
(Dbox)
|
||||
(prompt "")
|
||||
(datain)
|
||||
(geometrie)
|
||||
(setvar "osmode" ALTFANG)
|
||||
)
|
||||
@@ -1,94 +0,0 @@
|
||||
;------------------------------------------------------------------------;
|
||||
; ALU-KOMPONENTEN - ils_sensor.LSP ;
|
||||
;------------------------------------------------------------------------;
|
||||
; AW 14.06.97 / 15.8.98 / 20.9.06 ;
|
||||
;------------------------------------------------------------------------;
|
||||
(defun Dbox (/ Dat)
|
||||
(setq Dat (load_dialog (strcat lw "/acadsst/ils2100/ils_sensor.DCL")))
|
||||
(if (not (new_dialog "ils_sensor" Dat)) (exit))
|
||||
(set_tile "DWG_NAME" m_DWG_NAME); Blockname
|
||||
(mode_tile "anzeige" 0)
|
||||
(SetDia)
|
||||
(ACTION_TILE "DWG_NAME" "(zeig_dia)")
|
||||
(action_tile "accept" "(SetPara) (done_dialog)")
|
||||
(action_tile "cancel" "(exit) (done_dialog)")
|
||||
(start_dialog)
|
||||
(unload_dialog Dat)
|
||||
)
|
||||
|
||||
(defun SetDia()
|
||||
(setq breite (dimx_tile "anzeige"))
|
||||
(setq hoehe (dimy_tile "anzeige"))
|
||||
(start_image "anzeige")
|
||||
(FILL_IMAGE 0 0 breite hoehe -18)
|
||||
(if (= m_DWG_NAME "0")
|
||||
(slide_image 0 0 breite hoehe "ils2100(27422001)")
|
||||
)
|
||||
(if (= m_DWG_NAME "1")
|
||||
(slide_image 0 0 breite hoehe "ils2100(27422002)")
|
||||
)
|
||||
(if (= m_DWG_NAME "2")
|
||||
(slide_image 0 0 breite hoehe "ils2100(27422003)")
|
||||
)
|
||||
(if (= m_DWG_NAME "3")
|
||||
(slide_image 0 0 breite hoehe "ils2100(27422004)")
|
||||
)
|
||||
(if (= m_DWG_NAME "4")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29422039)")
|
||||
)
|
||||
(end_image)
|
||||
)
|
||||
|
||||
(defun zeig_dia()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
(SetDia)
|
||||
)
|
||||
|
||||
(defun setpara()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
)
|
||||
|
||||
(defun datain ()
|
||||
(setq dummy nil)
|
||||
)
|
||||
|
||||
(defun geometrie()
|
||||
(if (= m_DWG_NAME "0")
|
||||
(setq BL_NAME "827422001")
|
||||
)
|
||||
(if (= m_DWG_NAME "1")
|
||||
(setq BL_NAME "827422002")
|
||||
)
|
||||
(if (= m_DWG_NAME "2")
|
||||
(setq BL_NAME "827422003")
|
||||
)
|
||||
(if (= m_DWG_NAME "3")
|
||||
(setq BL_NAME "827422004")
|
||||
)
|
||||
(if (= m_DWG_NAME "4")
|
||||
(setq BL_NAME "829422039")
|
||||
)
|
||||
(command "_layer" "_m" "ILS-AUTOMATION" "_c" "1" "" "")
|
||||
(setq P0 (getpoint "\nPick insert point: "))
|
||||
(bl-name P0) ;--> Block-Name definieren -> R�ckgabe: element-name
|
||||
(setq BL_NAME (strcat lw "/acadsst/ils2100/" BL_NAME))
|
||||
(command "_insert" BL_NAME P0 "" "" pause)
|
||||
(attribute-aendern "" "" "" "" "" block-kennung "" "" "" "")
|
||||
)
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
(defun c:ils_sensor ( / DWG_NAME BL_NAME P0)
|
||||
(setvar "limcheck" 0)
|
||||
(setvar "CMDECHO" 0)
|
||||
(setvar "BLIPMODE" 0)
|
||||
(setq ALTFANG (getvar "osmode"))
|
||||
(setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB
|
||||
(prompt "**** ILS MODULS *******")
|
||||
(prompt "")
|
||||
(if (null m_DWG_NAME)(setq m_DWG_NAME "0")); Anfangssymbolname
|
||||
(Dbox)
|
||||
(prompt "")
|
||||
(datain)
|
||||
(geometrie)
|
||||
(setvar "osmode" ALTFANG)
|
||||
)
|
||||
@@ -1,107 +0,0 @@
|
||||
;------------------------------------------------------------------------;
|
||||
; ALU-KOMPONENTEN - HFS_MOD.LSP ;
|
||||
;------------------------------------------------------------------------;
|
||||
; AW 14.06.97 / 15.8.98 / 20.9.06 ;
|
||||
;------------------------------------------------------------------------;
|
||||
(defun Dbox (/ Dat)
|
||||
(setq Dat (load_dialog (strcat lw "/acadsst/ils2100/ils_verb_str.DCL")))
|
||||
(if (not (new_dialog "ils_verb_str" Dat)) (exit))
|
||||
(set_tile "DWG_NAME" m_DWG_NAME); Blockname
|
||||
(mode_tile "anzeige" 0)
|
||||
(SetDia)
|
||||
(ACTION_TILE "DWG_NAME" "(zeig_dia)")
|
||||
(action_tile "accept" "(SetPara) (done_dialog)")
|
||||
(action_tile "cancel" "(exit) (done_dialog)")
|
||||
(start_dialog)
|
||||
(unload_dialog Dat)
|
||||
)
|
||||
|
||||
(defun SetDia()
|
||||
(setq breite (dimx_tile "anzeige"))
|
||||
(setq hoehe (dimy_tile "anzeige"))
|
||||
(start_image "anzeige")
|
||||
(FILL_IMAGE 0 0 breite hoehe -18)
|
||||
(if (= m_DWG_NAME "0")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29412013)")
|
||||
)
|
||||
(if (= m_DWG_NAME "1")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29412009)")
|
||||
)
|
||||
(if (= m_DWG_NAME "2")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29414007)")
|
||||
)
|
||||
(if (= m_DWG_NAME "3")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29414008)")
|
||||
)
|
||||
(if (= m_DWG_NAME "4")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29422035)")
|
||||
)
|
||||
(if (= m_DWG_NAME "5")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29422029)")
|
||||
)
|
||||
(if (= m_DWG_NAME "6")
|
||||
(slide_image 0 0 breite hoehe "ils2100(29422028)")
|
||||
)
|
||||
(end_image)
|
||||
)
|
||||
|
||||
(defun zeig_dia()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
(SetDia)
|
||||
)
|
||||
|
||||
(defun setpara()
|
||||
(setq m_DWG_NAME (get_tile "DWG_NAME"))
|
||||
)
|
||||
|
||||
(defun datain ()
|
||||
(setq dummy nil)
|
||||
)
|
||||
|
||||
(defun geometrie()
|
||||
(if (= m_DWG_NAME "0")
|
||||
(setq BL_NAME "829412013")
|
||||
)
|
||||
(if (= m_DWG_NAME "1")
|
||||
(setq BL_NAME "829412009")
|
||||
)
|
||||
(if (= m_DWG_NAME "2")
|
||||
(setq BL_NAME "829414007")
|
||||
)
|
||||
(if (= m_DWG_NAME "3")
|
||||
(setq BL_NAME "829414008")
|
||||
)
|
||||
(if (= m_DWG_NAME "4")
|
||||
(setq BL_NAME "829422035")
|
||||
)
|
||||
(if (= m_DWG_NAME "5")
|
||||
(setq BL_NAME "829422029")
|
||||
)
|
||||
(if (= m_DWG_NAME "6")
|
||||
(setq BL_NAME "829422028")
|
||||
)
|
||||
|
||||
(command "_layer" "_m" "ILS-COMPONENTS" "_c" "4" "" "")
|
||||
(setq P0 (getpoint "\nPick insert point: "))
|
||||
(bl-name P0) ;--> Block-Name definieren -> R�ckgabe: element-name
|
||||
(setq BL_NAME (strcat lw "/acadsst/ils2100/" BL_NAME))
|
||||
(command "_insert" BL_NAME P0 "" "" pause)
|
||||
(attribute-aendern "" "" "" "" "" "ZZZZZZZZZ" "" "" "" "")
|
||||
)
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
(defun c:ils_verb_str ( / DWG_NAME BL_NAME P0)
|
||||
(setvar "limcheck" 0)
|
||||
(setvar "CMDECHO" 0)
|
||||
(setvar "BLIPMODE" 0)
|
||||
(setq ALTFANG (getvar "osmode"))
|
||||
(setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB
|
||||
(prompt "**** ILS MODULS *******")
|
||||
(prompt "")
|
||||
(if (null m_DWG_NAME)(setq m_DWG_NAME "0")); Anfangssymbolname
|
||||
(Dbox)
|
||||
(prompt "")
|
||||
(datain)
|
||||
(geometrie)
|
||||
(setvar "osmode" ALTFANG)
|
||||
)
|
||||
@@ -1,462 +0,0 @@
|
||||
;............................................................
|
||||
;: DATE : 92-01-01 Kunde: tewi :
|
||||
;: Autor: Schmidt AutoCAD-Version 11 :
|
||||
;: Version 1.1 ab Version 10 mit anpassen :
|
||||
;: :
|
||||
;: LAYM14.LSP Layer-Manager :
|
||||
;:..........................................................:
|
||||
|
||||
(SPECIAL '(grp))
|
||||
|
||||
(DEFUN zoal () ;Zoom af
|
||||
(SETQ vsiz (GETVAR "VIEWSIZE"))
|
||||
(COMMAND "_ZOOM" "_V")
|
||||
)
|
||||
|
||||
(DEFUN zovo () ;Zoom vorher, wenn m”glich
|
||||
(IF (/= (GETVAR "VIEWSIZE") vsiz)
|
||||
(COMMAND "_ZOOM" "_P")
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN mdis (/ mlau)
|
||||
(SETQ mlau 26)
|
||||
(GRTEXT 0 "LAY-MAN")
|
||||
(GRTEXT 1 " ")
|
||||
(GRTEXT 2 " ? ")
|
||||
(GRTEXT 3 " SET ")
|
||||
(GRTEXT 4 "COPY GR.")
|
||||
(GRTEXT 5 "MOVE GR.")
|
||||
(GRTEXT 6 "MOVE EL ")
|
||||
(GRTEXT 7 "MOVE ALL")
|
||||
(GRTEXT 8 "ON LAYER")
|
||||
(GRTEXT 9 "OFF LAYR")
|
||||
(GRTEXT 10 "TAU LAY.")
|
||||
(GRTEXT 11 "FR LAYER")
|
||||
(GRTEXT 12 "FR ALL ")
|
||||
(GRTEXT 13 "DEL LAY.")
|
||||
(GRTEXT 14 "LAY.SELE")
|
||||
(GRTEXT 15 " ")
|
||||
(GRTEXT 16 " ")
|
||||
(GRTEXT 17 " ")
|
||||
(GRTEXT 18 " ")
|
||||
(GRTEXT 19 " ")
|
||||
(GRTEXT 20 " ")
|
||||
(GRTEXT 21 " ")
|
||||
(GRTEXT 22 " ")
|
||||
(GRTEXT 23 " ")
|
||||
(GRTEXT 24 " ")
|
||||
(GRTEXT 25 " ")
|
||||
(WHILE (< mlau mlen)
|
||||
(GRTEXT mlau " ")
|
||||
(SETQ mlau (1+ mlau))
|
||||
)
|
||||
)
|
||||
(DEFUN ssgad (nset gset / slau seln) ;SSET zu SSET addieren
|
||||
(SETQ slau 0)
|
||||
(IF (NULL (EVAL (READ gset)))(SET (READ gset)(SSADD)))
|
||||
(WHILE (SETQ seln (SSNAME nset slau))
|
||||
(SSADD seln (EVAL (READ gset)))
|
||||
(REDRAW seln 3)
|
||||
(SETQ slau (1+ slau))
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN ared (aset ltyp / asla asna) ;Ausleuchten von Elementen.
|
||||
(SETQ asla 0)
|
||||
(WHILE (SETQ asna (SSNAME aset asla))
|
||||
(REDRAW asna ltyp)
|
||||
(SETQ asla (1+ asla))
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN alay (txt) ;Layername filtern
|
||||
(IF (SETQ akel (ENTSEL txt))
|
||||
(CDR (ASSOC '8 (ENTGET (CAR akel))))
|
||||
)
|
||||
|
||||
)
|
||||
|
||||
(defun alel (tele elna) ;Elemente filtern
|
||||
(IF elna
|
||||
(SSGET "X" (LIST (CONS '0 elna)(CONS '8 tele)))
|
||||
(SSGET "X" (LIST (CONS '8 tele)))
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN lann (nwna ngna) ;Layer new name
|
||||
(STRCAT (SUBSTR nwna 1 1) ngna (SUBSTR nwna 4))
|
||||
)
|
||||
|
||||
(DEFUN laqu (/ lach) ;Layer Gruppenname
|
||||
(SETQ lach "-"
|
||||
last (SUBSTR (STRCASE (GETSTRING "Group-Letter: <_> ")) 1 2)
|
||||
last (COND
|
||||
((= (STRLEN last) 2) last)
|
||||
((= (STRLEN last) 1) (STRCAT last lach))
|
||||
( T (STRCAT lach lach))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN ltes (tlay grou) ;ausschalt Kontrolle
|
||||
(IF (OR (AND (= (SUBSTR (GETVAR "CLAYER") 2 2) tlay) grou)
|
||||
(AND (= (GETVAR "CLAYER") tlay) (NOT grou))
|
||||
)
|
||||
(emsg "change first active layer")
|
||||
T
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN layl (/ lext ltan) ;Layerliste
|
||||
(SETQ ltan T)
|
||||
(WHILE (SETQ lext (TBLNEXT "LAYER" ltan))
|
||||
(SETQ laex (CONS (CONS (CDADR lext) (CDDR lext)) laex)
|
||||
ltan NIL
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN ldis (/ run lauf llen) ;Layer am Seitenmenu anz.
|
||||
(SETQ run T
|
||||
lauf 0
|
||||
llen (LENGTH clis)
|
||||
)
|
||||
(WHILE run
|
||||
(WHILE (< lauf mlen)
|
||||
(IF (< lpos llen)
|
||||
(GRTEXT lauf (NTH lpos clis))
|
||||
(GRTEXT lauf " ")
|
||||
) ;Menuanzeige
|
||||
(SETQ lauf (1+ lauf)
|
||||
lpos (1+ lpos)
|
||||
)
|
||||
;um 1 erh”hen
|
||||
)
|
||||
(IF (> lpos mlen)
|
||||
(GRTEXT mlen "Prev. ")
|
||||
(GRTEXT mlen " ")
|
||||
) ;R�ckschalten
|
||||
(IF (> (- llen lpos) 0)
|
||||
(GRTEXT (1+ mlen) "Next ")
|
||||
(GRTEXT (1+ mlen) " ")
|
||||
) ;Vorw„rtsschalten
|
||||
(IF (= (CAR (SETQ antw (GRREAD))) 4)
|
||||
(IF (< (CADR antw) mlen)
|
||||
;wenn g�ltige Antwort
|
||||
(IF (> (SETQ antw (+ (CADR antw)(- lpos lauf))) llen)
|
||||
(SETQ antw NIL run NIL)
|
||||
(SETQ run NIL
|
||||
lpos (IF (= (- lpos mlen) (1- llen))
|
||||
(- lpos mlen mlen)
|
||||
(- lpos mlen)
|
||||
)
|
||||
)
|
||||
)
|
||||
(COND
|
||||
((AND (= (CADR antw) mlen)(> lpos mlen))
|
||||
;Vorher
|
||||
(SETQ lpos (- lpos mlen mlen)
|
||||
lauf 0
|
||||
)
|
||||
)
|
||||
((AND (= (CADR antw) (1+ mlen))(> llen lpos))
|
||||
;N„chst
|
||||
(SETQ lauf 0)
|
||||
)
|
||||
(T (emsg "False Field !"))
|
||||
)
|
||||
)
|
||||
(SETQ antw NIL run NIL)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN lays (ein / clis lpos laex antw atly akly llau lcom) ;Layer schalten
|
||||
(SETQ lpos 0)
|
||||
(layl)
|
||||
(IF ein
|
||||
(FOREACH xpos laex
|
||||
(IF (MINUSP (CDR (ASSOC 62 (CDR xpos))))
|
||||
(SETQ clis (CONS (CAR xpos) clis))
|
||||
)
|
||||
)
|
||||
(FOREACH xpos laex
|
||||
(IF (= (CDR (ASSOC 70 (CDR xpos))) 65)
|
||||
(SETQ clis (CONS (CAR xpos) clis))
|
||||
)
|
||||
)
|
||||
)
|
||||
(WHILE clis
|
||||
(PRINC "\nSelect Layer from the Screen Menu: ")
|
||||
(ldis)
|
||||
(IF antw
|
||||
(SETQ atly (NTH antw clis)
|
||||
akly (CONS atly akly)
|
||||
clis (APPEND (REVERSE (CDR (MEMBER atly (REVERSE clis))))
|
||||
(CDR (MEMBER atly clis))
|
||||
)
|
||||
)
|
||||
(SETQ clis NIL)
|
||||
)
|
||||
)
|
||||
(IF akly
|
||||
(PROGN
|
||||
(SETQ llau 0
|
||||
lcom (IF ein "_ON" "_T")
|
||||
)
|
||||
(PRINC "\n\nPlease wait ...")
|
||||
(COMMAND "_LAYER")
|
||||
(REPEAT (LENGTH akly)
|
||||
(COMMAND lcom (NTH llau akly))
|
||||
(SETQ llau (1+ llau))
|
||||
)
|
||||
(COMMAND "")
|
||||
)
|
||||
(emsg "Nothing selected!")
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN laye (/ lacg lauf lant) ;Layer neuer Auswahlsatz
|
||||
(SETQ lacg (SSLENGTH chgr)
|
||||
lauf 0
|
||||
)
|
||||
(REPEAT lacg
|
||||
(IF (NOT (MEMBER (SETQ lant (CDR (ASSOC 8 (ENTGET
|
||||
(SSNAME chgr lauf))))) lanl))
|
||||
(SETQ lanl (CONS lant lanl))
|
||||
)
|
||||
(SETQ lauf (1+ lauf))
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN layc (/ lall lauf lane linf laco nlna chel laol nwel) ;Layer change
|
||||
(SETQ lall (LENGTH lanl)
|
||||
lauf 0
|
||||
)
|
||||
(REPEAT lall
|
||||
(IF (NOT (ASSOC (lann (NTH lauf lanl) last) laex))
|
||||
(SETQ lane (CONS (NTH lauf lanl) lane))
|
||||
)
|
||||
(SETQ lauf (1+ lauf))
|
||||
)
|
||||
(SETQ lall (LENGTH lane)
|
||||
lauf 0
|
||||
)
|
||||
(REPEAT lall
|
||||
(SETQ linf (CDR (ASSOC (NTH lauf lane) laex))
|
||||
laco (IF (MINUSP (SETQ lico (CDR (ASSOC 62 linf))))(ABS lico) lico)
|
||||
nlna (lann (NTH lauf lane) last)
|
||||
)
|
||||
(COMMAND "_LAYER" "_N" nlna "_CO" lico nlna "LT" (CDR (ASSOC 6 linf)) nlna "")
|
||||
(SETQ lauf (1+ lauf))
|
||||
)
|
||||
(SETQ lall (SSLENGTH chgr)
|
||||
lauf 0
|
||||
)
|
||||
(REPEAT lall
|
||||
(SETQ chel (ENTGET (SSNAME chgr lauf))
|
||||
laol (ASSOC 8 chel)
|
||||
nwel (SUBST (CONS 8 (lann (CDR laol) last)) laol chel)
|
||||
)
|
||||
(ENTMOD nwel)
|
||||
(SETQ lauf (1+ lauf))
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN lgrn (cona / lpos lgri clis lnwn lnaw lsta ltmp lntp ldtp lddb last) ;Layer Gruppenmanipulationen
|
||||
(SETQ lpos 0)
|
||||
(layl)
|
||||
(FOREACH xpos laex
|
||||
(IF (SETQ lgri (SUBSTR (CAR xpos) 2 2))
|
||||
(IF clis
|
||||
(IF (NOT (MEMBER lgri clis))
|
||||
(SETQ clis (CONS lgri clis))
|
||||
)
|
||||
(SETQ clis (LIST lgri))
|
||||
)
|
||||
)
|
||||
)
|
||||
(IF clis
|
||||
(PROGN
|
||||
(PRINC "\nSelect group from the Screen Menu: ")
|
||||
(ldis)
|
||||
(IF antw
|
||||
(PROGN
|
||||
(SETQ lnwn (STRCAT "?" (NTH antw clis) "*"))
|
||||
(COND
|
||||
((= cona "_OFF")
|
||||
(IF (ltes (NTH antw clis) T)
|
||||
(COMMAND "_LAYER" "_OFF" lnwn "")
|
||||
)
|
||||
)
|
||||
((= cona "DEL")
|
||||
(SETQ lnaw (NTH antw clis)
|
||||
lsta T
|
||||
)
|
||||
(zoal)
|
||||
(WHILE (SETQ ltmp (TBLNEXT "LAYER" lsta))
|
||||
(IF (= (SUBSTR (SETQ lntp (CDR (ASSOC 2 ltmp))) 2 2) lnaw)
|
||||
(IF (SETQ ldtp (SSGET "X" (LIST (CONS 8 lntp))))
|
||||
(ssgad ldtp "lddb")
|
||||
)
|
||||
)
|
||||
(SETQ lsta NIL)
|
||||
)
|
||||
(IF lddb
|
||||
(IF (ques "Delete this Elements?" NIL)
|
||||
(COMMAND "_ERASE" lddb "")
|
||||
(ared lddb 4)
|
||||
)
|
||||
)
|
||||
(zovo)
|
||||
)
|
||||
((= cona "WAHL")
|
||||
(SETQ lnaw (NTH antw clis)
|
||||
lsta T
|
||||
)
|
||||
(WHILE (SETQ ltmp (TBLNEXT "LAYER" lsta))
|
||||
(IF (= (SUBSTR (SETQ lntp (CDR (ASSOC 2 ltmp))) 2 2) lnaw)
|
||||
(IF (SETQ ldtp (SSGET "X" (LIST (CONS 8 lntp))))
|
||||
(ssgad ldtp "lddb")
|
||||
)
|
||||
)
|
||||
(SETQ lsta NIL)
|
||||
)
|
||||
(IF lddb
|
||||
(PROGN
|
||||
(PRINC "\nThis Elements are now saved as !GRP")
|
||||
(PRINC "\nPress any key to continue...")
|
||||
(GRREAD)
|
||||
(SETQ grp lddb)
|
||||
(ared lddb 4)
|
||||
)
|
||||
(emsg "No elements found..!")
|
||||
)
|
||||
)
|
||||
(T (COMMAND "_LAYER" cona lnwn ""))
|
||||
)
|
||||
)
|
||||
(emsg "Nothing selected!")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(DEFUN laymanag (sele layn / vsiz elem elet akna akel akly clay lanl last) ;Hauptprogramm
|
||||
(IF (NOT runm)
|
||||
(pstart "Layer - Manager" "" '(("REGENMODE")))
|
||||
)
|
||||
(COND
|
||||
((= sele 2)
|
||||
(IF (SETQ akly (alay "\nObjekt wählen\n"))
|
||||
(PRINC (STRCAT "\nElement ist auf Layer " akly))
|
||||
)
|
||||
)
|
||||
((= sele 3)
|
||||
(IF (SETQ akly (alay "\nZiel-Ebene wählen\n"))
|
||||
(PROGN
|
||||
(COMMAND "_LAYER" "_SET" akly "")
|
||||
(SETQ cavar (SUBST (CONS "CLAYER" akly)
|
||||
(ASSOC '"CLAYER" cavar) cavar)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= sele 4)
|
||||
(IF (SETQ elem (ssget))
|
||||
(IF (SETQ akly (alay "\nObjekt auf dem Ziel-Ebene wählen\n"))
|
||||
(COMMAND "_COPY" elem "" "@" "@" "_CHANGE" elem "" "_PROP" "_LA" akly "")
|
||||
(emsg "Kein Layer gewählt! ")
|
||||
)
|
||||
(emsg "Kein Objekt gewählt! ")
|
||||
)
|
||||
)
|
||||
((= sele 5)
|
||||
(IF (SETQ elem (ssget))
|
||||
(IF (SETQ akly (alay "\nObjekt auf dem Ziel-Ebene wählen\n"))
|
||||
(COMMAND "_CHANGE" elem "" "_PROP" "_LA" akly "")
|
||||
(emsg "Kein Layer gewählt")
|
||||
)
|
||||
(emsg "Kein Objekt gewählt")
|
||||
)
|
||||
)
|
||||
((= sele 6)
|
||||
(IF (SETQ akly (alay "\nZu änderndes Objekt wählen\n"))
|
||||
(PROGN
|
||||
(SETQ akna (CDR (ASSOC '0 (ENTGET (CAR akel)))))
|
||||
(IF (SETQ elem (alel akly akna))
|
||||
(IF (SETQ akly (alay "Select object on the target layer:\n"))
|
||||
(PROGN
|
||||
(zoal)
|
||||
(ared elem 3)
|
||||
(IF (ques (STRCAT "Layer von "
|
||||
(COND
|
||||
((= akna "LINE") "Line")
|
||||
((= akna "CIRCLE") "Circle")
|
||||
((= akna "ARC") "Arc")
|
||||
((= akna "POINT") "Point")
|
||||
((= akna "PLINE") "Polylie")
|
||||
( T akna)
|
||||
)
|
||||
" ändern?") NIL)
|
||||
(COMMAND "_CHANGE" elem "" "_PROP" "_LA" akly "")
|
||||
(ared elem 4)
|
||||
)
|
||||
(zovo)
|
||||
)
|
||||
(emsg "Kein Layer gewählt")
|
||||
)
|
||||
)
|
||||
)
|
||||
(emsg "Kein Object gewählt")
|
||||
)
|
||||
)
|
||||
((= sele 7)
|
||||
(IF (SETQ akly (alay "\nDie zu ändernden Objekte wählen\n"))
|
||||
(IF (SETQ elem (alel akly NIL))
|
||||
(IF (SETQ akly (alay "Objekt auf der Ziel-Ebene wählen\n"))
|
||||
(PROGN
|
||||
(zoal)
|
||||
(ared elem 3)
|
||||
(IF (ques "Layer für diese Objekte ändern ?" NIL)
|
||||
(COMMAND "_CHANGE" elem "" "_PROP" "_LA" akly "")
|
||||
(ared elem 4)
|
||||
)
|
||||
(zovo)
|
||||
)
|
||||
(emsg "Kein Layer gewählt")
|
||||
)
|
||||
)
|
||||
(emsg "Kein Objekt gewählt")
|
||||
)
|
||||
)
|
||||
((= sele 8)(lays T))
|
||||
((= sele 9)
|
||||
(WHILE (SETQ akly (alay "\nLayer zum Ausblenden\n"))
|
||||
(IF (ltes akly nil)
|
||||
(COMMAND "_LAYER" "_OFF" akly "")
|
||||
)
|
||||
)
|
||||
)
|
||||
((= sele 10)(lays NIL))
|
||||
((= sele 11)
|
||||
(WHILE (SETQ akly (alay "\nLayer FRIEREN\n"))
|
||||
(IF (ltes akly nil)
|
||||
(COMMAND "_LAYER" "_FR" akly "")
|
||||
)
|
||||
)
|
||||
)
|
||||
((= sele 12)
|
||||
(SETQ clay (alay "\nObjekt auf dem aktiven Layer der aktiv bleibt wählen\n"))
|
||||
(COMMAND "_LAYER" "_SET" clay "_FR" "*" "")
|
||||
)
|
||||
)
|
||||
(IF (NOT runm)
|
||||
(pend)
|
||||
)
|
||||
)
|
||||
|
||||
(PRINC)
|
||||
(PRINC "\n Layermanager loaded")
|
||||
(PRINC)
|
||||
@@ -1,518 +0,0 @@
|
||||
(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 "Yes No Yes")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "No")
|
||||
)
|
||||
(PROGN
|
||||
(INITGET 1 "Yes No No")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "Yes")
|
||||
)
|
||||
)
|
||||
)
|
||||
(DEFUN emsg (etxt)
|
||||
(IF (NOT bell)(PROMPT "\007"))
|
||||
(TERPRI)
|
||||
(PROMPT etxt)
|
||||
(TERPRI)
|
||||
)
|
||||
(DEFUN ques (dial defa) ;Std Abfrage
|
||||
(IF defa
|
||||
(PROGN
|
||||
(INITGET 1 "Yes No Yes")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "No")
|
||||
)
|
||||
(PROGN
|
||||
(INITGET 1 "Yes No No")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <N>: ")) "Yes")
|
||||
)
|
||||
)
|
||||
)
|
||||
(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 "Yes No Yes")
|
||||
(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 "\nInsert-Point: "))
|
||||
(SETQ drehung (GETSTRING "\nRotation: "))
|
||||
(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)
|
||||
)
|
||||
(progn
|
||||
(alert (strcat "\nBlockname: " element-name " already exists." ))
|
||||
(setq element-name (strcat "x" element-name))
|
||||
(alert (strcat "\nCorrected blockname: " element-name " .OK!"))
|
||||
(command "_block" element-name PT0 auswahl-satz "")
|
||||
(command "_insert" element-name PT0 "" "" szoeg)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(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-ohne-prop (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 exists. You need HELP !")
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(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 exists. You need HELP !")
|
||||
)
|
||||
)
|
||||
|
||||
;---------- 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)
|
||||
)
|
||||
|
||||
;---------- Attribute aendern - Laenge,Endstueck,Artikel-Nr.--------------------
|
||||
(defun ATTRIBUTE-AENDERN_IO (M_IO M_ID M_VERW M_BEZEICHNUNG M_KENNZEICHNUNG M_SPS / 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_IO) 0) (= ATTRIBUT-BEZEICHNUNG "IO"))
|
||||
(entmod (subst (cons 1 M_IO) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
|
||||
(if (and (> (strlen M_ID) 0) (= ATTRIBUT-BEZEICHNUNG "ID"))
|
||||
(entmod (subst (cons 1 M_ID) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
|
||||
(if (and (> (strlen M_VERW) 0) (= ATTRIBUT-BEZEICHNUNG "VERW"))
|
||||
(entmod (subst (cons 1 M_VERW) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
|
||||
(if (and (> (strlen M_BEZEICHNUNG) 0) (= ATTRIBUT-BEZEICHNUNG "BEZEICHNUNG"))
|
||||
(entmod (subst (cons 1 M_BEZEICHNUNG) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
|
||||
(if (and (> (strlen M_KENNZEICHNUNG) 0) (= ATTRIBUT-BEZEICHNUNG "KENNZEICHNUNG"))
|
||||
(entmod (subst (cons 1 M_KENNZEICHNUNG) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
(if (and (> (strlen M_SPS) 0) (= ATTRIBUT-BEZEICHNUNG "SPS"))
|
||||
(entmod (subst (cons 1 M_SPS) (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))
|
||||
)
|
||||
)
|
||||
;--------------------------------------------------------------------------
|
||||
(setq lw "m:")
|
||||
(setvar "attreq" 0)
|
||||
(setq
|
||||
v-lay (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")
|
||||
v-col (list "7" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")
|
||||
v-ltyp (list "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" )
|
||||
)
|
||||
;----------------------------------------------------------------------------
|
||||
(prompt "\nSSG-Menu.. (c) 2013 by SCHÖNENBERGER Systeme GmbH - All rights reserved")
|
||||
(prompt " ")
|
||||
(princ)
|
||||
@@ -1,515 +0,0 @@
|
||||
(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 "Yes No Yes")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "No")
|
||||
)
|
||||
(PROGN
|
||||
(INITGET 1 "Yes No No")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "Yes")
|
||||
)
|
||||
)
|
||||
)
|
||||
(DEFUN emsg (etxt)
|
||||
(IF (NOT bell)(PROMPT "\007"))
|
||||
(TERPRI)
|
||||
(PROMPT etxt)
|
||||
(TERPRI)
|
||||
)
|
||||
(DEFUN ques (dial defa) ;Std Abfrage
|
||||
(IF defa
|
||||
(PROGN
|
||||
(INITGET 1 "Yes No Yes")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "No")
|
||||
)
|
||||
(PROGN
|
||||
(INITGET 1 "Yes No No")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <N>: ")) "Yes")
|
||||
)
|
||||
)
|
||||
)
|
||||
(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 "Yes No Yes")
|
||||
(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 "\nInsert-Point: "))
|
||||
(SETQ drehung (GETSTRING "\nRotation: "))
|
||||
(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)
|
||||
)
|
||||
(progn
|
||||
(alert (strcat "\nBlockname: " element-name " already exists." ))
|
||||
(setq element-name (strcat "x" element-name))
|
||||
(alert (strcat "\nCorrected blockname: " element-name " .OK!"))
|
||||
(command "_block" element-name PT0 auswahl-satz "")
|
||||
(command "_insert" element-name PT0 "" "" szoeg)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(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-ohne-prop (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 exists. You need HELP !")
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(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 exists. You need HELP !")
|
||||
)
|
||||
)
|
||||
|
||||
;---------- 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)
|
||||
)
|
||||
|
||||
;---------- Attribute aendern - Laenge,Endstueck,Artikel-Nr.--------------------
|
||||
(defun ATTRIBUTE-AENDERN_IO (M_IO M_ID M_VERW M_BEZEICHNUNG M_KENNZEICHNUNG / 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_IO) 0) (= ATTRIBUT-BEZEICHNUNG "IO"))
|
||||
(entmod (subst (cons 1 M_IO) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
|
||||
(if (and (> (strlen M_ID) 0) (= ATTRIBUT-BEZEICHNUNG "ID"))
|
||||
(entmod (subst (cons 1 M_ID) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
|
||||
(if (and (> (strlen M_VERW) 0) (= ATTRIBUT-BEZEICHNUNG "VERW"))
|
||||
(entmod (subst (cons 1 M_VERW) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
|
||||
(if (and (> (strlen M_BEZEICHNUNG) 0) (= ATTRIBUT-BEZEICHNUNG "BEZEICHNUNG"))
|
||||
(entmod (subst (cons 1 M_BEZEICHNUNG) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
|
||||
(if (and (> (strlen M_KENNZEICHNUNG) 0) (= ATTRIBUT-BEZEICHNUNG "KENNZEICHNUNG"))
|
||||
(entmod (subst (cons 1 M_KENNZEICHNUNG) (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))
|
||||
)
|
||||
)
|
||||
;--------------------------------------------------------------------------
|
||||
(setq lw "m:")
|
||||
(setvar "attreq" 0)
|
||||
(setq
|
||||
v-lay (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")
|
||||
v-col (list "7" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")
|
||||
v-ltyp (list "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" )
|
||||
)
|
||||
;----------------------------------------------------------------------------
|
||||
(prompt "\nSSG-Menu.. (c) 2007 by SCHÖNENBERGER Systeme GmbH - All rights reserved")
|
||||
(prompt " ")
|
||||
(princ)
|
||||
@@ -1,518 +0,0 @@
|
||||
(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 "Yes No Yes")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "No")
|
||||
)
|
||||
(PROGN
|
||||
(INITGET 1 "Yes No No")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "Yes")
|
||||
)
|
||||
)
|
||||
)
|
||||
(DEFUN emsg (etxt)
|
||||
(IF (NOT bell)(PROMPT "\007"))
|
||||
(TERPRI)
|
||||
(PROMPT etxt)
|
||||
(TERPRI)
|
||||
)
|
||||
(DEFUN ques (dial defa) ;Std Abfrage
|
||||
(IF defa
|
||||
(PROGN
|
||||
(INITGET 1 "Yes No Yes")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "No")
|
||||
)
|
||||
(PROGN
|
||||
(INITGET 1 "Yes No No")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <N>: ")) "Yes")
|
||||
)
|
||||
)
|
||||
)
|
||||
(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 "Yes No Yes")
|
||||
(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 "\nInsert-Point: "))
|
||||
(SETQ drehung (GETSTRING "\nRotation: "))
|
||||
(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)
|
||||
)
|
||||
(progn
|
||||
(alert (strcat "\nBlockname: " element-name " already exists." ))
|
||||
(setq element-name (strcat "x" element-name))
|
||||
(alert (strcat "\nCorrected blockname: " element-name " .OK!"))
|
||||
(command "_block" element-name PT0 auswahl-satz "")
|
||||
(command "_insert" element-name PT0 "" "" szoeg)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(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-ohne-prop (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 exists. You need HELP !")
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(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 exists. You need HELP !")
|
||||
)
|
||||
)
|
||||
|
||||
;---------- 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)
|
||||
)
|
||||
|
||||
;---------- Attribute aendern - Laenge,Endstueck,Artikel-Nr.--------------------
|
||||
(defun ATTRIBUTE-AENDERN_IO (M_IO M_ID M_VERW M_BEZEICHNUNG M_KENNZEICHNUNG M_SPS / 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_IO) 0) (= ATTRIBUT-BEZEICHNUNG "IO"))
|
||||
(entmod (subst (cons 1 M_IO) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
|
||||
(if (and (> (strlen M_ID) 0) (= ATTRIBUT-BEZEICHNUNG "ID"))
|
||||
(entmod (subst (cons 1 M_ID) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
|
||||
(if (and (> (strlen M_VERW) 0) (= ATTRIBUT-BEZEICHNUNG "VERW"))
|
||||
(entmod (subst (cons 1 M_VERW) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
|
||||
(if (and (> (strlen M_BEZEICHNUNG) 0) (= ATTRIBUT-BEZEICHNUNG "BEZEICHNUNG"))
|
||||
(entmod (subst (cons 1 M_BEZEICHNUNG) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
|
||||
(if (and (> (strlen M_KENNZEICHNUNG) 0) (= ATTRIBUT-BEZEICHNUNG "KENNZEICHNUNG"))
|
||||
(entmod (subst (cons 1 M_KENNZEICHNUNG) (assoc 1 (entget objekt))
|
||||
(entget objekt)))
|
||||
)
|
||||
(if (and (> (strlen M_SPS) 0) (= ATTRIBUT-BEZEICHNUNG "SPS"))
|
||||
(entmod (subst (cons 1 M_SPS) (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))
|
||||
)
|
||||
)
|
||||
;--------------------------------------------------------------------------
|
||||
(setq lw "D:")
|
||||
(setvar "attreq" 0)
|
||||
(setq
|
||||
v-lay (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")
|
||||
v-col (list "7" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")
|
||||
v-ltyp (list "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" )
|
||||
)
|
||||
;----------------------------------------------------------------------------
|
||||
(prompt "\nSSG-Menu.. (c) 2011 by SCHÖNENBERGER Systeme GmbH - All rights reserved")
|
||||
(prompt " ")
|
||||
(princ)
|
||||
@@ -1,434 +0,0 @@
|
||||
(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 "Yes No Yes")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "No")
|
||||
)
|
||||
(PROGN
|
||||
(INITGET 1 "Yes No No")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "Yes")
|
||||
)
|
||||
)
|
||||
)
|
||||
(DEFUN emsg (etxt)
|
||||
(IF (NOT bell)(PROMPT "\007"))
|
||||
(TERPRI)
|
||||
(PROMPT etxt)
|
||||
(TERPRI)
|
||||
)
|
||||
(DEFUN ques (dial defa) ;Std Abfrage
|
||||
(IF defa
|
||||
(PROGN
|
||||
(INITGET 1 "Yes No Yes")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "No")
|
||||
)
|
||||
(PROGN
|
||||
(INITGET 1 "Yes No No")
|
||||
(= (GETKWORD (STRCAT "\n" dial " Y/N <N>: ")) "Yes")
|
||||
)
|
||||
)
|
||||
)
|
||||
(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 "Yes No Yes")
|
||||
(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 "\nInsert-Point: "))
|
||||
(SETQ drehung (GETSTRING "\nRotation: "))
|
||||
(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)
|
||||
)
|
||||
(progn
|
||||
(alert (strcat "\nBlockname: " element-name " already exists." ))
|
||||
(setq element-name (strcat "x" element-name))
|
||||
(alert (strcat "\nCorrected blockname: " element-name " .OK!"))
|
||||
(command "_block" element-name PT0 auswahl-satz "")
|
||||
(command "_insert" element-name PT0 "" "" szoeg)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(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 exists. You need HELP !")
|
||||
)
|
||||
)
|
||||
|
||||
;---------- 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))
|
||||
)
|
||||
)
|
||||
;--------------------------------------------------------------------------
|
||||
(setq lw "m:")
|
||||
(setvar "attreq" 0)
|
||||
(setq
|
||||
v-lay (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")
|
||||
v-col (list "7" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")
|
||||
v-ltyp (list "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" )
|
||||
)
|
||||
;----------------------------------------------------------------------------
|
||||
(prompt "\nSSG-Menu.. (c) 2006 by SCHÖNENBERGER Systeme GmbH - All rights reserved")
|
||||
(prompt " ")
|
||||
(princ)
|
||||
@@ -1,697 +0,0 @@
|
||||
; PU1PU2 - Putzstation ;
|
||||
; -----------------------------------------------------------------------;
|
||||
; AW 1.3.98 ;
|
||||
;------------------------------------------------------------------------;
|
||||
|
||||
(defun start()
|
||||
(setq auswahl-satz nil)
|
||||
(setvar "limcheck" 0)
|
||||
(command "_vports" "_S" "aktiv" "_Y")
|
||||
(setq BMOD (getvar "BLIPMODE")
|
||||
MOSM (getvar "OSMODE")
|
||||
MSNA (getvar "SNAPMODE")
|
||||
MORT (getvar "ORTHOMODE")
|
||||
CLAY (getvar "CLAYER") ; aktuelle Ebene
|
||||
MECH (getvar "MENUECHO")
|
||||
BKSYM (getvar "UCSICON")
|
||||
UCSF (getvar "UCSFOLLOW")
|
||||
Z-HOEHE (getvar "THICKNESS")
|
||||
ERHEB (getvar "ELEVATION")
|
||||
)
|
||||
(princ)
|
||||
)
|
||||
|
||||
(defun Dbox (/ Dat)
|
||||
(setq Dat (load_dialog (strcat lw "/acadsst/spinne/pu1pu2.DCL")))
|
||||
(if (not (new_dialog "pu1pu2" Dat))
|
||||
(exit)
|
||||
)
|
||||
; (set_tile "SPULEN" m_SPULEN) ; Spulen pro Spulenzug - default: "36"
|
||||
; (set_tile "TEILUNG" m_TEILUNG)) ; Spulenzugteilung - default: "150"
|
||||
(set_tile "RICHTUNG" m_RICHTUNG) ; Drehrichtung - default: "LINKS"
|
||||
(set_tile "FUSS" m_FUSS) ; FUSS - default: OPPOSITE + VERBUNDEN
|
||||
(set_tile "ANTRIEB" m_ANTRIEB) ; Reibradantrieb - default: "mit Antrieb" (PU2)
|
||||
(set_tile "GERUEST" m_GERUEST) ; mit Gerüst
|
||||
(set_tile "BEMASS" m_BEMASS) ; keine Bemassung
|
||||
(SetDia)
|
||||
(ACTION_TILE "FUSS" "(zeig_dia)")
|
||||
(ACTION_TILE "RICHTUNG" "(zeig_dia)")
|
||||
(ACTION_TILE "ANTRIEB" "(zeig_dia)")
|
||||
(action_tile "accept" "(SetPara) (done_dialog)")
|
||||
(action_tile "cancel" "(exit) (done_dialog)")
|
||||
(start_dialog)
|
||||
(unload_dialog Dat)
|
||||
)
|
||||
|
||||
(defun SetDia()
|
||||
(setq breite (dimx_tile "anzeige"))
|
||||
(setq hoehe (dimy_tile "anzeige"))
|
||||
(start_image "anzeige")
|
||||
(FILL_IMAGE 0 0 breite hoehe -18)
|
||||
(if (and (= m_RICHTUNG "UHR")(= m_ANTRIEB "1")) ; Drehung in uhrzeigersinn+Antrieb
|
||||
(progn
|
||||
(if (= m_FUSS "ZURUECK") (slide_image 0 0 breite hoehe "spinne(pu2ll)"))
|
||||
(if (= m_FUSS "ENTGEGEN")(slide_image 0 0 breite hoehe "spinne(pu2lr)"))
|
||||
(if (= m_FUSS "ENTGVERB")(slide_image 0 0 breite hoehe "spinne(pu2lrd)"))
|
||||
(if (= m_FUSS "NICHTS") (slide_image 0 0 breite hoehe "spinne(pu2lo)"))
|
||||
)
|
||||
)
|
||||
(if (and (= m_RICHTUNG "GEGENUHR")(= m_ANTRIEB "1")) ; Drehung in gegenuhrzeigersinn+Antrieb
|
||||
(progn
|
||||
(if (= m_FUSS "ZURUECK") (slide_image 0 0 breite hoehe "spinne(pu2rr)"))
|
||||
(if (= m_FUSS "ENTGEGEN")(slide_image 0 0 breite hoehe "spinne(pu2rl)"))
|
||||
(if (= m_FUSS "ENTGVERB")(slide_image 0 0 breite hoehe "spinne(pu2rld)"))
|
||||
(if (= m_FUSS "NICHTS") (slide_image 0 0 breite hoehe "spinne(pu2ro)"))
|
||||
)
|
||||
)
|
||||
(if (and (= m_RICHTUNG "UHR") (= m_ANTRIEB "0")) ; Drehung in uhrzeigersinn und KEIN Antrieb
|
||||
(progn
|
||||
(if (= m_FUSS "ZURUECK") (slide_image 0 0 breite hoehe "spinne(pu1ll)"))
|
||||
(if (= m_FUSS "ENTGEGEN")(slide_image 0 0 breite hoehe "spinne(pu1lr)"))
|
||||
(if (= m_FUSS "ENTGVERB")(slide_image 0 0 breite hoehe "spinne(pu1lrd)"))
|
||||
(if (= m_FUSS "NICHTS") (slide_image 0 0 breite hoehe "spinne(pu1lo)"))
|
||||
)
|
||||
)
|
||||
(if (and (= m_RICHTUNG "GEGENUHR")(= m_ANTRIEB "0")) ; Drehung in gegenuhrzeigersinn und KEIN Antrieb
|
||||
(progn
|
||||
(if (= m_FUSS "ZURUECK") (slide_image 0 0 breite hoehe "spinne(pu1rr)"))
|
||||
(if (= m_FUSS "ENTGEGEN")(slide_image 0 0 breite hoehe "spinne(pu1rl)"))
|
||||
(if (= m_FUSS "ENTGVERB")(slide_image 0 0 breite hoehe "spinne(pu1rld)"))
|
||||
(if (= m_FUSS "NICHTS") (slide_image 0 0 breite hoehe "spinne(pu1ro)"))
|
||||
)
|
||||
)
|
||||
(end_image)
|
||||
)
|
||||
|
||||
(defun zeig_dia()
|
||||
(setq m_SPULEN (get_tile "SPULEN"))
|
||||
(setq m_TEILUNG (get_tile "TEILUNG"))
|
||||
(setq m_RICHTUNG (get_tile "RICHTUNG")) ; Drehrichtung
|
||||
(setq m_FUSS (get_tile "FUSS")) ; Weichenkonfiguration am Ein- und Ausfahrt
|
||||
(setq m_ANTRIEB (get_tile "ANTRIEB")) ; Reibradantrieb
|
||||
(setq m_GERUEST (get_tile "GERUEST")) ; Gerüst
|
||||
(setq m_BEMASS (get_tile "BEMASS")) ; Bemassung
|
||||
(SetDia)
|
||||
)
|
||||
|
||||
(defun SetPara ()
|
||||
(setq m_SPULEN (get_tile "SPULEN"))
|
||||
(setq m_TEILUNG (get_tile "TEILUNG"))
|
||||
(setq m_RICHTUNG (get_tile "RICHTUNG"))
|
||||
(setq m_FUSS (get_tile "FUSS"))
|
||||
(setq m_ANTRIEB (get_tile "ANTRIEB"))
|
||||
(setq m_GERUEST (get_tile "GERUEST"))
|
||||
(setq m_BEMASS (get_tile "BEMASS"))
|
||||
;-------------------------------------------------------
|
||||
(initget (+ 2 4))
|
||||
;-------------------------------------------------------
|
||||
)
|
||||
|
||||
|
||||
(defun datain ()
|
||||
;-------------------------------------------------------
|
||||
;>>>> Eingabeteil <<<<<<<
|
||||
;-------------------------------------------------------
|
||||
(if (= m_TEILUNG "0") ; 150-er Teilung
|
||||
(progn
|
||||
(setq A '(7250 9050 10850 12650 14450 16250 18050 19850))
|
||||
(setq B '(4900 6100 7300 8500 9700 10900 12100 13300))
|
||||
)
|
||||
)
|
||||
(if (= m_TEILUNG "1") ; 165-er Teilung
|
||||
(progn
|
||||
(setq A '(7790 9770 11750 13730 15710 17690 19670 21650))
|
||||
(setq B '(5260 6580 7900 9220 10540 11860 13180 14500))
|
||||
)
|
||||
)
|
||||
|
||||
(setq ANZ_SPULEN (atoi m_SPULEN)) ; um Wert NULL zu vermeiden
|
||||
|
||||
(setq ALTFANG (getvar "osmode"))
|
||||
(initget (+ 1 2 4))
|
||||
(command "_layer" "_m" "A-2" "_c" "2" "" "")
|
||||
(command "_ortho" "_off")
|
||||
(setq P0 (getpoint "\nPick insertion point : "))
|
||||
; (setq P0 (list (car P0) (cadr P0) UK-SCHIENE))
|
||||
(bl-name P0) ;--> Block-Name definieren -> Rückgabe: block-kennung
|
||||
(setq P1 (list (car p0) (+ (cadr p0) 2650) UK-SCHIENE))
|
||||
(if (= m_RICHTUNG "GEGENUHR") ; gegenuhrzeigersinn
|
||||
(progn
|
||||
(setq P2 (list (+ (nth ANZ_SPULEN A)(car p1)) (- (cadr P1) 200) UK-SCHIENE))
|
||||
(setq P3 (list (car p2) (cadr p0) UK-SCHIENE))
|
||||
(setq P4 (list (+ (car p1) 800) (cadr p1) UK-SCHIENE))
|
||||
(setq P6 (list (car p4) (- (cadr p4) 200) UK-SCHIENE))
|
||||
(setq P8 (list (car p4) (- (cadr p4) 2650) UK-SCHIENE))
|
||||
(setq P10 (list (car p0) (+ (cadr p0) 800) UK-SCHIENE))
|
||||
(setq P11 (list (car p0) (- (cadr p1) 1050) UK-SCHIENE))
|
||||
(setq P15 (list (+ (car p0) 300) (+ (cadr p0) 300) 0))
|
||||
)
|
||||
(progn
|
||||
(setq P2 (list (+ (nth ANZ_SPULEN A)(car p1)) (cadr P1) UK-SCHIENE))
|
||||
(setq P3 (list (car p2) (+ (cadr p0) 200) UK-SCHIENE))
|
||||
(setq P4 (list (+ (car p0) 800) (cadr p0) UK-SCHIENE))
|
||||
(setq P6 (list (car p4) (+ (cadr p4) 200) UK-SCHIENE))
|
||||
(setq P8 (list (car p4) (+ (cadr p4) 2650) UK-SCHIENE))
|
||||
(setq P10 (list (car p0) (+ (cadr p0) 1050) UK-SCHIENE))
|
||||
(setq P11 (list (car p1) (- (cadr p1) 500) UK-SCHIENE))
|
||||
(setq P15 (list (+ (car p0) 300) (+ (cadr p0) 500) 0))
|
||||
)
|
||||
)
|
||||
|
||||
(setq P14 (list (+ (nth ANZ_SPULEN B)(car p0)) (cadr P0) UK-SCHIENE))
|
||||
(command "_ortho" "_on")
|
||||
(setvar "osmode" 0)
|
||||
(command "_elevation" "0")
|
||||
(command "_ucs" "_w")
|
||||
(command "_fill" "_off")
|
||||
(setq M_ARTINR "821106002") ; artikel.nr fuer alu-profil APG110
|
||||
)
|
||||
|
||||
(defun geometrie()
|
||||
; ---- Bereich einstellen
|
||||
(command "_vpoint" "0,0,1")
|
||||
(command "_zoom" "_w" (list (- (car P0) 2000) (- (cadr P0) 2000) 0)
|
||||
(list (+ (car P2) 2000) (+ (cadr P2) 2000) 0))
|
||||
; --- Putzstation einfügen
|
||||
(command "_layer" "_m" "Putzstation" "_c" "5" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/spinne/putzstation") P15 "" "" "")
|
||||
(setq auswahl-satz (ssget "_L"))
|
||||
|
||||
(if (= m_RICHTUNG "GEGENUHR") ; in gegenuhrzeigerrichtung
|
||||
(progn
|
||||
(command "_layer" "_m" "A-2" "_c" "2" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/b1109065")
|
||||
(list (car P0) (cadr P0) (+ (caddr P0) UK-SCHIENE)) "" "" "180")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat lw "/acadsst/alu/wbe2r20") P1 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(if (= m_FUSS "ENTGEGEN")
|
||||
(progn
|
||||
(command "_insert" (strcat lw "/acadsst/alu/wbe2r20") P2 "" "" "180")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
(if (or (= m_FUSS "ZURUECK") (= m_FUSS "ENTGVERB"))
|
||||
(progn
|
||||
(command "_insert" (strcat lw "/acadsst/alu/wb2r20") P2 "" "" "180")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
|
||||
(gemeinsame-el)
|
||||
|
||||
; Fuß bearbeiten
|
||||
(if (= m_FUSS "ZURUECK")
|
||||
(progn
|
||||
(command "_layer" "_m" "A-2" "_c" "2" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/b1109065") P3 "" "" "")
|
||||
(command "_mirror" (entlast) "" P8 P3 "_Y")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(setq P12 (list (car p2) (+ (cadr p2) 650) UK-SCHIENE))
|
||||
(ap-zeichnen (list (car p3) (+ (cadr p3) 800) UK-SCHIENE) P12)
|
||||
(command "_layer" "_m" "A-10" "_c" "8" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/tv80") (list (car p3) (+ (cadr p3) 800) UK-SCHIENE) "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat lw "/acadsst/alu/alu_ks") P12 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
(if (= m_FUSS "ENTGEGEN")
|
||||
(progn
|
||||
(command "_layer" "_m" "A-2" "_c" "2" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/b1109065") P3 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
(if (= m_FUSS "ENTGVERB")
|
||||
(progn
|
||||
(command "_layer" "_m" "A-2" "_c" "2" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/sw90l70") P3 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(setq P12 (list (car p2) (+ (cadr p2) 650) UK-SCHIENE))
|
||||
(setq P13 (list (car p3) (- (cadr p3) 440) UK-SCHIENE))
|
||||
(ap-zeichnen P13 P12)
|
||||
(command "_layer" "_m" "A-10" "_c" "8" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/alu_ks") P12 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat lw "/acadsst/alu/alu_ks") P13 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
|
||||
; zieren
|
||||
(command "_layer" "_m" "A-1" "_c" "1" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_l")
|
||||
(list (+ (car p0) 2000) (cadr p0) UK-SCHIENE) "0.5" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_l")
|
||||
(list (+ (car p1) 2000) (cadr p1) UK-SCHIENE) "0.5" "" "180")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(if (or (= m_FUSS "ZURUECK") (= m_FUSS "ENTGVERB"))
|
||||
(progn
|
||||
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_l")
|
||||
(list (car p3) (+ (cadr p3) 1300) UK-SCHIENE) "0.5" "" "90")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
|
||||
(prompt (strcat "Modul-Länge=" (itoa (+ LAENGE 1650 (* WIEDERHOLE 6000)))))
|
||||
(prompt "\n")
|
||||
)
|
||||
) ; ENDE (if (= m_RICHTUNG "GEGENUHR")
|
||||
|
||||
(if (= m_RICHTUNG "UHR") ; in uhrzeigerrichtung
|
||||
(progn
|
||||
(command "_layer" "_m" "A-2" "_c" "2" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/wbe2l20") P0 "" "" "180")
|
||||
(setq auswahl-satz (ssget "_L"))
|
||||
(command "_insert" (strcat lw "/acadsst/alu/b1109065") P1 "" "" "90")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(if (= m_FUSS "ZURUECK")
|
||||
(progn
|
||||
(command "_insert" (strcat lw "/acadsst/alu/b1109065") P2 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
(if (= m_FUSS "ENTGEGEN")
|
||||
(progn
|
||||
(command "_insert" (strcat lw "/acadsst/alu/b1109065") P2 "" "" "180")
|
||||
(command "_mirror" (entlast) "" P3 P2 "_Y")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
(if (= m_FUSS "ENTGVERB")
|
||||
(progn
|
||||
(command "_insert" (strcat lw "/acadsst/alu/sw90r70") P2 "" "" "180")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
|
||||
(gemeinsame-el)
|
||||
|
||||
; Fuß bearbeiten
|
||||
(if (= m_FUSS "ZURUECK")
|
||||
(progn
|
||||
(command "_layer" "_m" "A-2" "_c" "2" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/wb2l20") P3 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(setq P12 (list (car p2) (- (cadr p2) 800) UK-SCHIENE))
|
||||
(ap-zeichnen (list (car p3) (- (cadr p3) 650) UK-SCHIENE) P12)
|
||||
(command "_layer" "_m" "A-10" "_c" "8" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/alu_ks") (list (car p3) (- (cadr p3) 650) UK-SCHIENE) "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat lw "/acadsst/alu/tv80") P12 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
(if (= m_FUSS "ENTGEGEN")
|
||||
(progn
|
||||
(command "_layer" "_m" "A-2" "_c" "2" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/wbe2l20") P3 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
(if (= m_FUSS "ENTGVERB")
|
||||
(progn
|
||||
(command "_layer" "_m" "A-2" "_c" "2" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/wb2l20") P3 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(setq P12 (list (car p2) (+ (cadr p2) 360) UK-SCHIENE))
|
||||
(setq P13 (list (car p3) (- (cadr p3) 650) UK-SCHIENE))
|
||||
(ap-zeichnen P13 P12)
|
||||
(command "_layer" "_m" "A-10" "_c" "8" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/alu_ks") P12 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat lw "/acadsst/alu/alu_ks") P13 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
|
||||
; zieren
|
||||
(command "_layer" "_m" "A-1" "_c" "1" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") (list (+ (car p1) 1500) (cadr p1) UK-SCHIENE) "0.5" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") (list (+ (car p0) 1500) (cadr p0) UK-SCHIENE) "0.5" "" "180")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(if (or (= m_FUSS "ZURUECK") (= m_FUSS "ENTGVERB"))
|
||||
(progn
|
||||
(command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") (list (car p3) (+ (cadr p3) 1300) UK-SCHIENE) "0.5" "" "90")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
|
||||
(prompt (strcat "Modul-Länge=" (itoa (+ LAENGE 1650 (* WIEDERHOLE 6000)))))
|
||||
(prompt "\n")
|
||||
)
|
||||
) ; ENDE (if (= m_RICHTUNG "UHR")
|
||||
)
|
||||
|
||||
|
||||
(defun gemeinsame-el()
|
||||
; trapezverbindungselemente
|
||||
(command "_layer" "_m" "A-10" "_c" "8" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/tv80") P4 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat lw "/acadsst/alu/tv80") P6 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat lw "/acadsst/alu/tv80") P8 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat lw "/acadsst/alu/tv80") P10 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_insert" (strcat lw "/acadsst/alu/tv80") P11 "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
|
||||
; -- ap träger zeichnen - ABSTAND ermitteln
|
||||
(ap-zeichnen P10 P11)
|
||||
(setq LAENGE (fix (- (nth ANZ_SPULEN A) 1650)))
|
||||
(setq WIEDERHOLE (fix (/ LAENGE 6000))); wenn > 6000 ist der faktor > 0
|
||||
(if (> WIEDERHOLE 0)
|
||||
(progn
|
||||
(repeat WIEDERHOLE
|
||||
(setq P5 (list (+ (car p4) 6000) (cadr p4) UK-SCHIENE))
|
||||
(ap-zeichnen P4 P5)
|
||||
(setq P4 P5) ; punkte vertauschen
|
||||
(setq P7 (list (+ (car p6) 6000) (cadr p6) UK-SCHIENE))
|
||||
(ap-zeichnen P6 P7)
|
||||
(setq P6 P7) ; punkte vertauschen
|
||||
(setq P9 (list (+ (car p8) 6000) (cadr p8) UK-SCHIENE))
|
||||
(ap-zeichnen P8 P9)
|
||||
(setq P8 P9) ; punkte vertauschen
|
||||
(setq LAENGE (- LAENGE 6000))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
; (if (= m_RICHTUNG "GEGENUHR")
|
||||
(if (= m_FUSS "ENTGEGEN")
|
||||
(progn
|
||||
(setq P5 (list (+ (car p4) LAENGE 50) (cadr p4) UK-SCHIENE))
|
||||
(setq P7 (list (+ (car p6) LAENGE 50) (cadr p6) UK-SCHIENE))
|
||||
)
|
||||
(progn
|
||||
(setq P5 (list (+ (car p4) LAENGE) (cadr p4) UK-SCHIENE))
|
||||
(setq P7 (list (+ (car p6) LAENGE) (cadr p6) UK-SCHIENE))
|
||||
)
|
||||
)
|
||||
; )
|
||||
(ap-zeichnen P4 P5)
|
||||
(ap-zeichnen P6 P7)
|
||||
(if (= m_FUSS "ENTGVERB")
|
||||
(setq P9 (list (+ (car p8) LAENGE 150) (cadr p8) UK-SCHIENE))
|
||||
(setq P9 (list (+ (car p8) LAENGE 50) (cadr p8) UK-SCHIENE))
|
||||
)
|
||||
(ap-zeichnen P8 P9)
|
||||
)
|
||||
|
||||
(defun ap-zeichnen (anfang ende)
|
||||
(command "_layer" "_m" "A-2" "_c" "2" "" "")
|
||||
(bl-name anfang) ;--> Block-Name definieren -> Rückgabe: element-name
|
||||
(command "_line" anfang ende "")
|
||||
(setq auswahl-ap (ssget "_L"))
|
||||
(mach-block anfang "0" AUSWAHL-AP)
|
||||
(attribute-aendern "0" "2" "3" (itoa (fix (distance anfang ende))) "" block-kennung
|
||||
M_ARTINR (strcat "APG110 L= " (itoa (fix (distance anfang ende)))) "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(setq auswahl-ap nil)
|
||||
(command "_layer" "_m" "A-10" "_c" "8" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/alu/tv80") ende "" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
|
||||
(defun BEMASSUNG ()
|
||||
;---------
|
||||
; Bemaßung
|
||||
;---------
|
||||
(command "_layer" "_m" "A-8" "_c" "8" "" "")
|
||||
(command "_dimtad" "0")
|
||||
(command "_dimtxt" "125")
|
||||
(command "_dimasz" "40")
|
||||
; (setvar "osmode" 0)
|
||||
(command "_dimaligned" P0 P1 (list (- (car p0) 400) (cadr p0) 0))
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_dimlinear" P11 P2 (list (- (car p11) 400) (cadr p11) 0))
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(if (= m_BEMASS "1")
|
||||
(progn
|
||||
(command "_layer" "_m" "F-8" "_c" "8" "" "")
|
||||
(command "_dimlinear" P0 P14 (list (+ (car p0) 2000) (- (cadr p0) 400) 0 ))
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun motor()
|
||||
(if (= m_RICHTUNG "GEGENUHR")
|
||||
(progn
|
||||
(command "_layer" "_m" "F-1" "_c" "1" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/foerder/ra1") P14 "" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/foerder/ra2_200") (list (car P14) (+ (cadr P14) 2450) UK-SCHIENE) "" "" "")
|
||||
)
|
||||
)
|
||||
(if (= m_RICHTUNG "UHR")
|
||||
(progn
|
||||
(command "_layer" "_m" "F-1" "_c" "1" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/foerder/ra2_200") P14 "" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/foerder/ra1") (list (car P14) (+ (cadr P14) 2650) UK-SCHIENE) "" "" "")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
; ---- GERUEST zeichnen ----------------------------------------------------
|
||||
(defun structure ()
|
||||
(setq T1 (list (- (car p0) 600) (- (cadr p0) 1175) UK-GERUEST))
|
||||
(setq T2 (list (+ (car p0) 1400) (- (cadr p0) 1175) UK-GERUEST))
|
||||
(setq T3 (list (- (car p3) 1400) (- (cadr p0) 1175) UK-GERUEST))
|
||||
(setq T4 (list (+ (car p3) 600) (- (cadr p0) 1175) UK-GERUEST))
|
||||
(setq T5 (list (car t1) (- (cadr p0) 325) UK-GERUEST))
|
||||
(setq T6 (list (+ (car P0) 100) (- (cadr p0) 325) UK-GERUEST))
|
||||
|
||||
; ---- eine 3-Fläche als Unterlage zeichnen
|
||||
(command "_layer" "_m" "Boden" "_c" "8" "" "")
|
||||
(command "_3dface" (list (car T1) (cadr T1) 0) (list (car T4) (cadr T4) 0)
|
||||
(list (car T4) (+ (cadr T4) 5000) 0) (list (car T1) (+ (cadr T4) 5000) 0) "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
|
||||
; ---- RT80/80 zeichnen ---------------------------------------------------
|
||||
(setq auswahl-rt nil)
|
||||
(command "_layer" "_m" "D-5" "_c" "5" "" "")
|
||||
; -- das kurze Stück zwischen DRT80
|
||||
(bl-name T6) ;--> Block-Name definieren -> Rückgabe: element-name
|
||||
(command "_line" (list (car T6) (+ (cadr T6) 35) (caddr T6)) (list (car T6) (+ (cadr T6) 3265) (caddr T6)) "")
|
||||
(setq auswahl-rt (ssget "_L"))
|
||||
(mach-block T1 "0" AUSWAHL-rt)
|
||||
(attribute-aendern "0" "2" "5" "3230" "115-115" block-kennung
|
||||
"825144004" "RT 80/80 L= 3230" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(if (not (= m_FUSS "NICHTS"))
|
||||
(progn
|
||||
(command "_copy" (entlast) "" T6 (list (+ (car T6) (- (fix (distance T1 T4)) 1400)) (cadr T6) (caddr T6)))
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
(setq auswahl-rt nil)
|
||||
(bl-name T1) ;--> Block-Name definieren -> Rückgabe: element-name
|
||||
(command "_line" T1 (list (car T1) (+ (cadr T1) 5000) (caddr T1)) "")
|
||||
(setq auswahl-rt (ssget "_L"))
|
||||
(mach-block T1 "0" AUSWAHL-rt)
|
||||
(attribute-aendern "0" "2" "5" "5000" "250-250" block-kennung
|
||||
"825144005" "RT 80/80 L= 5000" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(setq auswahl-rt nil)
|
||||
|
||||
; -------- wie oft kopieren ? -------------------------------------------
|
||||
(setq wieoft (+ (fix (/ (distance P0 P3) 3000)) 1))
|
||||
(setq copyabstand (fix (/ (distance P0 P3) wieoft)))
|
||||
(setq wieoft (- wieoft 2))
|
||||
(copy_element T1 T2 T3 T4)
|
||||
|
||||
; --- DRT 80 -> 1-mal zeichnen und 4 mal kopieren
|
||||
(command "_layer" "_m" "D-1" "_c" "1" "" "")
|
||||
(bl-name T5) ;--> Block-Name definieren -> Rückgabe: element-name
|
||||
(command "_line" (list (+ (car T5) 35) (cadr T5) (caddr T5))
|
||||
(list (+ (car T5) 1965) (cadr T5) (caddr T5)) "")
|
||||
(setq auswahl-rt (ssget "_L"))
|
||||
(mach-block T5 "0" AUSWAHL-rt)
|
||||
(attribute-aendern "0" "2" "5" "1930" "250-180" block-kennung
|
||||
"825084002" "DRT 80 L= 1930" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(setq auswahl-rt nil)
|
||||
(command "_copy" (entlast) "" T5 (list (car T5) (+ (cadr T5) 3300) (caddr T5)))
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(if (not (= m_FUSS "NICHTS"))
|
||||
(progn
|
||||
(command "_copy" (entlast) "" (list (car T5) (+ (cadr T5) 3300) (caddr T5))
|
||||
(list (+ (car T5) (fix (distance T1 T3))) (+ (cadr T5) 3300) (caddr T5)))
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(command "_copy" (entlast) "" (list (+ (car T5) (fix (distance T1 T3))) (+ (cadr T5) 3300) (caddr T5))
|
||||
(list (+ (car T5) (fix (distance T1 T3))) (cadr T5) (caddr T5)))
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
|
||||
; 2" Säulen ---------------------------------------------------------
|
||||
(setq AUSWAHL-STR nil)
|
||||
(setq TS1 (list (car T1) (- (cadr T1) 35) 0))
|
||||
(setq TS2 (list (car T2) (- (cadr T2) 35) 0))
|
||||
(setq TS3 (list (car T3) (- (cadr T3) 35) 0))
|
||||
(setq TS4 (list (car T4) (- (cadr T4) 35) 0))
|
||||
(command "_layer" "_m" "D-1" "_c" "1" "" "")
|
||||
(bl-name T1) ;--> Block-Name definieren -> Rueckgabe: element-name
|
||||
(setq PT1 (list (- (car TS1) 100) (- (cadr TS1) 150) 0))
|
||||
(setq PT2 (list (+ (car TS1) 100) (- (cadr TS1) 150) 0))
|
||||
(setq PT3 (list (+ (car TS1) 100) (+ (cadr TS1) 150) 0))
|
||||
(setq PT4 (list (- (car TS1) 100) (+ (cadr TS1) 150) 0))
|
||||
(setvar "thickness" 10)
|
||||
(setvar "elevation" 0)
|
||||
(command "_solid" PT1 PT2 PT4 PT3 "")
|
||||
(setq AUSWAHL-STR (ssget "_L"))
|
||||
(setvar "thickness" 2990)
|
||||
(setvar "elevation" 10)
|
||||
(command "_circle" TS1 "30")
|
||||
(ssadd (entlast) AUSWAHL-STR)
|
||||
(setvar "thickness" 0)
|
||||
(setvar "elevation" 0)
|
||||
(mach-block TS1 "0" AUSWAHL-STR)
|
||||
(attribute-aendern "0" "0" "25" "3000" "" block-kennung "821004025" "SL 2\" mit Fussplatte" "" "")
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(setq AUSWAHL-STR nil)
|
||||
(copy_element TS1 TS2 TS3 TS4)
|
||||
|
||||
; ----- UPAT Duebel 4 Stück ----------------------------------------
|
||||
(command "_layer" "_m" "D-10" "_c" "10" "" "")
|
||||
(setq WINKEL 0)
|
||||
(setvar "thickness" 0)
|
||||
(setvar "elevation" 0)
|
||||
(command "_insert" (strcat lw "/acadsst/rohr/d_einzel") TS1 "" "" (rtos WINKEL))
|
||||
(attribute-aendern "0" "0" "25" "" "" block-kennung "922021003" "HST M12/20" "4" "")
|
||||
(ssadd (entlast) AUSWAHL-SATZ)
|
||||
(copy_element TS1 TS2 TS3 TS4)
|
||||
(setq WINKEL (+ WINKEL 5))
|
||||
(command "_insert" (strcat lw "/acadsst/rohr/d_einzel") TS1 "" "" (rtos WINKEL))
|
||||
(attribute-aendern "0" "0" "25" "" "" block-kennung "923014001" "UPAT PSL-ANKER TYP B 14/10" "4" "")
|
||||
(ssadd (entlast) AUSWAHL-SATZ)
|
||||
(copy_element TS1 TS2 TS3 TS4)
|
||||
|
||||
; ---- KLEMMRING EINFACH
|
||||
(command "_layer" "_m" "D-4" "_c" "4" "" "")
|
||||
(command "_insert" (strcat lw "/acadsst/rohr/" "D_1KR") (list (car TS1) (cadr TS1) 2620) "" "" "")
|
||||
(ssadd (entlast) AUSWAHL-SATZ)
|
||||
(copy_element TS1 TS2 TS3 TS4)
|
||||
(command "_insert" (strcat lw "/acadsst/rohr/" "D_1KR") (list (car TS1) (cadr TS1) 2500) "" "" "")
|
||||
(ssadd (entlast) AUSWAHL-SATZ)
|
||||
(copy_element TS1 TS2 TS3 TS4)
|
||||
|
||||
; Säulen und Klemmringe spiegeln auf die andere Seite
|
||||
(command "_mirror" "_w" (list (- (car T1) 500) (- (cadr T1) 500) 0)
|
||||
(list (+ (car T4) 500) (+ (cadr T4) 500) 4000) ""
|
||||
(list (car P0) (+ (cadr P0) 1325) 0)
|
||||
(list (+ (car P0) 500) (+ (cadr P0) 1325) 0) "_N"
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
; ---- ELEMENTE KOPIEREN -----------------------------------------------------------------
|
||||
(defun copy_element (TK1 TK2 TK3 TK4)
|
||||
(command "_copy" (entlast) "" TK1 TK2)
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(setq AP_BEF_90 (+ AP_BEF_90 3)) ; Rohrschelle für AP kpl.
|
||||
(setq TM (list (+ (car TK1) 2000) (cadr TK1) (caddr TK1)))
|
||||
(repeat wieoft
|
||||
(setq TN (list (+ (car TM) copyabstand) (cadr TM) (caddr TM)))
|
||||
(command "_copy" (entlast) "" TM TN)
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(setq AP_BEF_90 (+ AP_BEF_90 3)) ; Rohrschelle für AP kpl.
|
||||
(setq TM TN)
|
||||
)
|
||||
(command "_copy" (entlast) "" TM TK3)
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
(setq AP_BEF_90 (+ AP_BEF_90 3)) ; Rohrschelle für AP kpl.
|
||||
(if (not (= m_FUSS "NICHTS"))
|
||||
(progn
|
||||
(command "_copy" (entlast) "" TK3 TK4)
|
||||
(ssadd (entlast) auswahl-satz)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun schluss()
|
||||
(IF clay
|
||||
(progn
|
||||
(command "_layer" "_set" clay "")
|
||||
(setvar "BLIPMODE" bmod)
|
||||
(setvar "CMDECHO" 1)
|
||||
(setvar "MENUECHO" mech)
|
||||
(setvar "OSMODE" mosm)
|
||||
(setvar "SNAPMODE" msna)
|
||||
(setvar "ORTHOMODE" mort)
|
||||
(setvar "UCSICON" bksym)
|
||||
(setvar "UCSFOLLOW" ucsf)
|
||||
(setvar "THICKNESS" Z-HOEHE)
|
||||
(setvar "ELEVATION" ERHEB)
|
||||
)
|
||||
)
|
||||
(command "_vports" "_R" "aktiv")
|
||||
(princ)
|
||||
)
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
(defun c:pu1pu2 ( / A B C P1 P2 P3 p4 P5 P6 P7 P8 P9 P10 P11 P12 P13 P14 P15
|
||||
T1 T2 T3 T4 T5 TS1 TS2 TS3 TS4 AUSWAHL-STR UK-SCHIENE UK-GERUEST AB_BEF_90
|
||||
AB_BEF_BOG DRT80_8080 BMOD MOSM MSNA MORT CLAY MECH BKSYM UCSF HOEHE ERHEB BREITE
|
||||
Z-HOEHE)
|
||||
(start)
|
||||
(setq auswahl-ap nil) ; auswahlsatz fuer die Bildung der traeger
|
||||
(prompt "******* SPINNING MODULES - CLEANING STATIONS P1 & P2 *******")
|
||||
(prompt "")
|
||||
(setq UK-SCHIENE 2390)
|
||||
(setq UK-GERUEST 2500)
|
||||
; --- Zaehler für die Ermittlung der Kleinteile
|
||||
; --- Die Kleinteile werden auf D-10 in P0 gesetzt
|
||||
(setq AP_BEF_90 0) ; Rohrschelle für AP kpl. 821114019 - Abhängig von der Länge - pro RT80/80 3 Stück
|
||||
(setq AP_BEF_BOG 5) ; Bogenschelle für AP kpl. 821114028 - am Ende des Moduls
|
||||
(setq DRT80_8080 4) ; ?????????????????????
|
||||
|
||||
(if (null m_SPULEN) (setq m_SPULEN "0")) ; Spulen pro Spulenzug - default: "36"
|
||||
(if (null m_TEILUNG) (setq m_TEILUNG "0")) ; Spulenzugteilung - default: "150"
|
||||
(if (null m_RICHTUNG) (setq m_RICHTUNG "GEGENUHR")) ; Drehrichtung - default: "gegenuhrzeigersinn"
|
||||
(if (null m_FUSS) (setq m_FUSS "ENTGVERB")) ; FUSS
|
||||
(if (null m_ANTRIEB) (setq m_ANTRIEB "1")) ; Reibradantrieb - default: "mit Antrieb" (PU2)
|
||||
(if (null m_GERUEST) (setq m_GERUEST "1")) ; mit Gerüst
|
||||
(if (null m_BEMASS) (setq m_BEMASS "0")) ; keine Bemassung
|
||||
;-------------------------------------------------------------------------------------------------------
|
||||
(Dbox)
|
||||
(datain)
|
||||
(geometrie)
|
||||
(if (= m_BEMASS "1")
|
||||
(bemassung)
|
||||
)
|
||||
(if (= m_ANTRIEB "1")
|
||||
(motor)
|
||||
)
|
||||
(if (= m_GERUEST "1")
|
||||
(structure)
|
||||
)
|
||||
; (mach-block P0 "0" auswahl-satz)
|
||||
; (command "_rotate" "_l" "" P0 pause)
|
||||
; --- Die Kleinteile in 0,0
|
||||
(command "_layer" "_m" "D-10" "_c" "10" "" "")
|
||||
(setq WINKEL 0)
|
||||
(setvar "thickness" 0)
|
||||
(setvar "elevation" 0)
|
||||
; ---- Rohrschelle für AP kpl. (für die geraden Stücke)
|
||||
(command "_insert" (strcat lw "/acadsst/rohr/d_einzel") P0 "" "" (rtos WINKEL))
|
||||
(attribute-aendern "0" "0" "25" "" "" block-kennung "821114019" "Rohrschelle für AP kpl." (rtos AP_BEF_90) "")
|
||||
(setq WINKEL (+ WINKEL 5))
|
||||
; ---- Bogenschelle für AP kpl. (für die Bögenabhängung)
|
||||
(command "_insert" (strcat lw "/acadsst/rohr/d_einzel") P0 "" "" (rtos WINKEL))
|
||||
(attribute-aendern "0" "0" "25" "" "" block-kennung "821114028" "Bogenschelle für AP kpl." (rtos AP_BEF_BOG) "")
|
||||
(setq WINKEL (+ WINKEL 5))
|
||||
; ---- DRT 80 an RT80/80 ????????????????
|
||||
(command "_insert" (strcat lw "/acadsst/rohr/d_einzel") P0 "" "" (rtos WINKEL))
|
||||
(attribute-aendern "0" "0" "25" "" "" block-kennung "?????????" "????????" (rtos DRT80_8080) "")
|
||||
(setq WINKEL (+ WINKEL 5))
|
||||
; ---- ENDE der Einfügug der Kleinteile
|
||||
|
||||
(command "_rotate" auswahl-satz "" P0 pause)
|
||||
(schluss)
|
||||
)
|
||||
@@ -1,70 +0,0 @@
|
||||
# ACADSST – Quelldateien Übersicht
|
||||
|
||||
Originale AutoLISP-Makros aus `M:\ACADSST`, kopiert nach `doc/acadsst/` zur Referenz und Archivierung.
|
||||
Die allgemeingültigen Muster wurden in die Standardbibliotheken unter `Lisp/ssg_*.lsp` überführt.
|
||||
|
||||
---
|
||||
|
||||
## MENU/
|
||||
|
||||
Menü- und Basisroutinen, die von allen anderen Makros genutzt werden.
|
||||
|
||||
| Datei | Beschreibung |
|
||||
|---|---|
|
||||
| `ssg.lsp` | **Kernbibliothek** – Systemvariablen sichern/wiederherstellen (`pstart`/`pend`), Fehlerhandler (`errhan`), Ja/Nein-Dialog (`ques`), Fehlermeldung mit Ton (`emsg`). Block aus Auswahlsatz erzeugen und einfügen (`block-op`, `mach-block`, `mach-block-ohne-prop`). Eindeutigen Blocknamen aus Position + Zeitstempel generieren (`bl-name`). Attribute eines Blocks ändern – einzeln (`ATTRIBUTE-AENDERN`, `ATTRIBUTE-AENDERN_IO`) und über Entity-Handle mit Suche durch die DB (`suchen-aendern`, `obj-suchen`, `einzel-attr-aendern`). Block-Hilfsfunktionen für Symbole mit/ohne Drehung und Skalierung (`c:symplac`, `c:sympl_dr`, `c:sympldr2`, `c:sympldr1`, `c:sym_scal`). Farbe eines Auswahlsatzes interaktiv ändern (`c:alt_farb`). |
|
||||
| `laymr14.lsp` | **Layer-Manager** – Interaktive Layer-Operationen über das Screen-Menü: Layer eines Objektes ermitteln (`alay`), Auswahlsatz nach Layer+Typ filtern (`alel`). Layer ein- und ausschalten, einfrieren/auftauen (`lays`). Objekte auf anderen Layer verschieben oder kopieren, alle Objekte eines Typs auf einem Layer verschieben (`laymanag` Selektoren 4–7). Layernamen für Gruppen-Umbenennung berechnen (`lann`, `laqu`). Layer-Gruppenoperationen (Ein/Ausschalten, Löschen, Auswahlsatz erzeugen) über Gruppenkennung (`lgrn`). Layer-Liste im Screen-Menü blättern (`ldis`). |
|
||||
| `ssg.lsp` (alt) | Ältere Versionen des Menüsystems (`ssg_110617.lsp`, `ssg_130829.lsp`, `ssg_old.lsp`) – nur zur Referenz, nicht produktiv verwenden. |
|
||||
|
||||
---
|
||||
|
||||
## ILS2100/
|
||||
|
||||
Makros für das ILS 2100-Hängefördersystem (Aluminium-Schienensystem). Alle Dateien folgen demselben Dialog-Pattern: DCL laden → Vorschaubild je Auswahl → Block einfügen → Attribute setzen → Baugruppe als Block zusammenfassen.
|
||||
|
||||
| Datei | Beschreibung |
|
||||
|---|---|
|
||||
| `ils_ae_elem.lsp` | **AS/ES-Elemente** – Antriebsstationen (AS) links/rechts und Endstationen (ES) links/rechts, jeweils mit Bosch- oder SMC-Pneumatik-Satz. AS-Elemente werden als Baugruppe (`mach-block`) mit dem zugehörigen Pneumatik-Einzelteil zusammengefasst. Dialog mit Vorschaubild je Variante. Befehl: `c:ILS_AE_ELEM`. |
|
||||
| `ils_anbau_str.lsp` | **Separatoren/Stopper** – Separator Einfach-Hub (links/rechts) und Doppel-Hub in Gefällestrecke (links/rechts-Sonder). Konfigurierbar: Pneumatik-Typ (Bosch/SMC), Abhängung (an Monster-Profil LP, an LP mit/ohne PIN), Anbau-Baugruppe für Doppel-Hub. Befehl: `c:ILS_ANBAU_STR`. |
|
||||
| `ils_angebot.lsp` | **Angebot-Modul** – Vereinfachte Angebotszeichnung der ILS-Komponenten (Antrieb 800/300, Spannstation 800/300, Umlenkstation, AS/ES links/rechts, Separator, Gefällestrecke, Scanner, Be-/Entladung u.a.). Geringere Detailtiefe als die Werkstattmakros. Befehl: `c:ILS_ANGEBOT`. |
|
||||
| `ils_angebot_module.lsp` | **Angebotsmodule** – Ergänzung zu `ils_angebot.lsp` für weitere vereinfachte Modultypen in der Angebotsphase. |
|
||||
| `ils_sensor.lsp` | **Sensoren/Automation** – Einfügen von Sensor-Blöcken (Lichtschranken, Initiatoren) auf den Layer `ILS-AUTOMATION`. Fünf Varianten via Dialog. Befehl: `c:ILS_SENSOR`. |
|
||||
| `ils_verb_str.lsp` | **Verbindungsstrukturen** – Verbindungs- und Strukturelemente (Profilverbinder, Winkelverbinder, Abhängungen) auf Layer `ILS-COMPONENTS`. Sieben Varianten via Dialog. Befehl: `c:ILS_VERB_STR`. |
|
||||
|
||||
---
|
||||
|
||||
## HFS/
|
||||
|
||||
Makros für das HFS-Hängefördersystem (höhenverstellbares Fördersystem).
|
||||
|
||||
| Datei | Beschreibung |
|
||||
|---|---|
|
||||
| `hfs_mod.lsp` | **HFS-Module** – Einfügen von HFS-Modulen (KM-Light, KM 3000, KM 5000, Hochlift, 2-Way-Modul, Hochlift-TUP, HP-Sort II) auf Layer `H-2`. Dialog mit Vorschau-Slide je Modul. Befehl: `c:HFS_MOD`. |
|
||||
|
||||
---
|
||||
|
||||
## Spinnerei/alt/
|
||||
|
||||
Ältere Makros für Spinnerei-Anlagen (Putzstationen). Nur zur Referenz archiviert.
|
||||
|
||||
| Datei | Beschreibung |
|
||||
|---|---|
|
||||
| `pu1pu2.lsp` | **Putzstationen PU1/PU2** – Komplexes Makro für Reibradangetriebene Putzstationen (PU2 = mit Antrieb, PU1 = ohne). Konfigurierbar: Spulenanzahl, Teilung (150/165 mm), Drehrichtung (Uhr/Gegenuhr), Fuß-Konfiguration (zurück, entgegen, verbunden, ohne). Optional: Gerüst (2″-Säulen, RT 80/80, DRT 80), Motor (RA1/RA2), Bemaßung. Zählt automatisch Kleinteile (Rohrschellen, Bogenschellen). Befehl: `c:PU1PU2`. |
|
||||
|
||||
---
|
||||
|
||||
## Gemeinsame Muster (Grundlage für `Lisp/ssg_*.lsp`)
|
||||
|
||||
Alle Makros teilen diese wiederkehrenden Muster, die in die Standardbibliotheken überführt wurden:
|
||||
|
||||
| Muster | Quelle | Standardbibliothek |
|
||||
|---|---|---|
|
||||
| Systemvariablen sichern/wiederherstellen | `ssg.lsp` `pstart`/`pend`, `pu1pu2.lsp` `start`/`schluss` | `ssg_core.lsp` → `ssg-start`/`ssg-end` |
|
||||
| Fehlerhandler mit Aufräumen | `ssg.lsp` `errhan` | `ssg_core.lsp` → `ssg-errhan` |
|
||||
| Ja/Nein-Abfrage | `ssg.lsp` `ques` | `ssg_core.lsp` → `ssg-ques` |
|
||||
| Attribute setzen (nach INSERT) | `ssg.lsp` `ATTRIBUTE-AENDERN` | `ssg_core.lsp` → `ssg-attrib-set`, `ssg-attrib-set-many` |
|
||||
| Attribut per Handle suchen | `ssg.lsp` `suchen-aendern` | `ssg_core.lsp` → `ssg-attrib-by-handle` |
|
||||
| Eindeutiger Blockname (Pos + Zeit) | `ssg.lsp` `bl-name` | `ssg_core.lsp` → `ssg-make-blockname` |
|
||||
| Block aus Auswahlsatz erzeugen | `ssg.lsp` `mach-block` | `ssg_core.lsp` → `ssg-make-block` |
|
||||
| Layer anlegen und aktivieren | alle ILS2100-Dateien | `ssg_core.lsp` → `ssg-make-layer` |
|
||||
| DCL-Dialog mit Vorschaubild | alle ILS2100-Dateien | `ssg_dialog.lsp` → `ssg-dia-show-slide`, `ssg-modul-dialog` |
|
||||
| Layer-Operationen interaktiv | `laymr14.lsp` | `ssg_layer.lsp` → `c:SSG-Layer*` |
|
||||
Reference in New Issue
Block a user