Author Topic: More Mleader Help Needed  (Read 2498 times)

0 Members and 1 Guest are viewing this topic.

cmwade77

  • Swamp Rat
  • Posts: 1277
More Mleader Help Needed
« on: February 12, 2010, 05:41:23 PM »
Ok, now I would like to know how to get attributes from a block in an MLeader? I can't quite seem to get this one, any ideas?

Lee Mac

  • Seagull
  • Posts: 12502
  • London, England
Re: More Mleader Help Needed
« Reply #1 on: February 12, 2010, 05:45:42 PM »
I didn't even realise that you could get a block in an MLeader...  :oops:

cmwade77

  • Swamp Rat
  • Posts: 1277
Re: More Mleader Help Needed
« Reply #2 on: February 12, 2010, 06:44:27 PM »
Yep, we've been doing it since they came out, very handy feature, especially with a lot of my routines, I just want to be able to modify the attributes without using the dialog box.

T.Willey

  • Needs a day job
  • Posts: 5247
Re: More Mleader Help Needed
« Reply #3 on: February 12, 2010, 07:15:43 PM »
Change the last ' 302 ' code.  That seemed to work on my simple test.

Code: [Select]
((lambda (x)
            (entmod (subst (cons 302 "testing") (assoc 302 (reverse x)) x))
        )(entget (car (entsel "\n Select mleader to change attribute to \"testing\": "))))
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

cmwade77

  • Swamp Rat
  • Posts: 1277
Re: More Mleader Help Needed
« Reply #4 on: February 12, 2010, 07:41:47 PM »
Ok, perhaps I should explain further, I have blocks with several attributes in them and I want to be able to select the attribute to change. Also, not all blocks have the same number of attributes, so I need to be able to get a list of the attributes in the block.

alanjt

  • Needs a day job
  • Posts: 5340
  • Standby for witty remark...
Re: More Mleader Help Needed
« Reply #5 on: February 15, 2010, 09:00:01 AM »
This might help, but will not get you exactly what you want.

http://www.theswamp.org/index.php?topic=29917.0
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

cmwade77

  • Swamp Rat
  • Posts: 1277
Re: More Mleader Help Needed
« Reply #6 on: February 15, 2010, 12:26:43 PM »
Here is what I have so far, the problem that I am finding is that the code from the above thread is returning the attribute definition, not the attribute reference. Any help with this would be greatly appreciated.
Code: [Select]
;Written By Chris Wade
; 2010-02-15

; Copies Text

; Table modifications uses modified code from:
;; Written by Lee Ambrosius
;; Date: 3/24/04
;; Checks for tables in current view to match up with HitTest
;; This avoids the need for the user to select the table first.

;; Program is provided AS-IS with no expressed written warranty
;; This example demonstrates a couple of the new Table ActiveX properties
;; HitTest, GetCellType, GetText and SetText

