Leaderboard

Hi, I modified little bit the procedure in order to set the current layer to "0" because in your drawing I saw sometime the current layer has been settled from those included in excel file to be turn off or on. So here attached your excel file with Module 10 modified with the following parts: Global AcadDoc As Object Sub Cad_Transfer() Dim AcadApp As Object 'Dim AcadDoc As Object ' MOVED AS GLOBAL VARIABLE DECLARATION ... MyAdd = Selection.Address Range("B2").Select 'After retriving last cell in the excel file, selection will be settled to top list cell. 'Check if layer shall be on or off SetToLayer0 ' Added routine for setting layer "0" as current before settining ON OFF the layers listed in Ecel file. .... 'NEW ROUTINE Sub SetToLayer0() Dim MyLayer As AcadLayers Set MyLayer = AcadDoc.Layers i = 0 For Each CurrentLayer In MyLayer If CurrentLayer.Name = "0" And CurrentLayer.Name <> AcadDoc.ActiveLayer.Name Then AcadDoc.ActiveLayer = AcadDoc.Layers.Item(i) End If i = i + 1 Next End Sub However again attached your excel file, please check module 10 VBA. Command button on excel worksheet has been fixed pointing MODULE 10 procedure Cad_Transfer() A final MsgBox at the end of layer setting ON OFF procedure could be added, in order to have a check of end of procedure. Actually it's not provided, you can add to yourself. Regards Copy of Copy of Copy of ACADTEST - Copy.xlsm

Try this Command FIB (for Find In Block), select block ... It will print the insert point of the circle within the block, and outside the block (see if this works) (vl-load-com) ;; iterates through the items inside a block. Returns the searched item (for example "CIRCLE") (DEFUN find_in_block (blkname tag / od_ent res) (SETQ od_ent (TBLOBJNAME "BLOCK" blkname )) (WHILE (SETQ od_ent (ENTNEXT od_ent)) (if (= tag (cdr (assoc 0 (entget od_ent)))) (setq res od_ent) ) ) res ) (defun geteffectivename ( ent / ) (vla-get-Effectivename (vlax-ename->vla-object ent)) ) (defun c:fib ( / ent blkname subent ip_ins ang_ins ip ang sc dist) (setq ent (car (entsel "\nSelect block: "))) ;;(setq blkname (cdr (assoc 2 (entget ent)))) (setq blkname (geteffectivename ent)) (setq subent (find_in_block blkname "CIRCLE")) ;; get the Insert Point (princ "\nInsert point of the circle inside the block: ") (princ (setq ip_ins (cdr (assoc 10 (entget subent))))) (setq ang_ins (angle (list 0.0 0.0 0.0) ip_ins)) ;; now let's add that to where the block was inserted, including rotation and scale (setq ip (cdr (assoc 10 (entget ent)))) (setq ang (cdr (assoc 50 (entget ent)))) (setq sc (cdr (assoc 41 (entget ent)))) ;; I will assume uniform scale (princ "\nInsert point of the circle outside the block: ") (princ (polar ip (+ ang ang_ins) (* sc (distance (list 0.0 0.0 0.0) ip_ins) ) ) ) (princ) )