Közzéteszek néhány AutoLisp programkódot, amelyek talán hasznosak lehetnek azok számára, akik
most ismerkednek az AutoLisppel. A profik meg úgysem itt kutakodnak, hogy élcelődhessenek a
megoldások gyengéin.
A programkódok a leírások végén található
letöltés címkéjű linkre kattintva menthetők el legegyszerűbben a saját gépre.
Hálás lennék, ha azok, akik valamelyik programkódot letöltik és használatba veszik, erről
a honlap Üzenő-füzet oldalán
értesítenének. Ennek nem csak az egóm pátyolgatása lenne a szerepe, hanem egy kis reklámot
is jelentene személyemnek és az oldalnak.
Azoknak a programkódoknak a felhasználásakor, amelyekben szerepel
(vla- ...),
(vlax- ...) függvényhívás,
a programfájl elején el kell helyezni a
(vl-load-com) utasítást.
Néhányuk hivatkozik az AutoCAD -hoz tartozó
ai_utils.lsp fájlban definiált függvényekre is.
Nagyon hálás lennék, ha a felhasználók az alábbi kódok használata során tapasztalt hibákról és hiányosságokról
e-mail -ben,
vagy az
üzenő-füzet
oldalon értesítenének.
2010. 08. 28.
AutoLisp konfigurációs adatok tárolása DWG-ben, egy saját szótárban
Ha olyan Autolisp programot írunk, amelynek számos, az egyes DWG állományokban többnyire eltérő értéket tartalmazó beállítása van, például
bemenő vagy kimenő adatok alpértelmezett keresési útvonalai, a program, vagy részprogramjai működését állományonként befolyásoló
beállítások, akkor célszerű azokat az állományban elmenteni, és az állomány későbbi megnyitásai során onnét kiolvasni, hogy megkíméljük
a felhasználót azok többszöri megadásától.
Adataink tárolására az AutoCAD szótár (Dictionary) objektuma a legalkalmasabb, mégpedig egy saját szótár, hogy ne szemeteljünk
az AutoCAD által is használt szótárakba (pld.: NamedObjDict).
Az alábbi AutoLisp függvényekben
"PF-GEO_config" a saját szótár neve. Ha használatba veszi valaki a függvényeket, írja a
helyére az általa favorizált szótárnevet.
A
geo_config_ki AutoLisp függvény az adatok szótárba írására szolgál. Hívása például a következőképpen történhet:
(geo_config_ki
(list
(list "dig_ortho" (getvar "orthomode"))
(list "bekotes" bekotes)
(list "metszes" metszes)
(list "dig_tipus" dig_tipus)
(list "ivdig_hur" ivdig_hur)
(list "ivtures" (if (equal (type ivtures) 'REAL) ivtures 0.05))
(list "metszo_list" ki_list)
)
)
(DEFUN geo_config_ki (tetelek / cnfq_ki akt_tetel_ki)
;A TETELEK paraméter egy lista. Allistákból áll, amelyeknek első eleme a tétel azonosítója,
; a második pedig a tétel aktuálissá tenni kívánt értéke.
; A tételazonosító mindig a tétel értékét a programban tároló változó neve idézőjelek között.
;
;---- Például: (...("mtmag" 132.342 ) ("vetulet" 3 ) ... ("teng_red" T ) ...)
(foreach akt_tetel_ki tetelek
(vlax-ldata-put "PF-GEO_config" (car akt_tetel_ki) (cadr akt_tetel_ki))
)
;---- A kiírt adatok legyenek aktuálisak az autolisp változókban:
(geo_config_be tetelek)
(princ)
)
A
geo_config_be AutoLisp függvény az adatok szótárból való kiolvasására szolgál. Hívása például a következőképpen történhet:
(geo_config_be
(list
(list "dig_ortho" 0)
(list "bekotes" T)
(list "metszes" nil)
(list "dig_tipus" 1)
(list "ivdig_hur" 0)
(list "ivtures" 0.05)
(list "metszo_list" nil)
)
)
(DEFUN geo_config_be (tetelek / cnfq_be akt_tetel_be cfg_list tetel)
; A TETELEK lista a tételek azonosítóiból és alapértelmezett értékeiből álló allistákból épül fel,
; amelyekben az azonosító mindig a tétel értékét a programban tároló változó neve idézőjelek között.
; Ha egy tétel még nem létezik, akkor az alapértelmezett értékkel létre hozza, és azzal vissza is adja.
;
;---- Például: (...("mtmag" 100.000 ) ("vetulet" 1 ) ... ("teng_red" nil ) ...)
(setq cfg_list (vlax-ldata-list "PF-GEO_config"))
(foreach akt_tetel_be tetelek
(if (setq tetel (assoc (car akt_tetel_be) cfg_list))
;---- Van ilyen konfigurációs tétel. Letároljuk az adatot a változóban.
(put (car tetel) (cdr tetel))
;---- Nincs ilyen konfigurációs tétel.
(progn
;---- Létrehozzuk:
(vlax-ldata-put "PF-GEO_config" (nth 0 akt_tetel_be) (nth 1 akt_tetel_be))
;---- Aktuálisá tesszük az autolisp változóban:
(set (read (nth 0 akt_tetel_be)) (nth 1 akt_tetel_be))
)
)
)
(princ)
)
A
pfgeoconfigpurge AutoLisp parancsfüggvény a saját szótár törlésére szolgál. Akkor szokás használni ha a DWG állományt
átadjuk a megrendelőnek, mert nem illendő dolog a további felhasználás során felesleges adatokat az állományban hagyni.
(defun c:pfgeoconfigpurge ()
;---- Törli az állományból a PF-GEO kiegészítések által tárolt konfigurációs adatokat.
;---- Törli a "PF-GEO-XDATA" regisztrált alkamazásnevet is.
(new_dialog "igen_nem" geo_dcl_id "" dia_bp_retv)
(set_tile "igen_nem" "Valóban törölni akarja?")
(start_dialog)
(if (= igen_nem 1)
(progn
(dictremove (namedobjdict) "PF-GEO_config")
(vlax-for appid (vla-get-registeredapplications
(vla-get-activedocument (vlax-get-acad-object)))
(if (= (vla-get-name appid) "PF-GEO-XDATA")
(vl-catch-all-apply 'vla-delete (list appid))
)
)
(princ "\n***** PF-GEO kiegészítések konfigurációs adatai törölve. *****")
)
)
(princ)
)
A fenti függvények által használt
put AutoLisp segédfüggvény:
(defun put (nev adat / )
;---- Beállítja a 'NEV' nevű változó értékét ADAT-ra.
(set (read nev) adat)
)
Globális AutoLisp konfigurációs adatok tárolása fájlban
Autolisp programjaink globális (Bármely DWG állomány használatakor érvényes) beállítási adatait fájlban
célszerű letárolni. Mivel AutoLispben igen hatékonyan lehet listákat kezelni, célszerű, ha adatainkat
listaként mentjük és olvassuk vissza.
A mentett lista három szintű:
;főlista
'(
(kulcszó1
(változó11 érték11)
(változó12 érték12)
.
.
.
(változó1N érték1N)
)
.
.
.
(kulcszóN
(változóN1 értékN1)
(változóN2 értékN2)
.
.
.
(változóNN értékNN)
)
)
Ez az adatszerkezet logikailag ugyanaz, mint a számos windows-os program által használt text formátumú ini fájlok adatszerkezete.
Az alábbi AutoLisp függvényekben
"pfgeo.ini" a beállításokat tároló fájl neve. Ha használatba veszi
valaki a függvényeket, írja a helyére a számára megfelelő fájlnevet.
A
pfgeo_ini_ki AutoLisp függvény az adatok fájlba írására szolgál. Hívása a (defun ...) előtti kommentekben
látható példa szerint történhet:
;(setq alama "zöld" körte "sárga" szilva "kék")
;(pfgeo_ini_ki "gyümölcsszínek" (list "alma" "körte" "szilva"))
(defun pfgeo_ini_ki ( funkcio adatok / pfgeo_ini adat)
(setq result nil)
(if (findfile (strcat progutv "pfgeo.ini"))
(setq pfgeo_ini (load (strcat progutv "pfgeo.ini")))
(setq pfgeo_ini nil)
)
(setq allista nil)
(foreach adat adatok
(setq allista (append allista (list (list adat (eval (read adat))))))
)
(if (setq old_allista (assoc funkcio pfgeo_ini))
(setq pfgeo_ini (subst (list funkcio allista) old_allista pfgeo_ini))
(setq pfgeo_ini (append pfgeo_ini (list (list funkcio allista))))
)
(if (setq fazon (open (strcat progutv "pfgeo.ini") "w"))
(progn
(princ "'" fazon)
(print pfgeo_ini fazon)
(close fazon)
(setq result T)
)
(setq result nil)
)
)
A
pfgeo_ini_be AutoLisp függvény az adatok beolvasására szolgál. Hívása a (defun ...) előtti kommentben
látható példa szerint történhet:
;(pfgeo_ini_be "gyümölcsszínek" '(("alma" "?") ("körte" "?") ("szilva" "?")))
(defun pfgeo_ini_be (funkcio adatok / pfgeo_ini adat allista tetel result)
(setq result nil)
(if (findfile (strcat progutv "pfgeo.ini"))
(setq pfgeo_ini (load (strcat progutv "pfgeo.ini")))
(progn
(foreach adat adatok
(set (read (car adat)) (cadr adat))
)
)
)
(if (setq allista (cadr (assoc funkcio pfgeo_ini)))
(foreach adat adatok
(if (setq tetel (assoc (car adat) allista))
(progn
(set (read (car tetel)) (cadr tetel))
(setq result (append result (list (list (car tetel) (cadr tetel)))))
)
(progn
(set (read (car adat)) (cadr adat))
(setq result (append result (list adat)))
)
)
)
)
result
)
A fenti függvényben használt
progutv változó az AutoLisp program telepítési könyvtárát tartalmazza.
Az általam megírt programokat mindig az AutoCAD telepítési könyvtárának (Az a könyvtár amelyben az
acad.exe fájl található)
pf-prg alkönyvárának további
alkönyvtáraiban szoktam elhelyezni. Így például a
geo alkönyvtárban elhelyezett program telepítési
könyvtárát a következő AutoLisp kóddal szoktam letárolni a
progutv változóban:
;Az ACADUTV változó az AutoCAD telepítési könyvtárát fogja tertalmazni.
;----------------------------------------------------------------------
(vl-load-com)
(setq acadutv (strcat (vla-get-path (vlax-get-acad-object)) "\\"))
(princ (strcat "\n AutoCAD könyvtár: " acadutv "\n"))
;A progutv változó a GEO program telepítési könyvtárát fogja tartalmazni.
;----------------------------------------------------------------------
(setq progutv (strcat acadutv "pf-prg\\geo\\"))
(princ (strcat "\n Program könyvtár: " acadutv "\n"))
Természetesen az
acadutv és
progutv változókat nem csak az
ini fájl helyének megadására
használom, hanem még számos olyan esetben, amikor ezekben a könyvtárakban kell valamit elérni.
Lényeges, hogy ez a kód a programfájlban a rá hivatkozó utasítások előtt szerepeljen, ezért célszerű a programfájl
elejére beilleszteni.
Néhány AutoLisp függvény változók kezeléséhez
(defun @swap (*v1 *v2 / qwer)
;---- Felcseréli a *v1 *v2 paraméterekben megkapott nevű változók értékeit.
;---- Hívása: (@svap 'valtozonev1 'valtozonev2)
(set 'qwer (eval *v2))
(set *v2 (eval *v1))
(set *v1 qwer)
)
;
;
(defun get (nev / )
;---- Visszaadja a 'NEV' nevű változó értékét.
;---- Hívása: (get "változónév")
(eval (read nev))
)
;
;
(defun put (nev adat / )
;---- Beállítja a 'NEV' nevű változó értékét ADAT-ra.
;---- Hívása: (put "váltózonév")
(set (read nev) adat)
)
AutoLisp függvények rajzelem adatok lekérdezéséhez
(DEFUN c:relem ()
;---- Bemutatott rajzelem elemazonosítója az ELEM -ben,
;---- elemlistája az ELEML -ben és visszatérési értékként:
(print (setq eleml (entget (setq elem (car (entsel))))))
(princ)
)
;
;
(DEFUN c:brelem ()
;---- Bemutatott beágyazott rajzelem elemazonosítója az ELEM -ben,
;---- elemlistája az ELEML -ben és visszatérési értékként:
(print (setq eleml (entget (setq elem (car (nentsel))))))
(princ)
)
;
;
(defun c:dump ( / )
;---- Bemutatott rajzelem objektumtulajdonságainak lekérdezése.
(while (setq elem (entsel "\nVálassz rajzelemet: "))
(setq elem (car elem)
eleml (entget elem)
obj (vlax-ename->vla-object elem)
)
(vlax-dump-object obj T)
(vlax-release-object obj)
)
(princ)
)
;
;
(defun c:bdump ( / )
;---- Bemutatott beágyazott rajzelem objektumtulajdonságainak lekérdezése.
(while (setq elem (nentsel "\nVálassz rajzelemet: "))
(setq elem (car elem)
eleml (entget elem)
obj (vlax-ename->vla-object elem)
)
(vlax-dump-object obj T)
(vlax-release-object obj)
)
(princ)
)
Néhány az AutoLisp -ben nem szereplő szögfüggvény
(DEFUN tang (szog / )
;---- Túlcsordulásmentes tangens függvény
;---- Radiánban megadott SZOG tangense:
(/ (sin szog) (if (/= szog 0.0) (cos szog) 1e-99))
)
;
;
(DEFUN asin (szam / )
;---- A SZAM arkusz sinusa:
(atan (/ szam (sqrt (- 1.0 (* szam szam)))))
)
;
;
(DEFUN acos (szam / )
;---- A SZAM arkusz cosinusa:
(atan (/ (sqrt (- 1.0 (* szam szam))) szam))
)
Egy kis matek Autolisp alatt
(defun sign (szam / )
;---- Előjelfüggvény:
(cond
((> szam 0) 1)
((= szam 0) 0)
((< szam 0) -1)
)
)
;
;
(defun integer (valos / )
;---- Integerként adja vissza a VALOS -ban átvett lebegőpontos számértéket.
(atoi (+ (rtos valos 2 16) 1E-8))
)
;
;
(defun dec_hex (dec / hex hany kilep)
;---- Decimális - hexadecimális konverzió:
(setq hex "" kilep nil)
(while (not kilep)
(setq hany (/ dec 16)
hex (strcat (substr
"0123456789ABCDEF"
(+ (- (fix dec) (* (fix hany) 16)) 1)
1
)
hex
)
dec (fix hany)
kilep (if (= dec 0.0) T nil)
)
)
hex
)
;
(defun hex_dec (hex / )
;---- Hexadecimális - decimális konverzió:
(setq dec 0.0 hex (strcase hex nil) kit (- (strlen hex) 1))
(while (>= kit 0)
(setq dec (+ dec
(*
(vl-string-position
(ascii (substr hex (- (strlen hex) kit) 1))
"0123456789ABCDEF"
0
nil
)
(expt 16 kit)
)
)
kit (1- kit)
)
)
dec
)
Átváltások radián és különböző 360-as szögformátumok között AutoLisp alatt
(DEFUN rad_fok ( radian / )
;---- Az AUNITS értékétől függően FOKdPERC'MASODPERC" vagy tizedes fok
;---- alakban adja vissza a RADIAN paraméterben átvett szögértéket. STRING -ként.
;---- Így lehet például a (getang...) függvénnyel megkapott szögértéket átadni egy a
;---- (command ...) függvénnyel elindított parancs paraméterébe.
(if (= (getvar "aunits") 0)
(angtos radian 0 18)
(angtos radian 1 18)
)
)
;
;
(DEFUN rad_e_tiz ( radian / )
;---- Előjeles tizedes fok alakban adja vissza a RADIAN paraméterben átvett szögértéket.
(setq radian (if (> (sign radian) 0.0)
(atof (angtos radian 0 18))
(- (atof (angtos radian 0 18)) 360.0)
)
)
)
;
;
(DEFUN rad_i_tiz ( radian / )
;---- Előjel nélküli tizedes fok alakban adja vissza a RADIAN paraméterben átvett szögértéket.
(atof (angtos radian 0 18))
)
;
;
(DEFUN altiz_tiz (altiz / q)
;---- Áltizedestört formátumban megadott irány vagy
;---- szögérték konvertálása tizedes fok formátumba:
(setq q (sign altiz) altiz (abs altiz))
(* (+ (fix (+ altiz 1e-8))
(/ (fix (* (- (+ altiz 1e-8) (fix (+ altiz 1e-8))) 100.0)) 60.0)
(/
(* (- (* (+ altiz 0.0) 100.0) (fix (* (+ altiz 1e-8) 100.0))) 100.0)
3600.0
)
)
q
)
)
;
;
(DEFUN tiz_rad (tiz / )
;---- Tizedes fok mértékegységű irány vagy
;---- szögérték konvertálása radiánba:
(* (/ tiz 360.0) (* pi 2.0))
)
;
;
(DEFUN altiz_rad (altiz / q )
;---- Áltizedestört formátumban megadott irány vagy
;---- szögérték konvertálása radián mértékegységbe:
(setq q (sign altiz) altiz (abs altiz))
(* (/ (+ (fix (+ altiz 1e-8))
(/ (fix (* (- (+ altiz 1e-8) (fix (+ altiz 1e-8))) 100.0)) 60.0)
(/
(* (- (* (+ altiz 0.0) 100.0) (fix (* (+ altiz 1e-8) 100.0))) 100.0)
3600.0
)
)
360.0
)
(* pi 2.0)
q
)
)
;
;
(DEFUN rad_altiz (rad / q fok perc mperc cc)
;---- Radián mértékegységben megadott irány, vagy
;---- szögérték konvertálása áltizedestört formátumba:
(setq q (sign rad)
mperc (abs (/ (* rad 1296000.0) (* pi 2.0)))
fok (fix (/ mperc 3600.0))
perc (fix (/ (- mperc (* fok 3600.0)) 60.0))
mperc (- mperc (* fok 3600.0) (* perc 60.0))
cc (if (> mperc 59.5) (setq perc (1+ perc) mperc 0.0))
cc (if (> perc 59.5) (setq fok (1+ fok) perc 0.0))
cc (if (> fok 359.5) (setq fok 0.0))
rad (* (+ fok (/ perc 100.0) (/ mperc 10000.0)) q)
)
)
Menük, eszköztárak kezelése AutoLisp alatt
(defun Tb_on (csop nev / )
;---- Megjeleníti a CSOP menücsoporthoz tartozó NEV nevű toolbart.
(vla-put-visible
(vla-item
(vla-get-toolbars
(vla-item
(vla-get-menugroups
(vlax-get-acad-object)
)
csop
)
)
nev
)
:vlax-true
)
)
;
;
(defun Tb_off (csop nev / )
;---- Elrejti a CSOP menücsoporthoz tartozó NEV nevű toolbart.
(vla-put-visible
(vla-item
(vla-get-toolbars
(vla-item
(vla-get-menugroups
(vlax-get-acad-object)
)
csop
)
)
nev
)
:vlax-false
)
)
;
;
(defun Tbnames (csop / )
;---- Megjeleníti a CSOP menücsoporthoz tartozó TOOLBAR -ok neveit a parancssorban
(setq tbars
(vla-get-toolbars
(vla-item
(vla-get-menugroups
(vlax-get-acad-object)
)
csop
)
)
)
(vlax-for tbar tbars
(princ (strcat "\n" (vla-get-name tbar)))
)
(princ)
)
;
;
(defun Mnnames (csop / menuk menu)
;---- Megjeleníti a CSOP menücsoporthoz tartozó Menük neveit a parancssorban
(setq menuk
(vla-get-Menus
(vla-item
(vla-get-menugroups
(vlax-get-acad-object)
)
csop
)
)
Menu-nevek nil
)
(vlax-for menu menuk
(setq Menu-nevek (append Menu-nevek (list (vla-get-name menu))))
)
)
;
;
(defun Mnitem-names (csop mname / menu sor)
;---- Megjeleníti a CSOP menücsoporthoz tartozó MNAME nevű menü elemeinek neveit a parancssorban.
;---- Az Item-indexek listában megjelennek a menüelemek indexei.
;---- Az Item-makrok listában megjelennek a menüelemek makrói.
;---- Az Item-nevek listában megjelennek a menüelemek nevei.
(setq menu
(vla-item
(vla-get-Menus
(vla-item
(vla-get-menugroups
(vlax-get-acad-object)
)
csop
)
)
mname
)
Item-nevek nil
Item-makrok nil
Item-indexek nil
)
(vlax-for sor menu
(setq Item-indexek (append Item-indexek (list (vla-get-index sor)))
Item-makrok (append Item-makrok (list (vla-get-macro sor)))
Item-nevek (append Item-nevek (list (vla-get-caption sor)))
)
)
)
;
;
(defun Tbitem-names (csop tname / )
;---- Megjeleníti a CSOP menücsoporthoz tartozó TNAME nevű toolbar elemeinek neveit a parancssorban.
(setq tbar
(vla-item
(vla-get-toolbars
(vla-item
(vla-get-menugroups
(vlax-get-acad-object)
)
csop
)
)
tname
)
)
(vlax-for button tbar
(princ (strcat "\n" (vla-get-name button)))
)
(princ)
)
;
;
(defun Tbitem-names-list (csop tname / tbitemnames tbar button)
;---- Megjeleníti a CSOP menücsoporthoz tartozó TNAME nevű toolbar elemeinek neveit a tbitemnames listában.
(setq tbar
(vla-item
(vla-get-toolbars
(vla-item
(vla-get-menugroups
(vlax-get-acad-object)
)
csop
)
)
tname
)
tbitemnames nil
)
(vlax-for button tbar
(setq tbitemnames (cons (vla-get-name button) tbitemnames))
)
(setq tbitemnames (reverse tbitemnames))
)
;
(defun Tbitem-index (csop tname bname / )
; Visszadja a CSOP menücsoport TNAME nevű eszköztára BNAME nevű buttonjának indexét.
(vl-position bname (Tbitem-names-list csop tname))
)
;
;
(defun Set-TbIcon (menu toolbar button kicsi nagy / )
;---- A MENU nevű menücsoport TOOLBAR nevű eszköztárának BUTTON azonosítójú
;---- eleméhez a KICSI és NAGY -ban megadot bitképeket rendeli hozzá.
;---- A bitképeknek az AutoCAD SUPPORT alkönyvtárában kell lenniük.
(vla-setbitmaps
(vla-item
(vla-item
(vla-get-toolbars
(vla-item
(vla-get-menugroups
(vlax-get-acad-object)
)
menu
)
)
toolbar
)
button
)
(strcat acadutv "support\\" kicsi)
(strcat acadutv "support\\" nagy)
)
)
;
;
; A fenti függvényben használt acadutv változó az
; AutoCAD program telepítési könyvtárát tartalmazza.
; Az általam megírt programokat mindig az AutoCAD telepítési könyvtárának
; (Az a könyvtár amelyben az acad.exe fájl található) ;pf-prg
; alkönyvárának további alkönyvtáraiban szoktam elhelyezni. Így például a
; geo alkönyvtárban elhelyezett program telepítési könyvtárát a
; következő AutoLisp kóddal szoktam letárolni a progutv változóban:
;Az ACADUTV változó az AutoCAD telepítési könyvtárát fogja tertalmazni.
;----------------------------------------------------------------------
(vl-load-com)
(setq acadutv (strcat (vla-get-path (vlax-get-acad-object)) "\\"))
(princ (strcat "\n AutoCAD könyvtár: " acadutv "\n"))
; A progutv változó a GEO program telepítési könyvtárát fogja tartalmazni.
;----------------------------------------------------------------------
(setq progutv (strcat acadutv "pf-prg\\geo\\"))
(princ (strcat "\n Program könyvtár: " acadutv "\n"))
Blokk attribútumok kezelése AutoLisp alatt
(defun blokk_attributumNEV_lista (blokknev / elem eleml result)
;---- Visszatérési érték a BLOKKNEV nevű blokkdefiníció előre definiált attribútumai neveinek listája.
(setq result '())
(if (setq elem (tblobjname "BLOCK" blokknev))
(progn
(while (setq elem (entnext elem))
(setq eleml (entget elem))
(if (equal (cdr (assoc 0 eleml)) "ATTDEF")
(setq result (append result (list (cdr (assoc 2 eleml)))))
)
)
)
)
result
)
;
;
(defun blokk_attributumELIST_lista (blokknev / elem eleml result)
;---- Visszatérési érték a BLOKKNEV nevű blokkdefiníció előre definiált attribútumai elemlistáinak listája.
(setq result '())
(if (setq elem (tblobjname "BLOCK" blokknev))
(if (logand 2 (cdr (assoc 70 (entget elem))))
(while (setq elem (entnext elem))
(if (= (cdr (assoc 0 (entget elem))) "ATTDEF")
(setq result (append result (list (entget elem))))
)
)
)
)
result
)
;
;
(defun blokkref_attributum_ertek_lista (i_elem / eleml result)
;---- Visszatérési érték az I_ELEM elemazonosítójú blokkreferencia attributumai értékeinek listája.
(setq result '())
(if i_elem
(if (and (equal (cdr (assoc 0 (entget i_elem))) "INSERT")
(> (cdr (assoc 66 (entget i_elem))) 0 )
)
(progn
(while
(not
(equal
(cdr (assoc 0 (setq eleml (entget (setq i_elem (entnext i_elem))))))
"SEQEND"
)
)
(if (equal (cdr (assoc 0 eleml)) "ATTRIB")
(setq result (append result (list (cdr (assoc 1 eleml)))))
)
)
)
)
)
result
)
;
;
(defun blokkref_attributum_ertek (i_elem i_nev / eleml result)
;---- Visszatérési érték az I_ELEM elemazonosítójú blokkreferencia I_NEV címkéjű attributumának értéke.
(setq result nil)
(if (and i_elem i_nev)
(if (and (equal (cdr (assoc 0 (entget i_elem))) "INSERT")
(> (cdr (assoc 66 (entget i_elem))) 0 )
)
(progn
(while
(not
(equal
(cdr (assoc 0 (setq eleml (entget (setq i_elem (entnext i_elem))))))
"SEQEND"
)
)
(if (and (equal (cdr (assoc 0 eleml)) "ATTRIB")
(equal (strcase (cdr (assoc 2 eleml))) (strcase i_nev))
)
(setq result (cdr (assoc 1 eleml)))
)
)
)
)
)
result
)
;
;
(defun blokkref_attributum_beirasa (i_elem i_nev i_ertek / eleml result)
;---- Az I_ELEM elemazonosítójú blokkreferencia I_NEV címkéjű attributumában letárolja az I_ERTEK -ben átvett szöveget.
;---- Visszatérési érték az átvett attribútumérték vagy hiba esetén nil.
(setq result nil)
(if (and i_elem i_nev i_ertek)
(if (and (equal (cdr (assoc 0 (entget i_elem))) "INSERT")
(> (cdr (assoc 66 (entget i_elem))) 0 )
)
(progn
(while
(not
(equal
(cdr (assoc 0 (setq eleml (entget (setq i_elem (entnext i_elem))))))
"SEQEND"
)
)
(if (and (equal (cdr (assoc 0 eleml)) "ATTRIB")
(equal (cdr (assoc 2 eleml)) i_nev)
)
(if (entmod (subst (cons 1 i_ertek) (assoc 1 eleml) eleml))
(setq result (entupd i_elem)
result i_ertek
)
(setq result nil)
)
)
)
)
)
)
result
)
2010. 09. 04.
Blokreferenciák beillesztése papírtéri elrendezésből
Kifejezetten elégedetlen vagyok az AutoCAD által blokkok beillesztésére kínált lehetőségekkel.
Az
INSERT parancs AutoCAD -es megoldása manapság már a felhasználók megsértésének tűnik.
A
Design Center sem igazán hatékony az olyan feladatoknál, amelyeknél az állományokban
blokkok százai vannak definiálva, és töméntelen beillesztett példányukat kell létrehozni.
Márpedig az én tevékenységi körömben szinte mindig ez a jelemző.
Ezért valósítotam meg eddigi AutoCAD buherátori pályafutásom alatt három különböző speciális
blokk beillesztési szisztémát. Egyet csak AutoLisp -ben, kettőt pedig együttműködő AutoLisp
és Delphi programokkal. Az elsőnek és az utóbbiak egyikének leírása megtalálható a letölthető
AutoCAD-PFgeo súgó
-ban.
Tegnap felötlött bennem egy negyedik megoldási lehetőség, és nem tudtam ellenállni a csábításnak,
rögtön meg is írtam. Persze lehet, hogy ismét a spanyolviaszt találtam fel, de nekem még nem volt
szerencsém találkozni ilyen jellegű megoldással.
Az ötlet lényege az, hogy egy a programkódban rögzített nevű papírtéri elrendezésben, elhelyezzük
a program által kezelendő blokkok egy-egy beillesztett példányát (
INSERT objektumok). Ha a
programot elindítjuk, az megvizsgálja a létező elrendezéseket, és ha talál a kódban megadott nevűt,
azt aktuálissá teszi, és felkéri a felhasználót, hogy válassza ki a beilleszteni kívánt blokkot.
Ha a júzer választ blokkot, annak nevét egy változóban letárolja, visszavált az eredeti elrendezésre,
és végrehajtja a blokk beillesztéséhez szükséges lépéseket.
A program úgy van megoldva. hogy nem csak blokkreferenciákat, hanem a blokkok neveit tartalmazó szövegeket
(
TEXT rajzelemek) kiválasztva is működjön. A felhasználó gusztusa szerint választhatja a számára
megfelelőbb megoldást.
Annak érdekében, hogy a kiválasztáskor esetleg eltolt, átzoomolt elrendezés a program következő hívásakor
a felhasználó által kívánt tartalommal jelenjen meg, a felhasználó elhelyezhet a blokkok kiválasztására
szolgáló elrendezésben egy derékszögű négyszög alakú 3D vonalláncot (
POLYLINE rajzelem), amely az
általa alapértelmezetten megjeleníteni kívánt ablakot foglalja magában. A program ezután minden hívásakor
rázoomol erre az ablakra.
persze még más képességekkel is fel lehetne ruházni. Például azzal, hogy valamilyen feltételtől, például
az aktuális fóliától függően más-más papírtéri elrendezésben elhelyezett blokkreferenciákat lehessen
kiválasztani. Automatikusan létrehozhatná a működéséhez szükséges papírtéri elrendezéseket és azok
tartalmát is.
A szisztéma nem csak blokkok kiválasztására lehet alkalmas. A jelenlegi megvalósításából is kitűnik,
hogy például konstans szövegek gyors bevitelére is használható lehetne. Lényegében az alapötlet is akkor
merült fel, amikor ezen törtem a fejem. De valahogyan inkább ez lett belőle. A szövegbevitelt majd később
valósítom meg.
Hogy egyértelmű legyen, miként kell a szisztéma működéséhez szükséges AutoCAD objektumokat létrehozni, az alábbi
linknél letölthető egy
demó AutoCAD állomány.
(setq AcadObj (vlax-get-acad-object) ActiveDocument (vla-get-ActiveDocument AcadObj))
;
(defun blokkbeill ( )
;---- Az aktuális Layout objektumot letároljuk, mert a blokk kiválasztása
;---- után ide kell visszatérni:
(setq actlayout (vlax-get-property ActiveDocument "ActiveLayout"))
;---- Megvizsgáljuk, hogy létezik-e "PFGEO-BLOKKOK" nevű Layout objektum:
(vlax-for layout (vla-get-layouts ActiveDocument)
(if (= (vlax-get-property layout "Name") "PFGEO-BLOKKOK")
;---- Ha rábukkantunk akkor aktuálissá tesszük
;---- a "PFGEO-BLOKKOK" nevű Layout -ot:
(vlax-put-property ActiveDocument "ActiveLayout" layout)
)
)
(if (=
(vlax-get-property (vlax-get-property ActiveDocument "ActiveLayout") "Name")
"PFGEO-BLOKKOK"
)
(progn
;---- Ha aktuális a "PFGEO-BLOKKOK" nevű Layout.
;---- Ha található benne POLYLINE, és az első megtaláltnak
;---- legalább négy töréspontja van, akkor azt a bokkokat
;---- keretező vonalláncnak tekitjük, és ráablakozunk:
(if (setq obj (ssget "_X" '((0 . "POLYLINE"))))
(progn
;---- Van legalább egy POLYLINE:
(setq obj (vlax-ename->vla-object (ssname obj 0)))
(if (>
(length (vlax-safearray->list (vlax-variant-value (vla-get-coordinates obj))))
3
)
(progn
;---- Legalább négy töréspontja van. Az elsőt és a harmadikat tekintjük az
;---- ablak sarokpontjainak:
(setq p1 (vlax-safearray->list (vlax-variant-value (vla-get-coordinate obj 0)))
p2 (vlax-safearray->list (vlax-variant-value (vla-get-coordinate obj 2)))
)
)
)
;---- Vannak sarokpontok. Ráablakozunk.
(if (and p1 p2) (zoomwindow (list p1 p2)))
)
)
(setq elem T blokknev nil)
(while elem
;---- Addig amíg a júzer választ ki rajzelemet.
;---- Ha nem megfelelőt választ ki akkor újra próbálkozhat.
(setq elem nil)
(if (setq elem (entsel "\nVálassza ki a beillesztendő blokkot!"))
(progn
(setq elem (car elem))
(if (= "INSERT" (setq eleml (entget elem) qwer (cdr (assoc 0 eleml))))
(progn
;---- Egy blokk beillesztett példányát választotta ki.
;---- A dinamikus blokkok kezelhetősége érdekében az
;---- alábbi módon olvassuk ki a blokkdefiníció nevét:
(setq blokknev (vla-get-effectivename (vlax-ename->vla-object elem))
elem nil ;---- Be kel fejezni a kiválasztást.
)
)
(if (= "TEXT" (setq eleml (entget elem) qwer (cdr (assoc 0 eleml))))
(progn
;---- TEXT rajzelemet választott. Ha van ilyen nevű blokk,
;---- akkor azt fogja beilleszteni.
(if (tblsearch "BLOCK" (setq nev (cdr (assoc 1 eleml))))
(setq blokknev nev
elem nil ;---- Be kel fejezni a kiválasztást.
)
)
)
)
)
)
)
)
;---- Visszatérünk a híváskor letárolt Layout -ba:
(vlax-put-property ActiveDocument "ActiveLayout" actlayout)
;---- Azért oldjuk meg az alábbi módon a beillesztést, hogy egy hívással
;---- a kiválasztott blokk több példányát is be lehessen illeszteni.
;---- A befejezéshez a beillesztési pont bekérésekor kell üres választ adni.
;
;---- Mivel az AutoDesk szerint, ha elkezdtük egy blokk beillesztését
;---- akkor kutya kötelességünk azt végre is hajtani, az INSERT parancsból
;---- nem lehet kilépni a beillesztési pont bekérésekor adott üres válaszal.
;---- Ezért a beillesztési pontot előre bekérjük, és üres válasz esetén
;---- kilépünk a funkcióból.
;
;---- Az alábbi ciklus addig futhat amíg a júzer ad meg beillesztési pontot.
;---- Hogy a feltétel belépéskor is igaz lehessen, a BP -nek T értéket adunk:
(setq bp T old_cmdecho (getvar "CMDECHO"))
(while (and blokknev bp)
;---- Ha van kiválasztott blokk, akkor addig,
;---- amíg volt megadva beillesztési pont.
(setq bp nil)
(if (setq bp (getpoint "\nAdja meg a beillesztési pontot: "))
(progn
(setvar "CMDECHO" 1)
;---- A én gyakorlatomban egy állományban minden blokk azonos
;---- beillesztési léptékű, és a léptéket a BLOKKSZORZO változó
;---- tárolja.
(command "_.INSERT" blokknev bp blokkszorzo blokkszorzo pause)
)
)
)
;---- Visszaállítjuk a CMDECHO eredeti értékét:
(setvar "CMDECHO" old_cmdecho)
)
(alert "Nincs PFGEO-BLOKKOK nevű elrendezés!")
)
(princ)
)
;
;
A fenti program által hívott segédfüggvények:
;
;
(defun zoomwindow (window / )
;---- A WINDOW listában átvett két pont által meghatározott ablakra zoomol.
(vla-ZoomWindow
(vlax-get-Acad-Object)
(vlax-3d-point (car window))
(vlax-3d-point (cadr window)
)
)
)
;
;
(defun osnap_ki ()
;---- Kikapcsolja az Object Snap -ot.
(setq r_osmode (getvar "osmode"))
(if (<= (getvar "osmode") 16384) (setvar "osmode" (+ (getvar "osmode") 16384)))
)
;
;
(defun osnap_be ()
;---- Visszaállítja az Object Snap eredeti beállításait.
(if r_osmode (setvar "osmode" r_osmode))
(setq r_osmode nil)
)
;
;
Az alábbi AutoLisp parancsfüggvénnyel egyszerűen létrehozhatóak
a papírtéri nézetablakban a blokkok beillesztett példányai:
(defun c:blokk_klt ()
;---- Mátrix elrendezésben megjeleníti az
;---- aktuális állományban létező blokkokat.
(setq blokk_list (vl-sort
(ai_table_geo "BLOCK" 14)
(function
(lambda
(sort_1 sort_2)
(< (strcase sort_1) (strcase sort_2))
)
)
)
)
(if blokk_list
(progn
(if (setq bp (getpoint "\n Hová illesszem be ? "))
(if (setq lep (getreal "\n Lépésköz ? "))
(if (setq oszl (getreal "\n Oszlopok száma ? "))
(progn
(setq db -1 sor 0 osz 0)
(osnap_ki)
(setvar "textstyle" "STANDARD")
(setq fixmag (if (> (cdr (assoc 40 (tblsearch "STYLE" "STANDARD"))) 0) T nil))
(setq old_attreq (getvar "ATTREQ")
old_attdia (getvar "ATTDIA")
)
(setvar "CMDECHO" 0)
(setvar "ATTREQ" 1)
(setvar "ATTDIA" 0)
(while (setq nev (nth (setq db (1+ db)) blokk_list))
(setq y (+ (car bp) (* osz lep))
x (- (cadr bp) (* sor lep))
osz (1+ osz)
)
(command "_.insert" nev (list y x 0.0) 1.0 1.0 0.0)
(while (> (getvar "cmdactive") 0) (command "attr"))
(if fixmag
(command "_.text" "_j" "_BC"
(polar (list y x) (* pi 1.5) (/ lep 2.1)) 0.0 nev
)
(command "_.text" "_j" "_BC"
(polar (list y x) (* pi 1.5) (/ lep 2.1)) 0.3 0.0 nev
)
)
(if (= osz oszl)
(setq osz 0
sor (1+ sor)
)
)
)
(osnap_be)
(setvar "CMDECHO" 1)
(setvar "ATTREQ" old_attreq)
(setvar "ATTDIA" old_attdia)
)
)
)
)
)
)
)
;
;
A továbbiakat majd későb...
