Create Area that updates with moving a dimension

April 9, 2010

I shall have a look, in the mean time, here is another to play with

Out done, but good stuff.

April 9, 2010

Try this:

Good idea.

April 9, 2010

Cheers dude - I just got carried away, wasn't trying to outdo you

April 9, 2010

My final offering, should now create slots correctly

;; Obj     => VLA-Object
;; Offset  => Real
;; Mode    => Integer
;; 0 = Rectangle, 1 = Circle, 2 = Slot

(defun BoxObject (obj offset Mode / MakeSafearrayVariant AddClosedLWPoly
                                   GetBoundingBox GetActiveSpace ll ur c p)
 ;; Lee Mac  ~  09.04.10

 (defun MakeSafearrayVariant (typ val)
   (vlax-make-variant
     (vlax-safearray-fill
       (vlax-make-safearray (eval typ)
         (cons 1 (length val))) val)))

 (defun AddClosedLWPoly (block lst / o)
   (vla-put-Closed
     (setq o (vla-AddLightWeightPolyline block
               (MakeSafearrayVariant vlax-VbDouble
                 (apply (function append)
                        (mapcar
                          (function
                            (lambda (x)
                              (list (car x) (cadr x)))) lst))))) :vlax-true)
   o)

 (defun AddCircle (block cen rad)
   (vla-AddCircle block (vlax-3D-point cen) rad))

 (defun GetBoundingBox (ll ur o / data)
   (  (lambda (data)         
      (mapcar
        (function
          (lambda (funcs)
            (mapcar
              (function
                (lambda (func)
                  ((eval func) data))) funcs)))

        '(((lambda (x) (- (caar  x) o)) (lambda (x) (- (cadar  x) o)))
          ((lambda (x) (+ (caadr x) o)) (lambda (x) (- (cadar  x) o)))
          ((lambda (x) (+ (caadr x) o)) (lambda (x) (+ (cadadr x) o)))
          ((lambda (x) (- (caar  x) o)) (lambda (x) (+ (cadadr x) o))))))

     (mapcar (function vlax-safearray->list) (list ll ur))))

 (defun GetActiveSpace (doc)
   (if (or (eq AcModelSpace (vla-get-ActiveSpace doc))
           (eq :vlax-true   (vla-get-MSpace doc)))
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)))

 (vla-GetBoundingBox obj 'll 'ur)
 (setq bb (GetBoundingBox ll ur offset))

 (cond (  (or (= 0 Mode) (= 2 Mode))

          (setq p (AddClosedLWPoly
                    (GetActiveSpace
                      (vla-get-ActiveDocument
                        (vlax-get-acad-object))) bb))

          (if (= 2 Mode)            
            (mapcar
              (function
                (lambda (v) (vla-SetBulge p v 1.)))

              (if (> (abs (- (caar  bb) (caadr bb)))
                     (abs (- (cadar bb) (cadr (caddr bb))))) '(1 3) '(0 2))))
          p)

       (  (AddCircle
            (GetActiveSpace
              (vla-get-ActiveDocument
                (vlax-get-acad-object)))

            (setq c (append (mapcar (function /)
                                    (apply (function mapcar)
                                           (cons (function +) bb))
                                    '(4. 4.))
                            '(0.)))

            (distance c (car bb))))))



(defun c:test (/ l ss o m)
 (vl-load-com)
 (setq l '("Rectangle" "Circle" "Slot"))
 
 (if (and (setq ss (ssget))
          (setq o  (getdist "\nOffset? : ")))
   (progn
     (initget 1 "Rectangle Circle Slot")
     (setq m (vl-position (getkword "\nBox With [Rectangle/Circle/Slot]: ") l))

     (  (lambda (count)
          (while (setq e (ssname ss (setq count (1+ count))))
            (BoxObject (vlax-ename->vla-object e) o m))) -1)))
 (princ))

Enjoy

April 9, 2010

Works perfect! I was passing the wrong variable.

April 9, 2010

Cheers dude - I just got carried away, wasn't trying to outdo you

Oh, not at all.

I leapfrogged off your boundingbox idea and so on.

April 9, 2010

Excellent

April 9, 2010

Thank you both for all your help.

April 9, 2010

Could I ask for one more thing?

I would like to put the info in this block.

farea.dwg

April 9, 2010

This will provide both options

(defun c:hsw  (/ *error* lst->str DOC ENT IDS PT SS UFLAG mTxt)
 (vl-load-com)
 ;; Lee Mac  ~  18.03.10

 (defun *error*  (msg)
   (and uFlag (vla-EndUndomark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun GetObjectID  (obj)
   (setq util (cond (util)
                    ((vla-get-Utility
                       (vla-get-ActiveDocument (vlax-get-acad-object))))))

   (if (vl-string-search "X64" (strcase (getvar 'PLATFORM)))
     (vlax-invoke-method util 'GetObjectIdString obj :vlax-false)
     (itoa (vla-get-Objectid obj))))

 (defun lst->str  (lst d1 d2)
   (if (cdr lst)
     (strcat d1 (car lst) d2 (lst->str (cdr lst) d1 d2))
     (strcat d1 (car lst))))

 (princ "\nSelect Dimensions to Retrieve Total Area... ")
 (if (ssget '((0 . "DIMENSION")))
   (progn
     (setq uFlag (not (vla-StartUndoMark
                        (setq doc (vla-get-ActiveDocument
                                    (vlax-get-acad-object))))))

     (vlax-for obj  (setq ss (vla-get-ActiveSelectionSet doc))
       (setq Ids (cons (GetObjectID obj) Ids)))
     (vla-delete ss)

     (setq str  (if (= 1 (length Ids))
                  (strcat "%<\\AcObjProp Object(%<\\_ObjId " (car Ids)
                          ">%).Measurement \\f \"%lu6%qf1\">%")
                  (strcat "%<\\AcExpr"
                          (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId "
                                    ">%).Measurement >% *")
                          ">%).Measurement >% \\f \"%lu2%pr0\"/144*4>%")))
     (while
       (progn
         (initget "Point")
         (setq ent (nentsel "\nSelect Attrib/Text [Point]: "))

         (cond (  (vl-consp ent)

                  (if (wcmatch (cdr (assoc 0 (entget (car ent)))) "ATTRIB,*TEXT")
                    (progn
                      (vla-put-TextString (vlax-ename->vla-object (car ent)) str)
                      (vla-regen doc acActiveViewport))

                    (princ "\n** Invalid Object Selected **")))

               (  (eq "Point" ent)

                  (initget "Attrib")
                  (setq pt (getpoint "\nSelect Point for Field [Attrib]: "))

                  (cond (  (vl-consp pt)

                           (vla-put-AttachmentPoint

                             (setq mTxt (vla-AddMText
                                          
                                          (if (or (eq AcModelSpace (vla-get-ActiveSpace doc))
                                                  (eq :vlax-true (vla-get-MSpace doc)))
                                            (vla-get-ModelSpace doc)
                                            (vla-get-PaperSpace doc))
                                          
                                          (vlax-3D-point pt) 0. str))

                                   acAttachmentPointMiddleCenter)

                           (vla-put-InsertionPoint mTxt (vlax-3D-point pt))
                           (BoxObject mTxt 0.35)

                         nil)

                        (t ))))))

     (setq uFlag (vla-EndUndomark doc))))

 (princ))


(defun BoxObject (obj offset / MakeSafearrayVariant LWPoly
                              GetBoundingBox GetActiveSpace ll ur)
 ;; Lee Mac  ~  09.04.10

 (defun MakeSafearrayVariant (typ val)
   (vlax-make-variant
     (vlax-safearray-fill
       (vlax-make-safearray (eval typ)
         (cons 1 (length val))) val)))

 (defun AddClosedLWPoly (block lst / o)
   (vla-put-Closed
     (setq o (vla-AddLightWeightPolyline block
               (MakeSafearrayVariant vlax-VbDouble
                 (apply (function append)
                        (mapcar
                          (function
                            (lambda (x)
                              (list (car x) (cadr x)))) lst))))) :vlax-true)
   o)

 (defun GetBoundingBox (ll ur o / data)
   (  (lambda (data)         
      (mapcar
        (function
          (lambda (funcs)
            (mapcar
              (function
                (lambda (func)
                  ((eval func) data))) funcs)))

        '(((lambda (x) (- (caar  x) o)) (lambda (x) (- (cadar  x) o)))
          ((lambda (x) (+ (caadr x) o)) (lambda (x) (- (cadar  x) o)))
          ((lambda (x) (+ (caadr x) o)) (lambda (x) (+ (cadadr x) o)))
          ((lambda (x) (- (caar  x) o)) (lambda (x) (+ (cadadr x) o))))))

     (mapcar (function vlax-safearray->list) (list ll ur))))

 (defun GetActiveSpace (doc)
   (if (or (eq AcModelSpace (vla-get-ActiveSpace doc))
           (eq :vlax-true   (vla-get-MSpace doc)))
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)))

 (vla-GetBoundingBox obj 'll 'ur)
 (AddClosedLWPoly
   (GetActiveSpace
     (vla-get-ActiveDocument
       (vlax-get-acad-object))) (GetBoundingBox ll ur offset)))

April 12, 2010

I finally figured out how to edit that attribute in the block. I modified an older lisp routine I had. This one insert the block farea and edits the attribute and updates the field. Thanks for all your help. This code is a using a lot from Lee Mac. Lee can you make sure I have give credit correctly please.

(defun c:hsw  (/ *error* lst->str DOC ENT IDS PT SS UFLAG mTxt)
 (vl-load-com)
 ;; Lee Mac  ~  18.03.10

 (defun *error*  (msg)
   (and uFlag (vla-EndUndomark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun GetObjectID  (obj)
   (setq util (cond (util)
                    ((vla-get-Utility
                       (vla-get-ActiveDocument (vlax-get-acad-object))))))

   (if (vl-string-search "X64" (strcase (getvar 'PLATFORM)))
     (vlax-invoke-method util 'GetObjectIdString obj :vlax-false)
     (itoa (vla-get-Objectid obj))))

 (defun lst->str  (lst d1 d2)
   (if (cdr lst)
     (strcat d1 (car lst) d2 (lst->str (cdr lst) d1 d2))
     (strcat d1 (car lst))))

 (princ "\nSelect Dimensions to Retrieve Total Area... ")
 (if (ssget '((0 . "DIMENSION")))
   (progn
     (setq uFlag (not (vla-StartUndoMark
                        (setq doc (vla-get-ActiveDocument
                                    (vlax-get-acad-object))))))

     (vlax-for obj  (setq ss (vla-get-ActiveSelectionSet doc))
       (setq Ids (cons (GetObjectID obj) Ids)))
     (vla-delete ss)

     (setq str  (if (= 1 (length Ids))
                  (strcat "%<\\AcObjProp Object(%<\\_ObjId " (car Ids)
                          ">%).Measurement \\f \"%lu6%qf1\">%")
                  (strcat "%<\\AcExpr"
                          (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId "
                                    ">%).Measurement >% *")
                          ">%).Measurement >% \\f \"%lu2%pr0\"/144*4>%")))
     
  ;-----------------------------------------------------------------------------
  ;MandDarran 4-12-10
  (command "layer" "m" "f-node" "")
  (command "setvar" "cmdecho" "0") 
  (setq VALUE str)
  (SETQ PT NIL)
  (setq valuenum (atoi VALUE))
  (SETQ PT (GETPOINT"\nInsertion point <enter to exit>:"))
  (COMMAND "INSERT" "farea" PT SCALE1 "" "" "")
(SETQ XX 0)
(WHILE (/= XX 2)
(setq a (ssget "L"))
(COND ((= XX 0 )
  (SETQ VAR1 50)
  (SETQ TS 0)
  ))
(COND ((= XX 1 )
   (SETQ VAR1 1)
   (SETQ TS VALUE)
  ))
(setq n (sslength a))
(setq index 0)
(repeat n
  (SETQ ENT1 (ENTGET (SSNAME A INDEX)))
  (setq index (1+ index))
  (IF
     (AND
    (= "INSERT" (CDR (ASSOC 0 ENT1)))
    (= 1 (CDR (ASSOC 66 ENT1)))
     )
       (progn
         (SETQ ENT2 (CAR ENT1))
       (SETQ ENT3 (CDR ENT2))
        (WHILE (/= "SEQEND" (CDR (ASSOC 0 (ENTGET ENT3))))
           (SETQ ENT4 (ENTNEXT ENT3))
           (SETQ OLD (CONS VAR1 (CDR (ASSOC VAR1 (ENTGET ENT4)))))
           (SETQ NEW (CONS VAR1 TS))
           (ENTMOD (SUBST NEW OLD (ENTGET ENT4)))
           (ENTUPD ENT4)
           (SETQ ENT3 ENT4)
        )
       )
  )
)
      (SETQ XX (1+ XX))
      )
     (setq uFlag (vla-EndUndomark doc))))
(command "updatefield" "all" "")
(princ))

April 13, 2010

Not a problem Matt, but did my last posted code not work for you?

April 13, 2010

It did, but not quite like I wanted. I wanted to be able to insert a block and edit that attribute with out having to select the attribute in the block.

April 13, 2010

It did, but not quite like I wanted. I wanted to be able to insert a block and edit that attribute with out having to select the attribute in the block.

I see - not a problem Matt

April 13, 2010

I had originally had to do three separate programs based on whether the head area calculation was from head to head or head to one wall or head to two walls, with the addition of the dimension association, that is now automatic!

April 13, 2010

Alternatively, try this Matt

(defun c:hsw  (/ *error* lst->str GetObjectID AddLayer GetActiveSpace AddBlock
                 BNME BOBJ BPT DOC ENT IDS LAYERNAME MTXT PT SS STR UFLAG UTIL)
 (vl-load-com)
 ;; Lee Mac  ~  18.03.10

 (setq bNme "f-area" layername "F-Node")

 (defun *error*  (msg)
   (and uFlag (vla-EndUndomark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun GetObjectID  (obj)
   (setq util (cond (util)
                    ((vla-get-Utility
                       (vla-get-ActiveDocument (vlax-get-acad-object))))))

   (if (vl-string-search "X64" (strcase (getvar 'PLATFORM)))
     (vlax-invoke-method util 'GetObjectIdString obj :vlax-false)
     (itoa (vla-get-Objectid obj))))

 (defun lst->str  (lst d1 d2)
   (if (cdr lst)
     (strcat d1 (car lst) d2 (lst->str (cdr lst) d1 d2))
     (strcat d1 (car lst))))

 (defun AddLayer (Name)
   (or (tblsearch "LAYER" Name)
       (vla-Add (vla-get-layers doc) Name)))

 (defun GetActiveSpace (doc)
   (if (or (eq AcModelSpace (vla-get-ActiveSpace doc))
           (eq :vlax-true   (vla-get-MSpace doc)))
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)))

 (defun AddBlock (Name Point)
   (vla-InsertBlock (GetActiveSpace doc)
     (vlax-3D-point Point) Name 1. 1. 1. 0.))      

 (cond (  (not (or (tblsearch "BLOCK" bNme)
                   (setq bNme (findfile (strcat bNme ".dwg")))))

          (princ "\n** Block not Found **"))

       (  (progn
            (princ "\nSelect Dimensions to Retrieve Total Area... ")
            (ssget '((0 . "DIMENSION"))))
        
          (setq uFlag (not (vla-StartUndoMark
                             (setq doc (vla-get-ActiveDocument
                                         (vlax-get-acad-object))))))

          (AddLayer LayerName)
        
          (vlax-for obj  (setq ss (vla-get-ActiveSelectionSet doc))
            (setq Ids (cons (GetObjectID obj) Ids)))
          (vla-delete ss)
          
          (setq str  (if (= 1 (length Ids))
                       (strcat "%<\\AcObjProp Object(%<\\_ObjId " (car Ids)
                               ">%).Measurement \\f \"%lu6%qf1\">%")
                       (strcat "%<\\AcExpr"
                         (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId "
                           ">%).Measurement >% *")
                           ">%).Measurement >% \\f \"%lu2%pr0\"/144*4>%")))
          (while
            (progn
              (initget "Point")
              (setq bPt (getpoint "\nSelect Point for Block [Point]: "))
              
              (cond (  (vl-consp bPt)

                       (setq bObj (AddBlock bNme bPt))
                       (vla-put-layer bObj layername)

                       (if (eq :vlax-true (vla-get-HasAttributes bObj))
                         (foreach att (vlax-safearray->list
                                        (vlax-variant-value
                                          (vla-getAttributes bObj)))
                           (vla-put-TextString att str)))
                     
                       nil)
                    
                    (  (eq "Point" bPt)
                     
                       (initget "Block")
                       (setq pt (getpoint "\nSelect Point for Field [block]: "))
                       
                       (cond (  (vl-consp pt)
                              
                                (vla-put-AttachmentPoint
                                  
                                  (setq mTxt (vla-AddMText
                                               
                                               (if (or (eq AcModelSpace (vla-get-ActiveSpace doc))
                                                       (eq :vlax-true (vla-get-MSpace doc)))
                                                 (vla-get-ModelSpace doc)
                                                 (vla-get-PaperSpace doc))
                                               
                                               (vlax-3D-point pt) 0. str))
                                  
                                  acAttachmentPointMiddleCenter)
                                
                                (vla-put-InsertionPoint mTxt (vlax-3D-point pt))
                                (vla-put-layer mTxt layername)
                                (BoxObject mTxt 0.35)
                                
                                nil)
                             
                             (t ))))))
          
          (setq uFlag (vla-EndUndomark doc))))

 (princ))


(defun BoxObject (obj offset / MakeSafearrayVariant LWPoly
                              GetBoundingBox GetActiveSpace ll ur)
 ;; Lee Mac  ~  09.04.10

 (defun MakeSafearrayVariant (typ val)
   (vlax-make-variant
     (vlax-safearray-fill
       (vlax-make-safearray (eval typ)
         (cons 1 (length val))) val)))

 (defun AddClosedLWPoly (block lst / o)
   (vla-put-Closed
     (setq o (vla-AddLightWeightPolyline block
               (MakeSafearrayVariant vlax-VbDouble
                 (apply (function append)
                        (mapcar
                          (function
                            (lambda (x)
                              (list (car x) (cadr x)))) lst))))) :vlax-true)
   o)

 (defun GetBoundingBox (ll ur o / data)
   (  (lambda (data)         
      (mapcar
        (function
          (lambda (funcs)
            (mapcar
              (function
                (lambda (func)
                  ((eval func) data))) funcs)))

        '(((lambda (x) (- (caar  x) o)) (lambda (x) (- (cadar  x) o)))
          ((lambda (x) (+ (caadr x) o)) (lambda (x) (- (cadar  x) o)))
          ((lambda (x) (+ (caadr x) o)) (lambda (x) (+ (cadadr x) o)))
          ((lambda (x) (- (caar  x) o)) (lambda (x) (+ (cadadr x) o))))))

     (mapcar (function vlax-safearray->list) (list ll ur))))

 (defun GetActiveSpace (doc)
   (if (or (eq AcModelSpace (vla-get-ActiveSpace doc))
           (eq :vlax-true   (vla-get-MSpace doc)))
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)))

 (vla-GetBoundingBox obj 'll 'ur)
 (AddClosedLWPoly
   (GetActiveSpace
     (vla-get-ActiveDocument
       (vlax-get-acad-object))) (GetBoundingBox ll ur offset)))

April 14, 2010

Thx. Works. I have modified mine to use the dimension associations so that it does a different calculation based on whether the coverage is a head to two walls, a head to a head and one wall and a head to a head to head.....

I add this at the end so that the fields update in the block (command "updatefield" "all" "")

April 14, 2010

Here is the code I pieced together:

;Using snip its from JohnM's and LeeMac's code.
;will list the two items that are attached to associative dimensions.
;JohnM

(defun getcount ()
; (while (not(setq ss (ssget "_:S" '((0 . "Dimension")(102 . "{ACAD_REACTORS"))))))
;   (if ss
;
(setq x 0)        
(setq sset (ssget "_P"))
(While (< x  2) 
(progn
           (setq ssnm (ssname sset x))
           ;JohnM
           ;MandDarran
           (setq datae (entget ssnm))
           (setq dataD (entget (cdr (assoc 330 dataE))))
           (setq dataDim (entget (cdr (assoc 331 dataD))))
           (setq dataDim2 (entget (entnext(cdr (assoc 331 dataD)))))
           (if (= (car item) 330)(setq lst1 (cons (cdr item) lst1)))
           (Setq lst1 '());_set up a blank list
           (foreach item datad
               (if (= (car item) 331)(setq lst1 (cons (cdr item) lst1)))
               );_foreach
           (setq assoc1 (car lst1))
           (setq assoc2 (cadr lst1)) 
           (setq obj1 (entget assoc1)) 
           (setq obj2 (entget assoc2)) 
           (setq lbl1 (cdr(assoc 0 obj1)))
           (setq lbl2 (cdr(assoc 0 obj2)))
           ;MandDarran
           ;JohnM
           (if (=(cdr(assoc 0 obj1))"INSERT")
                (progn
                (setq tsr(tblsearch "block" (cdr(assoc 2 obj1))))
                (if (=(cdr(assoc 70 tsr)) 0)
                   (setq count (+ 1 count)))
                );_progn
            );_if
            (if (=(cdr(assoc 0 obj2))"INSERT")
                (progn
                (setq tsr(tblsearch "block" (cdr(assoc 2 obj2))))
                (if (=(cdr(assoc 70 tsr)) 0)
                (setq count (+ 1 count)))
                );_progn
            );_if
           ; (alert (strcat "First Attachment to "lbl1 "\n" "Second Attachment to "lbl2))
            (princ)
            (setq x (+ 1 x))
        );_progn
);foreach
)
(princ)

(defun c:hsh  (/ *error* lst->str DOC ENT IDS PT SS UFLAG mTxt)
 (setq count 0)
(vl-load-com)
 ;; Lee Mac  ~  18.03.10

 (defun *error*  (msg)
   (and uFlag (vla-EndUndomark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun GetObjectID  (obj)
   (setq util (cond (util)
                    ((vla-get-Utility
                       (vla-get-ActiveDocument (vlax-get-acad-object))))))

   (if (vl-string-search "X64" (strcase (getvar 'PLATFORM)))
     (vlax-invoke-method util 'GetObjectIdString obj :vlax-false)
     (itoa (vla-get-Objectid obj))))

 (defun lst->str  (lst d1 d2)
   (if (cdr lst)
     (strcat d1 (car lst) d2 (lst->str (cdr lst) d1 d2))
     (strcat d1 (car lst))))

 (princ "\nSelect Dimensions to Retrieve Total Area... ")
 (if (ssget '((0 . "DIMENSION")))
   (progn
     (setq uFlag (not (vla-StartUndoMark
                        (setq doc (vla-get-ActiveDocument
                                    (vlax-get-acad-object))))))

     (vlax-for obj  (setq ss (vla-get-ActiveSelectionSet doc))
       (setq Ids (cons (GetObjectID obj) Ids)))
     (getcount)
     (vla-delete ss)
(if (= count 2)
(progn
     (setq str  (if (= 1 (length Ids))
                  (strcat "%<\\AcObjProp Object(%<\\_ObjId " (car Ids)
                          ">%).Measurement \\f \"%lu6%qf1\">%")
                  (strcat "%<\\AcExpr"
                          (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId "
                                    ">%).Measurement >% *")
                          ">%).Measurement >% \\f \"%lu2%pr0\"/144*4>%")))
                          );progn
                          );if
                          
   (if (= count 3)
   (progn  
     (setq str  (if (= 1 (length Ids))
                  (strcat "%<\\AcObjProp Object(%<\\_ObjId " (car Ids)
                          ">%).Measurement \\f \"%lu6%qf1\">%")
                  (strcat "%<\\AcExpr"
                          (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId "
                                    ">%).Measurement >% *")
                          ">%).Measurement >% \\f \"%lu2%pr0\"/144*2>%")))
                           );progn
                          );if
     
   (if (= count 4)
   (progn  
     
     (setq str  (if (= 1 (length Ids))
                  (strcat "%<\\AcObjProp Object(%<\\_ObjId " (car Ids)
                          ">%).Measurement \\f \"%lu6%qf1\">%")
                  (strcat "%<\\AcExpr"
                          (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId "
                                    ">%).Measurement >% *")
                          ">%).Measurement >% \\f \"%lu2%pr0\"/144>%")))
                           );progn
                           );if
  ;-----------------------------------------------------------------------------
  ;MandDarran 4-12-10
  (command "layer" "m" "f-node" "")
  (command "setvar" "cmdecho" "0") 
  (setq VALUE str)
  (SETQ PT NIL)
  (setq valuenum (atoi VALUE))
  (SETQ PT (GETPOINT"\nInsertion point <enter to exit>:"))
  (COMMAND "INSERT" "farea" PT SCALE1 "" "" "")
(SETQ XX 0)
(WHILE (/= XX 2)
(setq a (ssget "L"))
(COND ((= XX 0 )
  (SETQ VAR1 50)
  (SETQ TS 0)
  ))
(COND ((= XX 1 )
   (SETQ VAR1 1)
   (SETQ TS VALUE)
  ))
(setq n (sslength a))
(setq index 0)
(repeat n
  (SETQ ENT1 (ENTGET (SSNAME A INDEX)))
  (setq index (1+ index))
  (IF
     (AND
    (= "INSERT" (CDR (ASSOC 0 ENT1)))
    (= 1 (CDR (ASSOC 66 ENT1)))
     )
       (progn
         (SETQ ENT2 (CAR ENT1))
       (SETQ ENT3 (CDR ENT2))
        (WHILE (/= "SEQEND" (CDR (ASSOC 0 (ENTGET ENT3))))
           (SETQ ENT4 (ENTNEXT ENT3))
           (SETQ OLD (CONS VAR1 (CDR (ASSOC VAR1 (ENTGET ENT4)))))
           (SETQ NEW (CONS VAR1 TS))
           (ENTMOD (SUBST NEW OLD (ENTGET ENT4)))
           (ENTUPD ENT4)
           (SETQ ENT3 ENT4)
        )
       )
  )
)
      (SETQ XX (1+ XX))
      )
     (setq uFlag (vla-EndUndomark doc))))
(command "updatefield" "all" "")
(princ))

April 14, 2010

I am trying to create a reactor the will update the field when the head moves, but for some reason, nothing happens:

((= "MOVE" (strcase (car Args))) (VL-CMDF "updatefield" "all" ""))

April 14, 2010

OK Now this is driving me batty. For some reason my dimensions are no longer working. The variable dimassoc is set to 2 and when I move the object the dimension changes but the dimens no longer show associations...I have a routing that I found on the board to check for associative dimensions and it is listing those as NOT associated, yet when I move the object they update. What on earth has happened? I tried several different drawings and the same result. Is there another variable some where? Further it seems some dimensions are getting associations and some are not? This is driving me nuts.

Sign In

Create Area that updates with moving a dimension

Recommended Posts

alanjt

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

alanjt

Lee Mac

Lee Mac

manddarran

alanjt

Lee Mac

manddarran

manddarran

Lee Mac

manddarran

Lee Mac

manddarran

Lee Mac

manddarran

Lee Mac

manddarran

manddarran

manddarran

manddarran

Join the conversation

Tutorials

Forums

Activity