Citaat van: Jacob op do 22 05 2025, 16:39:00Dag Reimer en Eddy,Eigenlijk heel simpel:
Bedankt voor jullie input.
Ik heb jullie uitleg 3 keer doorggelezen, maar krijg het neit voor elkaar om de lisp te starten.
Het bestand heet "CopyBlockDefinition.lsp", deze wordt automatisch geladen met "acaddoc.lsp"
Via de toolpallet wil ik de lisproutine uitvoeren.
Normaal start ik met "^C^CCopyBlockDefinition"
Na de uitleg heb ik het geprobeerd met "^C^CLMCopyBlockDefinition" en met "^C^CLM:CopyBlockDefinition"
Maar ik blijf de melding houden dat hij het commando niet kent.
Wellicht lees ik het niet goed of zie wat over het hoofd.
Hoor graag.
(defun c:CopyB ( / OLDBLOCK OLDNAME NEWNAME) staat dit:
(defun C:LINE ( / )
...
)defun = definieer functieCitaat van: Reimer op ma 19 05 2025, 13:04:33...Met 'LM:' creëert Lee Mac dus een ruimte waarmee hij dus geen andere functies kan 'overrullen'
Wat Lee Mac doet is niets anders dan "LM:" toevoegen als onderdeel van de naam van zijn commando's.
...
(defun AB:subroutine ( / )
(alert "Dit is een subroutine")
(princ)
)
(defun XY:subroutine (a / )
(alert (strcat "Dit is een " a " subroutine")
(princ)
)
Je kunt dit dan zo gebruiken:(defun C:foo ( / )
; roep de subroutines aan
(AB:subroutine)
(XY:subroutine "andere")
(princ) ; nette afsluiting van je routine
)
;; Copy Block Definition - Lee Mac
;; Duplicates a block definition, with the copied definition assigned the name provided.
;; blk - [str] name of block definition to be duplicated
;; new - [str] name to be assigned to copied block definition
;; Returns the copied VLA Block Definition Object, else nil
(defun LM:CopyBlockDefinition ( blk new / abc app dbc dbx def doc rtn vrs )
(setq dbx
(vl-catch-all-apply 'vla-getinterfaceobject
(list (setq app (vlax-get-acad-object))
(if (< (setq vrs (atoi (getvar 'acadver))) 16)
"objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs))
)
)
)
)
(cond
( (or (null dbx) (vl-catch-all-error-p dbx))
(prompt "\nUnable to interface with ObjectDBX.")
)
( (and
(setq doc (vla-get-activedocument app)
abc (vla-get-blocks doc)
dbc (vla-get-blocks dbx)
def (LM:getitem abc blk)
)
(not (LM:getitem abc new))
)
(vlax-invoke doc 'copyobjects (list def) dbc)
(vla-put-name (setq def (LM:getitem dbc blk)) new)
(vlax-invoke dbx 'copyobjects (list def) abc)
(setq rtn (LM:getitem abc new))
)
)
(if (= 'vla-object (type dbx))
(vlax-release-object dbx)
)
rtn
)
;; VLA-Collection: Get Item - Lee Mac
;; Retrieves the item with index 'idx' if present in the supplied collection
;; col - [vla] VLA Collection Object
;; idx - [str/int] Index of the item to be retrieved
(defun LM:getitem ( col idx / obj )
(if (not (vl-catch-all-error-p (setq obj (vl-catch-all-apply 'vla-item (list col idx)))))
obj
)
)
;; Effective Block Name - Lee Mac
;; ent - [ent] Block Reference entity
(defun LM:al-effectivename ( ent / blk rep )
(if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
(if
(and
(setq rep
(cdadr
(assoc -3
(entget
(cdr
(assoc 330
(entget
(tblobjname "block" blk)
)
)
)
'("AcDbBlockRepBTag")
)
)
)
)
(setq rep (handent (cdr (assoc 1005 rep))))
)
(setq blk (cdr (assoc 2 (entget rep))))
)
)
blk
)
;; Functie door Reimer om de routine van Lee Mac te laten werken.
;;
(defun c:CopyB ( / OLDBLOCK OLDNAME NEWNAME)
(prompt "\nSelecteer een blok om te kopiëren: ")
(setq OLDBLOCK (car (entsel)))
(if (and OLDBLOCK (= (cdr (assoc 0 (entget OLDBLOCK))) "INSERT"))
(progn
(setq OLDNAME (LM:al-effectivename OLDBLOCK))
(setq NEWNAME (strcat OLDNAME "_1"))
(while (tblsearch "BLOCK" NEWNAME)
(setq NEWNAME (strcat NEWNAME "_1"))
)
(LM:CopyBlockDefinition OLDNAME NEWNAME)
(princ (strcat "\nBlock '" OLDNAME "' gekopieerd als '" NEWNAME "'."))
)
(if (not OLDBLOCK)
(prompt " Geen object geselecteerd.")
(prompt " Selectie is geen block.")
)
);_if
(print)
)