(defun c:ct ( / vector table pick row col cellValueOrg StopLoop oValue SS_tables cnt emax Modified cwset Crossing)
 (setq vHeight (getvar "viewsize"))
 (setq vWidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vHeight))

 (setq lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2)) (- (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0))
 (setq uprRight (list (+ (nth 0 (getvar "viewctr")) (/ vWidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0))

 (setq vector (vlax-make-safearray vlax-vbDouble '(0 . 2)))
 (vlax-safearray-fill vector '(1 1 1))
 (setq vector (vlax-make-variant vector))
(defun GetText ()
 (while (= StopLoop nil)
(setq input (grread T 4 2))
(prompt "\rSelect Text/Cell to Copy <Type Text>: ")
(cond
((and (= (car input) 2) (or (= (cadr input) 116) (= (cadr input) 84)))
(setq oValue (getstring T "\nEnter text to use (Press enter to select text): "))
(cond
((and (/= oValue nil) (/= oValue null) (/= oValue ""))
(setq StopLoop T)
)
)
)
((= (car input) 3)
(setq pick (vlax-3d-point (cadr input)))
(if (/= pick nil)
   (progn
(if (setq SS_TABLES (ssget "C" lwrleft uprright (list (cons 0 "ACAD_TABLE"))))
   (progn
(setq cnt 0 eMax (sslength SS_TABLES))
(while (> eMax cnt)
   (setq table (vlax-ename->vla-object (ssname SS_TABLES cnt)))
   ;; Return values for what cell was picked in
   (setq row 0 col 0)
   ;; Check to see if a valid cell was picked
   (if (= (vla-hittest table pick vector 'row 'col) :vlax-true)
(progn
   ;; Check to see what the Cell Type is (Text or Block)
   (if (= (vlax-invoke-method table 'GetCellType row col) acTextCell)
(progn
   ;; Let's get the value out
   (setq OValue (vlax-invoke-method table 'GetText row col))                                     
   (setq cnt eMax)
  )
)
  )
)
(setq cnt (1+ cnt))
  )
)
  )
)
  )
  (cond
((= Ovalue nil)
(setq obj (nentselp "" (cadr input)))
(cond
((/= obj nil)
(setq obj (vlax-ename->vla-object (car obj))
      ovalue (vla-get-textstring obj))
)

)
)
  )  
  (cond
((/= Ovalue nil)
(setq StopLoop T)
)
  )
)
)
)
oValue
)
(defun ChangeText (obj2 text pt pt2 / obj obj3 obj4 ATT ObjTyp ObjBKName row2 col2 Columns rows2 pick pta ptb xmax xmin ymax ymin ss cnt)
(setq Obj (vlax-ename->vla-object obj2)
      ObjTyp (vla-get-ObjectName obj)
  cnt 0)
(cond
((/= pt2 nil) 
(setq XMIN (MIN (CAR pt)(CAR pt2))
  XMAX (MAX (CAR pt)(CAR pt2))
  YMIN (MIN (CADR pt)(CADR pt2))
  YMAX (MAX (CADR pt)(CADR pt2)))
)
)
(cond
((= ObjTyp "AcDbTable")
(setq Rows2 (vla-get-rows obj)
  Columns (vla-get-columns obj)
  pick (list xmin ymin)
  Row2 -1
  Col2 -1)
(while (< col2 (- Columns 1))
(setq Col2 (+ col2 1))
(while (< row2 (- rows2 1))
(setq row2 (+ row2 1)
      pick2 (vlax-safearray->list (vlax-variant-value (vla-getcellextents obj row2 col2 0)))
  pta (list (nth 0 pick2) (nth 1 pick2))
  ptb (list (nth 9 pick2) (nth 10 pick2))
  pick (midpnt pta ptb))
(if (and (> (car pta) XMIN) (> (cadr pta) YMIN) (< (car ptb) XMAX) (< (cadr ptb) YMAX))
(progn
(ChangeTable (vlax-3d-point pick) oValue lwrleft uprright)
)
)
)

(setq row2 -1)
)
)
((= ObjTyp "AcDbBlockReference")
(cond
((= pt2 nil)
(setq Obj (vlax-ename->vla-object (car (nentselp "" pt))))
(vla-put-textstring obj text)
)
(T   
(setq AttList (vlax-variant-value (vla-getattributes obj)))  
(foreach Att (vlax-safearray->list AttList)
(setq tpt (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint att))))
(cond
((and (< XMIN (CAR tpt))(> XMAX (CAR tpt)) (< YMIN (CADR tpt))(> YMAX (CADR tpt)))
(vla-put-textstring att text)
)
)
 
                    )
               
)
)
)
((= ObjTyp "AcDbMLeader")
(setq ObjBKName (vla-get-ContentBlockName obj))
(cond
((or (= ObjBKName "") (= ObjBKName nil) (= ObjBKName null))
(vla-put-textstring obj text)
)
(T
(cond
((= pt2 nil)
(setq ss (ssget pt))
)
(T
(setq ss (ssget "_C" pt pt2))
)
)
(cond
((/= ss nil)
(while (< cnt (sslength ss))
(cond
((= AttList nil)
(setq AttList (MleaderAttributes (ssname ss cnt)))
)
(T
(setq AttList (append AttList (MleaderAttributes (ssname ss cnt))))
)
)
(setq cnt (+ cnt 1))
)
)
)
(foreach Att AttList
(setq tpt (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint att))))
(cond
((= pt2 nil)
(cond
((and (= (car pt) (car tpt)) (= (cadr pt) (cadr tpt)))
(vla-put-textstring att text)
)
)
)
(T
(cond
((and (< XMIN (CAR tpt))(> XMAX (CAR tpt)) (< YMIN (CADR tpt))(> YMAX (CADR tpt)))
(vla-put-textstring att text)
)
)
)
)
)
)
)
)
((= (wcmatch ObjTyp "*Dimension*") T)
(vla-put-TextOverride obj text)
)
(T
(vla-put-textstring obj text)
)
)  
)

(defun ChangeTable (pick oValue lwrleft uprright)
(if (setq SS_TABLES (ssget "C" lwrleft uprright (list (cons 0 "ACAD_TABLE"))))
(progn
(setq cnt 0 eMax (sslength SS_TABLES))
(while (> eMax cnt)
   (setq table (vlax-ename->vla-object (ssname SS_TABLES cnt)))
   ;; Return values for what cell was picked in
   (setq row 0 col 0)
   ;; Check to see if a valid cell was picked
   (if (= (vla-hittest table pick vector 'row 'col) :vlax-true)
(progn
   ;; Check to see what the Cell Type is (Text or Block)
   (if (= (vlax-invoke-method table 'GetCellType row col) acTextCell)
(progn
   ;; Change the current value
   (vlax-invoke-method table 'SetText row col OValue)
   (vlax-invoke-method table 'Update)
   (setq Modified T)
   (setq cnt eMax)
  )
)
  )
)
(setq cnt (1+ cnt))
  )
)
)
)

(setq oValue (GetText))
(setq StopLoop nil)
(while (= StopLoop nil)
(setq Modified nil
      crossing nil
      input (grread T 4 2))
(prompt "\rSelect Text/Cell to Overwrite <New text/Crossing>: ")
(cond
((and (= (car input) 2) (or (= (cadr input) 99) (= (cadr input) 67)))
(setq Crossing T)
)
((and (= (car input) 2) (or (= (cadr input) 110) (= (cadr input) 78)))
(setq oValue (GetText)
      StopLoop nil)
)
((or (= (car input) 3) (= Crossing T))
(setq pick (vlax-3d-point (cadr input)))
(if (= Crossing nil)
(ChangeTable pick oValue lwrleft uprright)
)
  (setq point2 (trans (cadr input) 1 0))
  (cond
((= Modified nil)
(setq cwset nil)
(setq cwset (ssget (cadr input)))
(cond
((/= cwset nil)
(setq obj (ssname cwset 0)
  cnt eMax)
(ChangeText obj oValue point2 nil)
)
(T
(cond
((= Crossing T)
(setq point2 (getpoint "\nSelect first corner of crossing box: "))
)
)
(setq point3 (getcorner point2 "\nSelect opposite corner of crossing box: ")
      flt '((-4 . "<OR") (0 . "TEXT") (0 . "MULTILEADER") (0 . "ACAD_TABLE") (0 . "*DIMENSION*") (0 . "MTEXT") (-4 . "<AND") (0 . "INSERT") (66 . 1) (-4 . "AND>") (-4 . "OR>"))
      cwset (ssget "_C" point2 point3 flt)
  ct 0)
(cond
((/= cwset nil)
(while (< ct (sslength cwset))
(setq obj (ssname cwset ct)
   ct (+ ct 1))
(ChangeText obj oValue point2 point3)
)
)
(T
(alert "You didn't select anything to change!")
)
)
)
)
)
  )  
)
)
)
 (princ)
)
; Code for getting MleaderAttributes written by AlanJt at http://www.theswamp.org/index.php?topic=29917.msg354739#msg354739
(defun MleaderAttributes (#Ename / #Entget)
  (if (eq (type #Ename) 'ENAME)
    (progn
      (setq #Entget (entget #Ename))
      (vl-remove-if
        '(lambda (x)
           (or (not x)
               (not (eq "AcDbAttributeDefinition"
                        (vla-get-objectname x)
                    ) ;_ eq
               ) ;_ not
           ) ;_ or
         ) ;_ lambda
        (mapcar
          '(lambda (x)
             (if (eq 330 (car x))
               (vlax-ename->vla-object (cdr x))
             ) ;_ if
           ) ;_ lambda
          #Entget
        ) ;_ mapcar
      ) ;_ vl-remove-if
    ) ;_ progn
  ) ;_ if
) ;_ defun

(defun midpnt (pt1 pt2)
(mapcar '(lambda (x y) (* 0.5 (+ x y))) pt1 pt2)
)

T.Willey

  • Needs a day job
  • Posts: 5247
Re: More Mleader Help Needed
« Reply #7 on: February 15, 2010, 01:24:39 PM »
Here you go.  I wanted to stretch the grey matter, and here is a working solution ( tested in '09 ).

Code: [Select]
(defun c:test ( / Sel EntData Ent EditList cnt Num Str tempList )
   
    (if
        (and
            (setq Sel (entsel "\n Select mleader with blocks to edit: "))
            (setq EntData (entget (setq Ent (car Sel))))
            (= (cdr (assoc 0 EntData)) "MULTILEADER")
        )
        (progn
            (foreach i EntData
                (if
                    (and
                        (equal (car i) 330)
                        (equal (type (cdr i)) 'ENAME)
                        (= (cdr (assoc 0 (entget (cdr i)))) "ATTDEF")
                    )
                    (setq EditList
                        (cons
                            (list
                                i
                                (assoc 177 (member i EntData))
                                (assoc 302 (member i EntData))
                            )
                            EditList
                        )
                    )
                )
            )
        )
    )
    (if EditList
        (progn
            (setq cnt 0)
            (setq EditList (reverse EditList))
            (foreach i EditList
                (prompt
                    (strcat
                        "\n "
                        (itoa cnt)
                        " - "
                        (cdr (assoc 3 (entget (cdar i))))
                        " <"
                        (cdaddr i)
                        ">: "
                    )
                )
                (setq cnt (1+ cnt))
            )
            (textscr)
            (if
                (and
                    (< -1 (setq Num (getint (strcat "\n Enter number of value to edit [0 - " (itoa (1- cnt)) "]: ")))  cnt)
                    (setq Str (getstring T (strcat "\n Replacement value for <" (cdaddr (setq tempList (nth Num EditList))) ">: ")))
                )
                (entmod
                    (mapcar
                        (function
                            (lambda ( x )
                                (if (equal x (cadr tempList))
                                    (setq flag T)
                                )
                                (if
                                    (and
                                        flag
                                        (equal (caddr tempList) x)
                                    )
                                    (progn
                                        (setq flag nil)
                                        (cons 302 Str)
                                    )
                                    x
                                )
                            )
                        )
                        EntData
                    )
                )
            )
            (graphscr)
        )
    )
    (princ)
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

cmwade77

  • Swamp Rat
  • Posts: 1277
Re: More Mleader Help Needed
« Reply #8 on: February 15, 2010, 01:51:17 PM »
Ok, great starting point, thank you, now all that I need to figure out is how to find the insertion point of the Attribute reference (not the attribute definition), so that I can determine which attribute was clicked or is within the crossing window.

Here is what I have so far:
Code: [Select]
;Written By Chris Wade
; 2010-02-15

; Copies Text

; Table modifications uses modified code from:
;; Written by Lee Ambrosius
;; Date: 3/24/04
;; Checks for tables in current view to match up with HitTest
;; This avoids the need for the user to select the table first.

;; Program is provided AS-IS with no expressed written warranty
;; This example demonstrates a couple of the new Table ActiveX properties
;; HitTest, GetCellType, GetText and SetText

(defun c:ct ( / vector table pick row col cellValueOrg StopLoop oValue SS_tables cnt emax Modified cwset Crossing)
 (setq vHeight (getvar "viewsize"))
 (setq vWidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vHeight))

 (setq lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2)) (- (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0))
 (setq uprRight (list (+ (nth 0 (getvar "viewctr")) (/ vWidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0))

 (setq vector (vlax-make-safearray vlax-vbDouble '(0 . 2)))
 (vlax-safearray-fill vector '(1 1 1))
 (setq vector (vlax-make-variant vector))
(defun GetText ()
 (while (= StopLoop nil)
(setq input (grread T 4 2))
(prompt "\rSelect Text/Cell to Copy <Type Text>: ")
(cond
((and (= (car input) 2) (or (= (cadr input) 116) (= (cadr input) 84)))
(setq oValue (getstring T "\nEnter text to use (Press enter to select text): "))
(cond
((and (/= oValue nil) (/= oValue null) (/= oValue ""))
(setq StopLoop T)
)
)
)
((= (car input) 3)
(setq pick (vlax-3d-point (cadr input)))
(if (/= pick nil)
   (progn
(if (setq SS_TABLES (ssget "C" lwrleft uprright (list (cons 0 "ACAD_TABLE"))))
   (progn
(setq cnt 0 eMax (sslength SS_TABLES))
(while (> eMax cnt)
   (setq table (vlax-ename->vla-object (ssname SS_TABLES cnt)))
   ;; Return values for what cell was picked in
   (setq row 0 col 0)
   ;; Check to see if a valid cell was picked
   (if (= (vla-hittest table pick vector 'row 'col) :vlax-true)
(progn
   ;; Check to see what the Cell Type is (Text or Block)
   (if (= (vlax-invoke-method table 'GetCellType row col) acTextCell)
(progn
   ;; Let's get the value out
   (setq OValue (vlax-invoke-method table 'GetText row col))                                     
   (setq cnt eMax)
  )
)
  )
)
(setq cnt (1+ cnt))
  )
)
  )
)
  )
  (cond
((= Ovalue nil)
(setq obj (nentselp "" (cadr input)))
(cond
((/= obj nil)
(setq obj (vlax-ename->vla-object (car obj))
      ovalue (vla-get-textstring obj))
)

)
)
  )  
  (cond
((/= Ovalue nil)
(setq StopLoop T)
)
  )
)
)
)
oValue
)
(defun ChangeText (obj2 text pt pt2 / obj obj3 obj4 ATT ObjTyp ObjBKName row2 col2 Columns rows2 pick pta ptb xmax xmin ymax ymin ss cnt CPt Sel EntData Ent EditList cnt Num Str tempList)
(setq Obj (vlax-ename->vla-object obj2)
      ObjTyp (vla-get-ObjectName obj)
  cnt 0)
(cond
((/= pt2 nil) 
(setq XMIN (MIN (CAR pt)(CAR pt2))
  XMAX (MAX (CAR pt)(CAR pt2))
  YMIN (MIN (CADR pt)(CADR pt2))
  YMAX (MAX (CADR pt)(CADR pt2)))
)
)
(cond
((= ObjTyp "AcDbTable")
(setq Rows2 (vla-get-rows obj)
  Columns (vla-get-columns obj)
  pick (list xmin ymin)
  Row2 -1
  Col2 -1)
(while (< col2 (- Columns 1))
(setq Col2 (+ col2 1))
(while (< row2 (- rows2 1))
(setq row2 (+ row2 1)
      pick2 (vlax-safearray->list (vlax-variant-value (vla-getcellextents obj row2 col2 0)))
  pta (list (nth 0 pick2) (nth 1 pick2))
  ptb (list (nth 9 pick2) (nth 10 pick2))
  pick (midpnt pta ptb))
(if (and (> (car pta) XMIN) (> (cadr pta) YMIN) (< (car ptb) XMAX) (< (cadr ptb) YMAX))
(progn
(ChangeTable (vlax-3d-point pick) oValue lwrleft uprright)
)
)
)

(setq row2 -1)
)
)
((= ObjTyp "AcDbBlockReference")
(cond
((= pt2 nil)
(setq Obj (vlax-ename->vla-object (car (nentselp "" pt))))
(vla-put-textstring obj text)
)
(T   
(setq AttList (vlax-variant-value (vla-getattributes obj)))  
(foreach Att (vlax-safearray->list AttList)
(setq tpt (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint att))))
(cond
((and (< XMIN (CAR tpt))(> XMAX (CAR tpt)) (< YMIN (CADR tpt))(> YMAX (CADR tpt)))
(vla-put-textstring att text)
)
)
 
                    )
               
)
)
)
((= ObjTyp "AcDbMLeader")
(setq ObjBKName (vla-get-ContentBlockName obj)
      ins_pt (osnap pt "_ins"))
(cond
((or (= ObjBKName "") (= ObjBKName nil) (= ObjBKName null))
(vla-put-textstring obj text)
)
(T
(cond
((= pt2 nil)
(setq ss (ssget pt))
)
(T
(setq ss (ssget "_C" pt pt2))
)
)
(cond ; Code for adjusting mleaders with attributes in them modified from code by T.Willey at http://www.theswamp.org/index.php?topic=32152.msg376440#msg376440
((/= ss nil)
(while (< cnt (sslength ss))
(if
(and
(setq Sel (ssname ss Cnt))
(setq EntData (entget (setq Ent Sel)))
(= (cdr (assoc 0 EntData)) "MULTILEADER")
)
(progn
(foreach i EntData
;(setq tpt (cdr (assoc 10 (entget (cdr i)))))
;       ins_pt (osnap pt "_ins"))
; (cond
; ((= pt2 nil)
; (if (and (= (car tpt) (car ins_pt)) (= (cadr tpt) (cadr ins_pt)))
; (setq Cpt T)
; (setq Cpt nil)
; )
; )
; (T
; (if (and (< XMIN (CAR tpt))(> XMAX (CAR tpt)) (< YMIN (CADR tpt))(> YMAX (CADR tpt)))
; (setq Cpt T)
; (setq Cpt nil)
; )
; )
; )
(if
(and
(equal (car i) 330)
(equal (type (cdr i)) 'ENAME)
(= (cdr (assoc 0 (entget (cdr i)))) "ATTDEF")
)
(setq EditList
(cons
(list
i
(assoc 177 (member i EntData))
(assoc 302 (member i EntData))
)
EditList
)
)
)
)
)
)
(if EditList
(progn
(setq cnt 0)
(setq EditList (reverse EditList))
(foreach i EditList
(prompt
(strcat
"\n "
(itoa cnt)
" - "
(cdr (assoc 3 (entget (cdar i))))
" <"
(cdaddr i)
">: "
)
)
(setq cnt (1+ cnt))
)
(textscr)
(if
(and
(< -1 (setq Num (getint (strcat "\n Enter number of value to edit [0 - " (itoa (1- cnt)) "]: ")))  cnt)
(setq tempList (nth Num EditList))
)
(entmod
(mapcar
(function
(lambda ( x )
(if (equal x (cadr tempList))
(setq flag T)
)
(if
(and
flag
(equal (caddr tempList) x)
)
(progn
(setq flag nil)
(cons 302 text)
)
x
)
)
)
EntData
)
)
)
(graphscr)
)
)
(setq cnt (+ cnt 1))
)
)
)
)
)
)
((= (wcmatch ObjTyp "*Dimension*") T)
(vla-put-TextOverride obj text)
)
(T
(vla-put-textstring obj text)
)
)  
)

(defun ChangeTable (pick oValue lwrleft uprright)
(if (setq SS_TABLES (ssget "C" lwrleft uprright (list (cons 0 "ACAD_TABLE"))))
(progn
(setq cnt 0 eMax (sslength SS_TABLES))
(while (> eMax cnt)
   (setq table (vlax-ename->vla-object (ssname SS_TABLES cnt)))
   ;; Return values for what cell was picked in
   (setq row 0 col 0)
   ;; Check to see if a valid cell was picked
   (if (= (vla-hittest table pick vector 'row 'col) :vlax-true)
(progn
   ;; Check to see what the Cell Type is (Text or Block)
   (if (= (vlax-invoke-method table 'GetCellType row col) acTextCell)
(progn
   ;; Change the current value
   (vlax-invoke-method table 'SetText row col OValue)
   (vlax-invoke-method table 'Update)
   (setq Modified T)
   (setq cnt eMax)
  )
)
  )
)
(setq cnt (1+ cnt))
  )
)
)
)

(setq oValue (GetText))
(setq StopLoop nil)
(while (= StopLoop nil)
(setq Modified nil
      crossing nil
      input (grread T 4 2))
(prompt "\rSelect Text/Cell to Overwrite <New text/Crossing>: ")
(cond
((and (= (car input) 2) (or (= (cadr input) 99) (= (cadr input) 67)))
(setq Crossing T)
)
((and (= (car input) 2) (or (= (cadr input) 110) (= (cadr input) 78)))
(setq oValue (GetText)
      StopLoop nil)
)
((or (= (car input) 3) (= Crossing T))
(setq pick (vlax-3d-point (cadr input)))
(if (= Crossing nil)
(ChangeTable pick oValue lwrleft uprright)
)
  (setq point2 (trans (cadr input) 1 0))
  (cond
((= Modified nil)
(setq cwset nil)
(setq cwset (ssget (cadr input)))
(cond
((/= cwset nil)
(setq obj (ssname cwset 0)
  cnt eMax)
(ChangeText obj oValue point2 nil)
)
(T
(cond
((= Crossing T)
(setq point2 (getpoint "\nSelect first corner of crossing box: "))
)
)
(setq point3 (getcorner point2 "\nSelect opposite corner of crossing box: ")
      flt '((-4 . "<OR") (0 . "TEXT") (0 . "MULTILEADER") (0 . "ACAD_TABLE") (0 . "*DIMENSION*") (0 . "MTEXT") (-4 . "<AND") (0 . "INSERT") (66 . 1) (-4 . "AND>") (-4 . "OR>"))
      cwset (ssget "_C" point2 point3 flt)
  ct 0)
(cond
((/= cwset nil)
(while (< ct (sslength cwset))
(setq obj (ssname cwset ct)
   ct (+ ct 1))
(ChangeText obj oValue point2 point3)
)
)
(T
(alert "You didn't select anything to change!")
)
)
)
)
)
  )  
)
)
)
 (princ)
)

(defun midpnt (pt1 pt2)
(mapcar '(lambda (x y) (* 0.5 (+ x y))) pt1 pt2)
)
« Last Edit: February 15, 2010, 02:18:59 PM by cmwade77 »

cmwade77

  • Swamp Rat
  • Posts: 1277
Re: More Mleader Help Needed
« Reply #9 on: February 16, 2010, 01:00:22 PM »
I can't seem to determine if a particular attribute was the one selected or not, any ideas?

T.Willey

  • Needs a day job
  • Posts: 5247
Re: More Mleader Help Needed
« Reply #10 on: February 16, 2010, 01:17:36 PM »
Maybe Gile will come along and save you.  I know what you need to do, but I can't really do it, as I don't know how to implement it.  You have to get the transformation matrix of the block.  Then you have to inverse it.  Gile has provided code for both of these operations, and I know how to make it work with an object, but not with a point, and the small testing I did, didn't work correctly, so hopefully he will see this and chime in with his expertise.

This thread might express what I'm talking about.
[ http://www.theswamp.org/index.php?topic=27786.0 ]
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

cmwade77

  • Swamp Rat
  • Posts: 1277
Re: More Mleader Help Needed
« Reply #11 on: February 22, 2010, 06:31:53 PM »
I am still not getting how to do this part of it, here's my most current code, in case someone can help me figure out the mleaders with multiple attributes issues:
Code: [Select]
;Written By Chris Wade
; 2010-02-15

; Copies Text

; Table modifications uses modified code from:
;; Written by Lee Ambrosius
;; Date: 3/24/04
;; Checks for tables in current view to match up with HitTest
;; This avoids the need for the user to select the table first.

;; Program is provided AS-IS with no expressed written warranty
;; This example demonstrates a couple of the new Table ActiveX properties
;; HitTest, GetCellType, GetText and SetText

(defun c:ct ( / vector table pick row col cellValueOrg StopLoop SS_tables cnt emax Modified cwset Crossing Inc)
 (setq vHeight (getvar "viewsize"))
 (setq vWidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vHeight))

 (setq lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2)) (- (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0))
 (setq uprRight (list (+ (nth 0 (getvar "viewctr")) (/ vWidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0))

 (setq vector (vlax-make-safearray vlax-vbDouble '(0 . 2)))
 (vlax-safearray-fill vector '(1 1 1))
 (setq vector (vlax-make-variant vector))
 (princ "\n")
(defun GetText ()
(setq str "")
(cond
((= oValue nil)
(setq oValue ".")
)
)
(prompt (strcat "\rSelect Text/Cell to Copy or type Text <" oValue ">: "))
; Code for typing text used from DTCurve command 
;; AUTHOR:                                                                      ;;
;;                                                                               ;;
;;  Copyright Lee McDonnell, November 2009. All Rights Reserved.               ;;
;;                                                                               ;;
;;      { Contact: Lee Mac @ TheSwamp.org, CADTutor.net }                        ;;
 (while (= StopLoop nil)
(setq input (grread T 4 2)
      data (cadr input)
  code (car input))
(cond

((= (car input) 3)
(setq oValue nil)
(setq pick (vlax-3d-point (cadr input)))
(if (/= pick nil)
   (progn
(if (setq SS_TABLES (ssget "C" lwrleft uprright (list (cons 0 "ACAD_TABLE"))))
   (progn
(setq cnt 0 eMax (sslength SS_TABLES))
(while (> eMax cnt)
   (setq table (vlax-ename->vla-object (ssname SS_TABLES cnt)))
   ;; Return values for what cell was picked in
   (setq row 0 col 0)
   ;; Check to see if a valid cell was picked
   (if (= (vla-hittest table pick vector 'row 'col) :vlax-true)
(progn
   ;; Check to see what the Cell Type is (Text or Block)
   (if (= (vlax-invoke-method table 'GetCellType row col) acTextCell)
(progn
   ;; Let's get the value out
   (setq OValue (vlax-invoke-method table 'GetText row col))                                     
   (setq cnt eMax)
  )
)
  )
)
(setq cnt (1+ cnt))
  )
)
  )
)
  )
  (cond
((= Ovalue nil)
(setq obj (nentselp "" (cadr input)))
(cond
((/= obj nil)
(setq obj (vlax-ename->vla-object (car obj))
      ovalue (vla-get-textstring obj))
)

)
)
  )  
  (cond
((/= Ovalue nil)
(setq StopLoop T)
)
  )
)
((= 25 code)
(if (and (/= str "") (/= str nil) (/= str null))
(setq oValue str str nil)
)
(setq StopLoop T)
)
((= 2 code)
(cond
((<= 32 data)
(setq str (strcat str (princ (chr data))))
)
((and (< 0 (strlen str)) (= 8 data))
                        (setq str (substr str 1 (1- (strlen str))))
                        (princ (vl-list->string '(8 32 8))))
((= 13 data)
(if (and (/= str "") (/= str nil) (/= str null))
(setq oValue str str nil)
)
(setq StopLoop T)
)
            )
)
)
)
oValue
)
(defun ChangeText (obj2 text pt pt2 / obj obj3 obj4 ATT ObjTyp ObjBKName row2 col2 Columns rows2 pick pta ptb xmax xmin ymax ymin ss cnt CPt Sel EntData Ent EditList cnt Num Str tempList)
(setq Obj (vlax-ename->vla-object obj2)
      ObjTyp (vla-get-ObjectName obj)
  cnt 0)
(cond
((= ObjTyp "AcDbTable")
(setq Rows2 (vla-get-rows obj)
  Columns (vla-get-columns obj)
  XMIN (MIN (CAR pt)(CAR pt2))
  XMAX (MAX (CAR pt)(CAR pt2))
  YMIN (MIN (CADR pt)(CADR pt2))
  YMAX (MAX (CADR pt)(CADR pt2))
  LLB (list XMIN YMIN)
  URB (list XMAX YMAX)
  pick (list xmin ymin)
  Row2 -1
  Col2 -1)
(while (< col2 (- Columns 1))
(setq Col2 (+ col2 1))
(while (< row2 (- rows2 1))
(setq row2 (+ row2 1)
      pick2 (vlax-safearray->list (vlax-variant-value (vla-getcellextents obj row2 col2 0)))
  pta (list (nth 0 pick2) (nth 1 pick2))
  ptb (list (nth 9 pick2) (nth 10 pick2))
  LLA (list (car pta) (cadr ptb))
  URA (list (car ptb) (cadr pta))
  pick (midpnt pta ptb))
(if ; Code for crossing box from Kent1Cooper at http://discussion.autodesk.com/forums/thread.jspa?threadID=761481&tstart=0
  (and
(or
  (<= (car LLB) (car LLA) (car URB))
  (<= (car LLB) (car URA) (car URB))
); end or
(or
  (<= (cadr LLB) (cadr LLA) (cadr URB))
  (<= (cadr LLB) (cadr URA) (cadr URB))
); end or
  ); end and
  (ChangeTable (vlax-3d-point pick) oValue lwrleft uprright)  
); end if
)

(setq row2 -1)
)
)
((= ObjTyp "AcDbBlockReference")
(cond
((= pt2 nil)
(setq Obj (vlax-ename->vla-object (car (nentselp "" pt))))
(vla-put-textstring obj text)
)
(T   
(setq XMIN (MIN (CAR pt)(CAR pt2))
  XMAX (MAX (CAR pt)(CAR pt2))
  YMIN (MIN (CADR pt)(CADR pt2))
  YMAX (MAX (CADR pt)(CADR pt2))
  AttList (vlax-variant-value (vla-getattributes obj)))
(foreach Att (vlax-safearray->list AttList)
(setq tpt (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint att))))
(cond
((and (< XMIN (CAR tpt))(> XMAX (CAR tpt)) (< YMIN (CADR tpt))(> YMAX (CADR tpt)))
(vla-put-textstring att text)
)
)
 
                    )
               
)
)
)
((= ObjTyp "AcDbMLeader")
(setq ObjBKName (vla-get-ContentBlockName obj)
      ins_pt (osnap pt "_ins"))
(cond
((or (= ObjBKName "") (= ObjBKName nil) (= ObjBKName null))
(vla-put-textstring obj text)
)
(T
(cond
((= pt2 nil)
(setq ss (ssget pt))
)
(T
(setq ss (ssget "_C" pt pt2))
)
)
(cond ; Code for adjusting mleaders with attributes in them modified from code by T.Willey at http://www.theswamp.org/index.php?topic=32152.msg376440#msg376440
((/= ss nil)
(while (< cnt (sslength ss))
(if
(and
(setq Sel (ssname ss Cnt))
(setq EntData (entget (setq Ent Sel)))
(= (cdr (assoc 0 EntData)) "MULTILEADER")
)
(progn
(foreach i EntData
;(setq tpt (cdr (assoc 10 (entget (cdr i)))))
;       ins_pt (osnap pt "_ins"))
; (cond
; ((= pt2 nil)
; (if (and (= (car tpt) (car ins_pt)) (= (cadr tpt) (cadr ins_pt)))
; (setq Cpt T)
; (setq Cpt nil)
; )
; )
; (T
; (if (and (< XMIN (CAR tpt))(> XMAX (CAR tpt)) (< YMIN (CADR tpt))(> YMAX (CADR tpt)))
; (setq Cpt T)
; (setq Cpt nil)
; )
; )
; )
(if
(and
(equal (car i) 330)
(equal (type (cdr i)) 'ENAME)
(= (cdr (assoc 0 (entget (cdr i)))) "ATTDEF")
)
(setq EditList
(cons
(list
i
(assoc 177 (member i EntData))
(assoc 302 (member i EntData))
)
EditList
)
)
)
)
)
)
(if EditList
(progn
(setq cnt 0)
(setq EditList (reverse EditList))
(foreach i EditList
(prompt
(strcat
"\n "
(itoa cnt)
" - "
(cdr (assoc 3 (entget (cdar i))))
" <"
(cdaddr i)
">: "
)
)
(setq cnt (1+ cnt))
)
(textscr)
(if
(and
(< -1 (setq Num (getint (strcat "\rEnter number of value to edit [0 - " (itoa (1- cnt)) "]: ")))  cnt)
(setq tempList (nth Num EditList))
)
(entmod
(mapcar
(function
(lambda ( x )
(if (equal x (cadr tempList))
(setq flag T)
)
(if
(and
flag
(equal (caddr tempList) x)
)
(progn
(setq flag nil)
(cons 302 text)
)
x
)
)
)
EntData
)
)
)
(graphscr)
)
)
(setq cnt (+ cnt 1))
)
)
)
)
)
)
((= (wcmatch ObjTyp "*Dimension*") T)
(vla-put-TextOverride obj text)
)
(T
(vla-put-textstring obj text)
)
)  
)

(defun ChangeTable (pick oValue lwrleft uprright)
(if (setq SS_TABLES (ssget "C" lwrleft uprright (list (cons 0 "ACAD_TABLE"))))
(progn
(setq cnt 0 eMax (sslength SS_TABLES))
(while (> eMax cnt)
   (setq table (vlax-ename->vla-object (ssname SS_TABLES cnt)))
   ;; Return values for what cell was picked in
   (setq row 0 col 0)
   ;; Check to see if a valid cell was picked
   (if (= (vla-hittest table pick vector 'row 'col) :vlax-true)
(progn
   ;; Check to see what the Cell Type is (Text or Block)
   (if (= (vlax-invoke-method table 'GetCellType row col) acTextCell)
(progn
   ;; Change the current value
   (vlax-invoke-method table 'SetText row col OValue)
   (vlax-invoke-method table 'Update)
   (setq Modified T)
   (setq cnt eMax)
  )
)
  )
)
(setq cnt (1+ cnt))
  )
)
)
)

(setq oValue (GetText))
(setq StopLoop nil)
(if (= inc nil)
(setq inc 0)
)
(while (= StopLoop nil)
(setq Modified nil      
      input (grread T 4 2))
(prompt (strcat "\rSelect Text or Cell to Overwrite <New text/Crossing/+ or - to change current increment of " (n2s Inc) "> (Current Value is: " oValue "): "))
(cond
((and (= (car input) 2) (or (= (cadr input) 99) (= (cadr input) 67)))
(setq Crossing T)
)
((and (= (car input) 2) (= (cadr input) 43))
(setq Inc (+ Inc 1))
(if (/= Inc 0)
(setq oValue (incr oValue Inc))
)
)
((and (= (car input) 2) (= (cadr input) 45))
(setq Inc (- Inc 1))
(if (/= Inc 0)
(setq oValue (incr oValue Inc))
)
)
((and (= (car input) 2) (or (= (cadr input) 110) (= (cadr input) 78)))
(setq oValue (GetText)
      StopLoop nil)
)
((or (= (car input) 3) (= Crossing T))
(cond
((= Crossing nil)
(setq pick (vlax-3d-point (cadr input)))
(ChangeTable pick oValue lwrleft uprright)
(cond
((= Modified nil)
(setq point2 (trans (cadr input) 1 0))
(setq cwset nil)
(setq cwset (ssget (cadr input)))
(cond
((/= cwset nil)
(setq obj (ssname cwset 0)
  cnt eMax)
(ChangeText obj oValue point2 nil)
(setq point2 nil)
)
(T
(setq Crossing T)
)
)
)
)
(if (/= Inc 0)
(setq oValue (incr oValue Inc))
)
)
(T
(if (= point2 nil)
(setq point2 (getpoint "\rSelect first corner of crossing box: "))
)
(setq point3 (getcorner point2 "\rSelect opposite corner of crossing box: ")
  flt '((-4 . "<OR") (0 . "TEXT") (0 . "MULTILEADER") (0 . "ACAD_TABLE") (0 . "*DIMENSION*") (0 . "MTEXT") (-4 . "<AND") (0 . "INSERT") (66 . 1) (-4 . "AND>") (-4 . "OR>"))
  cwset (ssget "_C" point2 point3 flt)
  ct 0)
(cond
((/= cwset nil)
(while (< ct (sslength cwset))
(setq obj (ssname cwset ct)
   ct (+ ct 1))
(ChangeText obj oValue point2 point3)
(if (/= Inc 0)
(setq oValue (incr oValue Inc))
)
)
)
(T
(alert "You didn't select anything to change!")
)
)
(setq Crossing nil
      point2 nil)
)
)
)
 
)
)
 (princ)
)

(defun midpnt (pt1 pt2)
(mapcar '(lambda (x y) (* 0.5 (+ x y))) pt1 pt2)
)
(defun N2S (NUM / Temp DcPt Cr CP); Converts Number to String, retaining appropriate number of decimal places
(setq Temp (rtos NUM 2 12)
  DcPt (vl-string-position (ascii ".") Temp)
  Cr (strlen Temp))
(while (and (> Cr 0) (= (substr Temp Cr 1) "0"))
(setq Cr (- Cr 1))
)
(if (< (- Cr DcPt) 0)
(setq CP 0)
(setq CP (- (- Cr DcPt) 1))
)
(rtos NUM 2 CP)
)

(defun incr (Text Inc / ct Tst Min Max StopLoop OrigText TempText NewText Increased)
(setq ct (strlen Text)
      x (- ct 1)
  Tst (ascii (substr Text ct 1)))  
(cond
((and (>= Tst 48) (<= Tst 57)); Numeric
(setq Min 48
      Max 57)
)
((and (>= Tst 65) (<= Tst 90)); Upper Case Text
(setq Min 65
      Max 90)
)
((and (>= Tst 97) (<= Tst 122)); Lower Case Text
(setq Min 97
      Max 122)
)
)
(while (and (> x 0) (= StopLoop nil))
(setq Tst (ascii (substr Text x 1)))
(if (not (or (and (>= Tst Min) (<= Tst Max)) (= Tst 46)))
(setq StopLoop T)
(setq x (- x 1))
)
)
(setq OrigText (substr Text (+ x 1))
      ct (strlen OrigText)
  x ct)
(cond
((and (>= Min 48) (<= Max 57))
(setq TempText (N2S (+ (atof OrigText) Inc)))
)
(T
(cond
((> inc 0)
(while (> x 0)
(setq Tst (ascii (substr OrigText x 1)))
(if (= Increased nil)
(progn
(if (<= Tst (- Max inc))
(progn
(if (= TempText nil)
(setq TempText (chr (+ Tst inc)))
(setq TempText (strcat (chr (+ Tst inc)) TempText))
)
(setq Increased T)
)
(progn
(if (= TempText nil)
(setq TempText (chr Min))
(setq TempText (strcat (chr Min) TempText))
)
)
)
)
(progn
(if (= TempText nil)
(setq TempText (chr Tst))
(setq TempText (strcat (chr Tst) TempText))
)
)
)
(setq x (- x 1))
)
)
((< inc 0)
(while (> x 0)
(setq Tst (ascii (substr OrigText x 1)))
(if (= Increased nil)
(progn
(if (>= Tst (- Min inc))
(progn
(if (= TempText nil)
(setq TempText (chr (+ Tst inc)))
(setq TempText (strcat (chr (+ Tst inc)) TempText))
)
(setq Increased T)
)
(progn
(if (= TempText nil)
(setq TempText (chr Min))
(setq TempText (strcat (chr Min) TempText))
)
)
)
)
(progn
(if (= TempText nil)
(setq TempText (chr Tst))
(setq TempText (strcat (chr Tst) TempText))
)
)
)
(setq x (- x 1))
)
)
)
)
)
(setq NewText (vl-string-subst TempText OrigText Text))
NewText
)