topic block clculate in Visual LISP, AutoLISP and General Customization Forum

block clculate

dvir860 — Sun, 03 Nov 2019 12:32:13 GMT

I have a block with values T.L, I.L, H and D when H automatically calculates the difference between T.L and I.L

I want D value to be dependent on H under the following conditions:
If H is less than 80 then D = 60
If H is between 80 and 125 then D = 80
If H is between 125 and 250 then D = 100
If H is greater than 250 then D = 125

How can I do this? Would appreciate help..

Attached is the block I am working on.

Re: block clculate

Kent1Cooper — Sun, 03 Nov 2019 15:05:15 GMT

(setq D

(cond

((< H 80) 60)

((< H 125) 80)

((< H 250) 100)

(125)

); cond

); setq

You need to decide whether a value of exactly 125 falls in the category of "between 80 and 125" or that of "between 125 and 250", that is, whether to use (<=) functions instead of (<).

Re: block clculate

marko_ribar — Sun, 03 Nov 2019 16:36:22 GMT

Here try this...

I played with object reactor, and I used only < function in diesel expression... So load lisp and type : REACT... From that point until you finish session it should update D whenever H changes, just be sure to use REGEN command after modification...

(defun D:ObjReactor ( owner reactor lstename / h b a )
  (setq h (cdr (assoc 1 (entget (vlax-vla-object->ename owner)))))
  (setq b (cdr (assoc 330 (entget (vlax-vla-object->ename owner)))))
  (setq a b)
  (while (setq a (entnext a))
    (if (and (= (cdr (assoc 0 (entget a))) "ATTRIB") (= (cdr (assoc 2 (entget a))) "D"))
      (entupd (cdr (assoc -1 (entmod (subst (cons 1 (strcat "%%C" "%<$(if,$(<, " h ", 80),60,$(if,$(and, $(>, " h ", 80), $(<, " h ", 125)),80,$(if,$(and, $(>, " h ", 125), $(<, " h ", 250)),100,$(if, $(>, " h ", 250),125))))>%")) (assoc 1 (entget a)) (entget a))))))
    )
  )
  (entupd b)
  (princ)
)

(defun c:react ( / collectowners )

  (vl-load-com)

  (defun collectowners ( / ss bl a al )
    (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
    (setq bl (vl-remove-if-not '(lambda ( x ) (= (vla-get-effectivename (vlax-ename->vla-object x)) "G_LABELD")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
    (foreach b bl
      (setq a b)
      (while (setq a (entnext a))
        (if (and (= (cdr (assoc 0 (entget a))) "ATTRIB") (= (cdr (assoc 2 (entget a))) "H"))
          (setq al (cons (cdr (assoc 5 (entget a))) al))
        )
      )
    )
    al
  )

  (vlr-remove-all)
  (setq *TheReactor* (vlr-object-reactor (mapcar 'vlax-ename->vla-object (mapcar 'handent (collectowners))) "Object Reactor" '((:VLR-modified . D:ObjReactor))))
  (princ)
)

HTH., M.R.

Re: block clculate

dvir860 — Tue, 05 Nov 2019 09:34:38 GMT

It doesn't work out with the 2 solutions shown in the comments above. What didn't I do right? What processes do I need to take for the solutions to work?

Dvir

Re: block clculate

marko_ribar — Tue, 05 Nov 2019 10:39:42 GMT

I've mod. it slightly... Like I said open DWG, load react.lsp, type REACT and then just type REGEN... It should update both H and D... Also when you want to change H and D, when you enter attedit by double clicking on block, when you change values of T.* attributes click on OK, not Apply... Then when CAD updates changes, just type REGEN again for D and H to update...

(defun D:ObjReactor ( owner reactor lstename / h b a )

  (vl-load-com)

  (setq h (cdr (assoc 1 (entget (vlax-vla-object->ename owner)))))
  (setq b (cdr (assoc 330 (entget (vlax-vla-object->ename owner)))))
  (setq a b)
  (while (setq a (entnext a))
    (if (and (= (cdr (assoc 0 (entget a))) "ATTRIB") (= (cdr (assoc 2 (entget a))) "D"))
      (entupd (cdr (assoc -1 (entmod (subst (cons 1 (strcat "%%C" "%<$(if,$(<, " h ", 80),60,$(if,$(<, " h ", 125),80,$(if,$(<, " h ", 250),100,125)))>%")) (assoc 1 (entget a)) (entget a))))))
    )
  )
  (entupd b)
  (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
  (princ)
)

(defun c:react ( / collectowners )

  (vl-load-com)

  (defun collectowners ( / ss bl a al )
    (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
    (setq bl (vl-remove-if-not '(lambda ( x ) (= (vla-get-effectivename (vlax-ename->vla-object x)) "G_LABELD")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
    (foreach b bl
      (setq a b)
      (while (setq a (entnext a))
        (if (and (= (cdr (assoc 0 (entget a))) "ATTRIB") (= (cdr (assoc 2 (entget a))) "H"))
          (setq al (cons (cdr (assoc 5 (entget a))) al))
        )
      )
    )
    al
  )

  (vlr-remove-all)
  (setq *TheReactor* (vlr-object-reactor (mapcar 'vlax-ename->vla-object (mapcar 'handent (collectowners))) "Object Reactor" '((:VLR-modified . D:ObjReactor))))
  (princ)
)

Re: block clculate

dvir860 — Tue, 05 Nov 2019 11:12:08 GMT

It works well for me only when I have one block in drawing but doesn't work for me when I have more than one block. Is it possible to have the same for multiple blocks in one drawing?

Re: block clculate

marko_ribar — Tue, 05 Nov 2019 14:21:40 GMT

Here, try this mod... If you go through diesel or field expressions, CAD will crash...

(defun H:ObjReactor ( owner reactor lstename / h d b a )

  (vl-load-com)

  (setq h (cdr (assoc 1 (entget (vlax-vla-object->ename owner)))))
  (setq d
    (cond
      ( (< (atof h) 80)
        60
      )
      ( (< (atof h) 125)
        80
      )
      ( (< (atof h) 250)
        100
      )
      ( t 125 )
    )
  )
  (setq b (cdr (assoc 330 (entget (vlax-vla-object->ename owner)))))
  (setq a b)
  (while (setq a (entnext a))
    (if (and (= (cdr (assoc 0 (entget a))) "ATTRIB") (= (cdr (assoc 2 (entget a))) "D"))
      (entupd (cdr (assoc -1 (entmod (subst (cons 1 (strcat "%%C" (itoa d))) (assoc 1 (entget a)) (entget a))))))
    )
  )
  (princ)
)

(defun c:react ( / collectowners )

  (vl-load-com)

  (defun collectowners ( / ss bl a al )
    (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
    (setq bl (vl-remove-if-not '(lambda ( x ) (= (vla-get-effectivename (vlax-ename->vla-object x)) "G_LABELD")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
    (foreach b bl
      (setq a b)
      (while (setq a (entnext a))
        (if (and (= (cdr (assoc 0 (entget a))) "ATTRIB") (= (cdr (assoc 2 (entget a))) "H"))
          (setq al (cons a al))
        )
      )
    )
    al
  )

  (vlr-remove-all)
  (setq *TheReactor* (vlr-object-reactor (mapcar 'vlax-ename->vla-object (collectowners)) "Object Reactor" '((:VLR-modified . H:ObjReactor))))
  (princ)
)