Topic: ObjectDBX Xref for block

[T.Willey]

But I thought Lisp was cAsE sensitive... And in our dynamic block "Detail Bdr" thats how it lists

It is, that is why we use this line

Code: [Select]

(strcase (vla-get-EffectiveName Obj))This tells it to make the name all capitol letters.

[OcCad]

Alright... one, there hasn't been a problem with the dynamic block so far that I list as "Detail Bdr" and two, would changing the case of the dynamic block fix the issue I'm having with "DTLTITLE" scaling by an xeffectivescale factor of 0.75 when it lists 12.0?

[T.Willey]

Post the whole code you are using so we can see what you are working with.

[OcCad]

"DTLTITLE" & "DET-TITLE" are not dynamic blocks

Code: [Select]

(defun c:xas (/ EntName EntData InsName InsScale InsPoint DwgName dbxDoc LO Obj dbxScale EL)

   (command "-layer" "make" "S-ANNO-XREF" "color" "7" "" "ltype" "continuous" "" "s" "" "")

 (INITDIA)
  (command "xattach" pause)

    (setq EntName  (entlast))
    (setq EntData  (entget EntName))
    (setq InsName (cdr (assoc 1 (tblsearch "BLOCK"(cdr (assoc 2 EntData))))))
    (setq InsScale (cdr (assoc 41 EntData)))
    (setq InsPoint (cdr (assoc 10 EntData)))
   (princ)   

 (vl-load-com)

    (setq dwgName InsName)
   
    (setq dbxDoc (vla-GetInterfaceObject
        (vlax-get-acad-object)
        (strcat "ObjectDBX.AxDbDocument." (substr (getvar "acadver") 1 2))
      )
    )
    (vlax-invoke dbxDoc "Open" dwgName)
   (princ)

    (vlax-for LO (vla-get-Layouts dbxDoc)
     (vlax-for Obj (vla-get-Block LO)
      (if
       (and
        (= (vla-get-ObjectName Obj) "AcDbBlockReference")
        (= (vl-position (strcase (vla-get-EffectiveName Obj)) '("DETAIL BDR" "DTLTITLE" "DET-TITLE")))
       );and
       (setq dbxScale (vla-get-XScaleFactor Obj))
      ):if
     )
    )
   (princ)

    (vlax-release-object dbxDoc)
      (setq dbxDoc nil)

  (command "scale" EntName "" InsPoint (/ 1 dbxScale))
  (princ)

  (setq EL (entget (entlast)))
  (prompt (strcat "\nInserted " (cdr (assoc 2 EL)) " at scale " (rtos (* 12 (cdr (assoc 41 EL)))) " = 1' "))

 (princ)
)

[T.Willey]

This line is not correct

Code: [Select]

(= (vl-position (strcase (vla-get-EffectiveName Obj)) '("DETAIL BDR" "DTLTITLE" "DET-TITLE")))
It should be (like we posted before)

Code: [Select]

(vl-position (strcase (vla-get-EffectiveName Obj)) '("DETAIL BDR" "DTLTITLE" "DET-TITLE"))
'vl-position' searches a list for the item supplied, so here it is searching the list you supply for the the name of the block you supply.  If it finds it, then it returns the postion, if it doesn't find it it returns nil.

[OcCad]

Shveet! Thanks

[OcCad]

Hey Gurus,

This code seems to work fine on my computer but now when I try to load it onto other peoples computer I'm getting an "exception occured" when they try to run it and can't figure out from where or even why. Could it be because some settings are diff on mine than theirs?...

Code: [Select]

=======================================================================
;;;
;;;  XrefAttachScale.lsp
;;;
;;;  Created by Alex J. Ruiz
;;;  Help from Tim Willey & Vovka
;;;  11.01.2007
;;;
;;;  Tested on r2008
;;;
=======================================================================
;;;  Function to attach xref at a scale governed by nested title block
;;;  Type xas in commandline to run

=======================
;;;Error definition
=======================

;(defun xrperr (msg)
;   (if ce  (setvar "cmdecho" ce))
;   (if v_r (setvar "visretain" v_r))
;   (if r_a (setvar "regenmode" r_a))
;   (setq *error* orgerr)   ;reset previous error def.
;   (princ "\nCommand cancelled!")
;   (prompt "\n ")
;   (princ)
;
;);end defun

=================
;;;Main Program
=================

(defun c:xas (/ lyr lyrdata lyrlock EntName EntData InsName InsScale InsPoint DwgName dbxDoc LO Obj dbxScale EL)

 (setq orgerr *error* *error* xrperr)

=======================
;;;Test for layer Xref
=======================

 (setq lyr "S-ANNO-XREF")

 (if (tblsearch "LAYER" lyr)
  (progn
    (setvar "clayer" lyr)
    (setq lyrdata (entget (tblobjname "layer" lyr)))
    (setq lyrlock (cdr (assoc 70 lyrdata)))
  );progn   
  (command "-layer" "make" lyr "color" "7" "" "ltype" "continuous" "" "s" lyr "")
 );if
 (princ)

 (if (= lyrlock 4)
   (progn
     (initget 0 "Yes No")
     (setq lock (cond ((getkword "\nThe layer S-ANNO-XREF is locked. Would you like to unlock it now? <Yes>: "))
                      ("Yes")))
       (cond
         ((= lock "Yes")
           (command "-layer" "unlock" lyr "")
           )
         ((= lock "No")
           (setq lyrlock 4)
           )
       );cond
   );progn
 );if



============================
;;;Xattach command with Box
============================

 (INITDIA)
  (command "xattach" PAUSE)
   
    (setq EntName  (entlast))
    (setq EntData  (entget EntName))
    (setq InsName  (cdr (assoc 1 (tblsearch "BLOCK"(cdr (assoc 2 EntData))))))
    (setq InsScale (cdr (assoc 41 EntData)))
    (setq InsPoint (cdr (assoc 10 EntData)))
;      (if (= nil Inspoint)
;          (setq InsPoint "0,0,0")
;      );if
;    (setq InsPoint (getpoint "\nSpecify point of insertion: "))
 
  (princ)   

    (setq dwgName InsName)
   
====================
;;;Open Dwg in ODBX
====================

 (vl-load-com)

    (setq dbxDoc (vla-GetInterfaceObject
        (vlax-get-acad-object)
        (strcat "ObjectDBX.AxDbDocument." (substr (getvar "acadver") 1 2))
      )
    )
    (vlax-invoke dbxDoc "Open" dwgName)
   (princ)

==========================
;;;Get the Desired Blocks
==========================

    (vlax-for LO (vla-get-layouts dbxDoc)
     (vlax-for Obj (vla-get-Block LO)
      (if
       (and
        (= (vla-get-ObjectName Obj) "AcDbBlockReference")
        (vl-position (strcase (vla-get-EffectiveName Obj))
        '("MI DETAIL TITLE"
  "MSMTITLE"
  "MSMDTITLE"
  "MI-DET-TITLE"
  "MI DETAIL TITLE1"))
       )
       (setq dbxScale (vla-get-XScaleFactor Obj))
      )
     )
    )
   (princ)

=====================
;;;Close Dwg in ODBX
=====================

    (vlax-release-object dbxDoc)
      (setq dbxDoc nil)

==============
;;;Scale Xref
==============

      (command "scale" EntName "" InsPoint (/ 1 dbxScale))

  (princ)

====================
;;;After the Insert
====================

;  (if (= lyrlock 4)
;   (command "-layer" "lock" lyr "")
;   (setq lyrlock 0)
;  );if

  (setq EL (entget (entlast)))
  (prompt (strcat "\nAttached \"" (cdr (assoc 2 EL)) "\" at " (rtos (* 12 (cdr (assoc 41 EL)))) "=1'-0\" scale"))

;  (setq *error* orgerr orgerr nil)

 (princ)
)

;; / lyr lyrdata lyrlock EntName EntData InsName InsScale InsPoint DwgName dbxDoc LO Obj dbxScale EL

[T.Willey]

The code isn't too long, so I would just test it piece by piece until I found what was giving the error.  Or you might be able to use vlide to watch it run on their computer, but I don't know how to do that, as I don't use vlide to code in.

If I have some time I will look through it a little more thorough.

[OcCad]

Tim,

I did break it apart piece by piece and it got "nils" beginning at the variable LO. I did not check dbxDoc (which I really should have) but still around that area.

[T.Willey]

LO will always be nil, unless you check it within the vlax-for loop.  It is kind of like a local variable.

I remember this routine now.  I would write it different, as there is not need to open the drawing with ObjectDBX since the blocks you are checking for are within model space, and therefor would be within the block definition (xref definition).

[CAB]

I doubt this is the problem but FYI the dxf code 70 is a bit code value and therefore this test may fail.

Code: [Select]

(if (= lyrlock 4)When in fact the layer is locked.

[OcCad]

CAB,

It's a direction I tested but took it out with the semi's

[CAB]

You took this out?

Code: [Select]

(if (= lyrlock 4)
   (progn
     (initget 0 "Yes No")
     (setq lock (cond ((getkword "\nThe layer S-ANNO-XREF is locked. Would you like to unlock it now? <Yes>: "))
                      ("Yes")))
       (cond
         ((= lock "Yes")
           (command "-layer" "unlock" lyr "")
           )
         ((= lock "No")
           (setq lyrlock 4)
           )
       );cond
   );progn
 );if
Just change this

Code: [Select]

(if (= lyrlock 4)to this

Code: [Select]

(if (= (logand 4 lyrlock) 4)

[OcCad]

hehe... forgot about that

[T.Willey]

See if this works for you.

Edit:  Updated code, shown in read.
Edit:  Updated code, shown in read. Tested and works, as long as the block that is being searched for is in model space.

Code: [Select]

(defun c:xas (/ ActDoc LayCol BlkCol xLay OldLay LayObj LockOpt Ent Obj BlkDefObj BlkDefLen cnt xScale tempObj Pos)

(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq LayCol (vla-get-Layers ActDoc))
(setq BlkCol (vla-get-Blocks ActDoc))
(setq xLay "S-ANNO-XREF")
(setq OldLay (getvar 'CLayer))

(if (vl-catch-all-error-p (setq LayObj (vl-catch-all-apply 'vla-Item (list LayCol xLay))))
(setq LayObj (vla-Add LayCol xLay))
)
(setvar 'CLayer xLay)
(if (equal (vla-get-Lock LayObj) :vlax-true)
(progn
(initget 0 "Yes No")
(setq LockOpt
(cond
((getkword "\nThe layer S-ANNO-XREF is locked. Would you like to unlock it now? <Yes>: "))
(T "Yes")
)
)
(if (= LockOpt "Yes")
(vla-put-Lock LayObj :vlax-false)
)
)
)

(InitDia)
(command "_.xattach" pause)
(if
(and
(setq Ent (entlast))
(setq Obj (vlax-ename->vla-object Ent))
(= (vla-get-ObjectName Obj) "AcDbBlockReference")
(equal (vla-get-IsXref (setq BlkDefObj (vla-Item BlkCol (vla-get-Name Obj)))) :vlax-true)
(setq BlkDefLen (vla-get-Count BlkDefObj))
(setq cnt 0)
)
(while
(and
(not xScale)
(< cnt BlkDefLen)
)
(setq tempObj (vla-Item BlkDefObj cnt))
(if
(and
(= (vla-get-ObjectName tempObj) "AcDbBlockReference")
[color=red](setq Pos (vl-string-search "|" (vla-get-EffectiveName tempObj)))[/color]
(vl-position
[color=red](strcase
(substr
(vla-get-EffectiveName tempObj)
(+ 2 Pos)
)
)[/color]
'("MI DETAIL TITLE"
  "MSMTITLE"
  "MSMDTITLE"
  "MI-DET-TITLE"
  "MI DETAIL TITLE1"
)
)
)
(setq xScale (vla-get-XScaleFactor tempObj))
(setq cnt (1+ cnt))
)
)
)
(if xScale
(progn
[color=red](vlax-invoke Obj 'ScaleEntity (vlax-get Obj 'InsertionPoint) (/ 1 xScale))[/color]
(prompt
(strcat
"\nAttached \""
(vla-get-Name Obj)
"\" at "
[color=red](rtos (* 12 (/ 1 xScale)))[/color]
"=1'-0\" scale"
)
)
)
)
(if (= LockOpt "Yes")
(vla-put-Lock LayObj :vlax-true)
)
(setvar 'CLayer OldLay)
(princ)
)