Author Topic: block x y independent scale dynamicly  (Read 12548 times)

0 Members and 1 Guest are viewing this topic.

Hugo

  • Bull Frog
  • Posts: 422
Re: block x y independent scale dynamicly
« Reply #15 on: September 05, 2012, 12:59:01 AM »
1x1 block must be drawn then it works

Block muss 1x1 gezeichnet sein dann funktioniert es

chlh_jd

  • Guest
Re: block x y independent scale dynamicly
« Reply #16 on: September 05, 2012, 07:30:45 AM »
Get an error message
Bekomme eine Fehlermeldung
Command: BLKDYNSCALE
Select a insert :*Cancel*
Command:
Command:
??: no function definition: OSMARK
See the link http://www.theswamp.org/index.php?topic=12813.0

chlh_jd

  • Guest
Re: block x y independent scale dynamicly
« Reply #17 on: September 05, 2012, 07:36:08 AM »
Why not simply:

Code: [Select]
(defun c:bs ( / e1 e2 l1 l2 )
    (if (and (setq e1 (car (entsel "\nSelect Block: ")))
             (= "INSERT" (cdr (assoc 0 (setq l1 (entget e1)))))
      ....
    )
    (princ)
)

Hi , Lee Mac .
Great demo , However It can't run correct in my ACAD2011 for 64Bit WIN7 SYS

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: block x y independent scale dynamicly
« Reply #18 on: September 05, 2012, 07:48:44 AM »
Sorry, yes the block must be 1x1 or smaller in dimension  :-(

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: block x y independent scale dynamicly
« Reply #19 on: September 05, 2012, 08:10:53 AM »
Sorry, yes the block must be 1x1 or smaller in dimension  :-(

AutoCAD can't scale independently drawing units... Anno scales are there just for wasting time on presentations...  :-(
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: block x y independent scale dynamicly
« Reply #20 on: September 05, 2012, 06:51:29 PM »
Here is my modification of Lee's code... It does thing with blocks that are not 1X1 units, but with some various dimensions of block - only thing after this routine, block scaling factors remain the same xscf=1.0 yscf=1.0 zscf=1.0, but dimensions are changed accordingly to desired picked corner point... Works also for rotated block...

Code - Auto/Visual Lisp: [Select]
  1. ;; Doug C. Broad, Jr.
  2. ;; can be used with vla-transformby to
  3. ;; transform objects from the UCS to the WCS
  4. (defun UCS2WCSMatrix ()
  5.     (append
  6.       (mapcar
  7.              '(lambda (vector origin)
  8.               (append (trans vector 1 0 t) (list origin))
  9.             )
  10.             (list '(1 0 0) '(0 1 0) '(0 0 1))
  11.             (trans '(0 0 0) 0 1)
  12.       )
  13.       (list '(0 0 0 1))
  14.     )
  15.   )
  16. )
  17. ;; transform objects from the WCS to the UCS
  18. (defun WCS2UCSMatrix ()
  19.     (append
  20.       (mapcar
  21.              '(lambda (vector origin)
  22.               (append (trans vector 0 1 t) (list origin))
  23.             )
  24.             (list '(1 0 0) '(0 1 0) '(0 0 1))
  25.             (trans '(0 0 0) 1 0)
  26.       )
  27.       (list '(0 0 0 1))
  28.     )
  29.   )
  30. )
  31.  
  32. (defun boundbox ( blk / ent minpt maxpt )
  33.   (if (eq (type blk) 'ENAME) (setq ent (vlax-ename->vla-object blk)))
  34.   (if blk
  35.     (progn
  36.       (vl-cmdf "_.UCS" "e" blk)
  37.       (vla-TransformBy ent (UCS2WCSMatrix))
  38.       (vla-getboundingbox ent 'minpoint 'maxpoint)
  39.       (vla-TransformBy ent (WCS2UCSMatrix))
  40.       (setq minpt (vlax-safearray->list minpoint))
  41.       (setq maxpt (vlax-safearray->list maxpoint))
  42.       (vl-cmdf "_.UCS" "p")
  43.     )
  44.   )
  45.   (list minpt maxpt)
  46. )
  47.  
  48. (defun scblk2unitblk ( blk / ent Xscf Yscf Zscf minpt maxpt dp )
  49.   (if (eq (type blk) 'ENAME) (setq ent (vlax-ename->vla-object blk)))
  50.   (setq Xscf (/ 1.0 (* (cos (angle (setq minpt (list (caar (boundbox blk)) (cadar (boundbox blk)))) (setq maxpt (list (caadr (boundbox blk)) (cadadr (boundbox blk)))))) (setq dp (distance minpt maxpt)))))
  51.   (setq Yscf (/ 1.0 (* (sin (angle minpt maxpt)) dp)))
  52.   (setq Zscf (/ 1.0 (if (eq (- (caddr (cadr (boundbox blk))) (caddar (boundbox blk))) 0.0) 1.0 (- (caddr (cadr (boundbox blk))) (caddar (boundbox blk))))))
  53.   (vla-put-XScaleFactor ent Xscf)
  54.   (vla-put-YScaleFactor ent Yscf)
  55.   (vla-put-ZScaleFactor ent Zscf)
  56.   (vla-put-Rotation ent 0.0)
  57. )
  58. ;|
  59. (defun scunitblk2blk ( blk / ent Xscf Yscf Zscf minpt maxpt dp )
  60.   (vl-load-com)
  61.   (if (eq (type blk) 'ENAME) (setq ent (vlax-ename->vla-object blk)))
  62.   (setq Xscf (* (cos (angle (setq minpt (list (caar (boundbox blk)) (cadar (boundbox blk)))) (setq maxpt (list (caadr (boundbox blk)) (cadadr (boundbox blk)))))) (setq dp (distance minpt maxpt))))
  63.   (setq Yscf (* (sin (angle minpt maxpt)) dp))
  64.   (setq Zscf (if (eq (- (caddr (cadr (boundbox blk))) (caddar (boundbox blk))) 0.0) 1.0 (- (caddr (cadr (boundbox blk))) (caddar (boundbox blk)))))
  65.   (vla-put-XScaleFactor ent Xscf)
  66.   (vla-put-YScaleFactor ent Yscf)
  67.   (vla-put-ZScaleFactor ent Zscf)
  68.   (vla-put-Rotation ent 0.0)
  69. )
  70. |;
  71. (defun c:bs ( / e1 e2 e3ss l1 l2 )
  72.     (vl-cmdf "_.UCS" "w")
  73.     (if (and (setq e1 (car (entsel "\nSelect Block: ")))
  74.              (= "INSERT" (cdr (assoc 0 (setq l1 (entget e1)))))
  75.         )
  76.         (progn
  77.             (setq e2 (entlast))
  78.             (vl-cmdf "_.UCS" "e" e1)
  79.             (vl-cmdf "_.UCS" "w")
  80.             (scblk2unitblk e1)
  81.             (vl-cmdf "_.explode" e1)
  82.             (setq e3ss (ssget "_P"))
  83.             (vl-cmdf "_.-block" (cdr (assoc 02 l1)) "_Y" "_non" (cdr (assoc 10 l1)) e3ss "")
  84.             (vl-cmdf "_.UCS" "p")
  85.             (vl-catch-all-apply 'vl-cmdf
  86.                 (list "_.-insert"
  87.                     (cdr (assoc 02 l1)) "_R" "0.0" "_non"
  88.                     '(0.0 0.0 0.0) "_C" "\\"
  89.                 )
  90.             )
  91.             (if (and (not (eq e2 (setq e2 (entlast))))
  92.                      (= "INSERT" (cdr (assoc 0 (setq l2 (entget e2)))))
  93.                 )
  94.                 (progn
  95.                     (vl-cmdf "_.UCS" "w")
  96.                     (vl-cmdf "_.rotate" e2 "" (cdr (assoc 10 l1)) (- (cvunit (cdr (assoc 50 l1)) "radians" "degrees")))
  97.                     (vl-cmdf "_.explode" e2)
  98.                     (entdel e2)
  99.                     (setq e3ss (ssget "_P"))
  100.                     (entdel e2)
  101.                     (vl-cmdf "_.-block" (cdr (assoc 02 l1)) "_Y" (cdr (assoc 10 l1)) e3ss "")
  102.                     (vl-cmdf "_.UCS" "p")
  103.                     (vl-cmdf "_.-insert" (cdr (assoc 02 l1)) "_R" "0.0" "_non" '(0.0 0.0 0.0) "1.0" "")
  104.                     (entmod (subst (assoc 8 l1) (assoc 8 (entget (entlast))) (entget (entlast))))
  105.                     (if (assoc 62 l1) (entmod (append (list (assoc 62 l1)) (entget (entlast)))))
  106.                     (entupd (entlast))
  107.                 )
  108.             )
  109.         )
  110.         (alert "\nPick block - picked object wasn't block entity")
  111.     )
  112.     (vl-cmdf "_.UCS" "p")
  113.     (vl-cmdf "_.UCS" "p")
  114.     (princ)
  115. )
  116.  

Regards, M.R. :-P
« Last Edit: September 07, 2012, 07:13:34 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Hugo

  • Bull Frog
  • Posts: 422
Re: block x y independent scale dynamicly
« Reply #21 on: September 06, 2012, 12:45:06 AM »
Thanks for the Lisp

But if the block is not drawn 1x1 is the same as happened in Lee's Lisp.
Does not exist.


Danke für das Lisp

Aber wenn der block nicht 1x1 gezeichnet ist passiert das gleich wie bei Lee seinen Lisp.
Funktioniert leider auch nicht.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: block x y independent scale dynamicly
« Reply #22 on: September 06, 2012, 05:20:16 AM »
I've tested it on my netbook A2009 and it works... Please, if you can't get result with my - Lee's modified code on other AutoCAD versions with some other configurations, inform me... Here it seems to work OK... Note that your block must be with base point on lower left corner of its bounding box...

Please, respond...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Hugo

  • Bull Frog
  • Posts: 422
Re: block x y independent scale dynamicly
« Reply #23 on: September 06, 2012, 05:29:11 AM »
Thank you now it works perfectly.
Do not know why but it works.
Thank you

Danke jetzt funktioniert es perfekt.
Weiß zwar nicht warum aber es läuft.
Danke

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: block x y independent scale dynamicly
« Reply #24 on: September 07, 2012, 07:15:09 AM »
For A2008 and lower (not tested) - the trick is in line (vl-cmdf "_.explode" e1) - A2009 and higher and (vl-cmdf "_.explode" e1 "") - A2008 :

Code - Auto/Visual Lisp: [Select]
  1. ;; Doug C. Broad, Jr.
  2. ;; can be used with vla-transformby to
  3. ;; transform objects from the UCS to the WCS
  4. (defun UCS2WCSMatrix ()
  5.     (append
  6.       (mapcar
  7.              '(lambda (vector origin)
  8.               (append (trans vector 1 0 t) (list origin))
  9.             )
  10.             (list '(1 0 0) '(0 1 0) '(0 0 1))
  11.             (trans '(0 0 0) 0 1)
  12.       )
  13.       (list '(0 0 0 1))
  14.     )
  15.   )
  16. )
  17. ;; transform objects from the WCS to the UCS
  18. (defun WCS2UCSMatrix ()
  19.     (append
  20.       (mapcar
  21.              '(lambda (vector origin)
  22.               (append (trans vector 0 1 t) (list origin))
  23.             )
  24.             (list '(1 0 0) '(0 1 0) '(0 0 1))
  25.             (trans '(0 0 0) 1 0)
  26.       )
  27.       (list '(0 0 0 1))
  28.     )
  29.   )
  30. )
  31.  
  32. (defun boundbox ( blk / ent minpt maxpt )
  33.   (if (eq (type blk) 'ENAME) (setq ent (vlax-ename->vla-object blk)))
  34.   (if blk
  35.     (progn
  36.       (vl-cmdf "_.UCS" "e" blk)
  37.       (vla-TransformBy ent (UCS2WCSMatrix))
  38.       (vla-getboundingbox ent 'minpoint 'maxpoint)
  39.       (vla-TransformBy ent (WCS2UCSMatrix))
  40.       (setq minpt (vlax-safearray->list minpoint))
  41.       (setq maxpt (vlax-safearray->list maxpoint))
  42.       (vl-cmdf "_.UCS" "p")
  43.     )
  44.   )
  45.   (list minpt maxpt)
  46. )
  47.  
  48. (defun scblk2unitblk ( blk / ent Xscf Yscf Zscf minpt maxpt dp )
  49.   (if (eq (type blk) 'ENAME) (setq ent (vlax-ename->vla-object blk)))
  50.   (setq Xscf (/ 1.0 (* (cos (angle (setq minpt (list (caar (boundbox blk)) (cadar (boundbox blk)))) (setq maxpt (list (caadr (boundbox blk)) (cadadr (boundbox blk)))))) (setq dp (distance minpt maxpt)))))
  51.   (setq Yscf (/ 1.0 (* (sin (angle minpt maxpt)) dp)))
  52.   (setq Zscf (/ 1.0 (if (eq (- (caddr (cadr (boundbox blk))) (caddar (boundbox blk))) 0.0) 1.0 (- (caddr (cadr (boundbox blk))) (caddar (boundbox blk))))))
  53.   (vla-put-XScaleFactor ent Xscf)
  54.   (vla-put-YScaleFactor ent Yscf)
  55.   (vla-put-ZScaleFactor ent Zscf)
  56.   (vla-put-Rotation ent 0.0)
  57. )
  58. ;|
  59. (defun scunitblk2blk ( blk / ent Xscf Yscf Zscf minpt maxpt dp )
  60.   (vl-load-com)
  61.   (if (eq (type blk) 'ENAME) (setq ent (vlax-ename->vla-object blk)))
  62.   (setq Xscf (* (cos (angle (setq minpt (list (caar (boundbox blk)) (cadar (boundbox blk)))) (setq maxpt (list (caadr (boundbox blk)) (cadadr (boundbox blk)))))) (setq dp (distance minpt maxpt))))
  63.   (setq Yscf (* (sin (angle minpt maxpt)) dp))
  64.   (setq Zscf (if (eq (- (caddr (cadr (boundbox blk))) (caddar (boundbox blk))) 0.0) 1.0 (- (caddr (cadr (boundbox blk))) (caddar (boundbox blk)))))
  65.   (vla-put-XScaleFactor ent Xscf)
  66.   (vla-put-YScaleFactor ent Yscf)
  67.   (vla-put-ZScaleFactor ent Zscf)
  68.   (vla-put-Rotation ent 0.0)
  69. )
  70. |;
  71. (defun c:bs ( / e1 e2 e3ss l1 l2 )
  72.     (vl-cmdf "_.UCS" "w")
  73.     (if (and (setq e1 (car (entsel "\nSelect Block: ")))
  74.              (= "INSERT" (cdr (assoc 0 (setq l1 (entget e1)))))
  75.         )
  76.         (progn
  77.             (setq e2 (entlast))
  78.             (vl-cmdf "_.UCS" "e" e1)
  79.             (vl-cmdf "_.UCS" "w")
  80.             (scblk2unitblk e1)
  81.             (vl-cmdf "_.explode" e1 "")
  82.             (setq e3ss (ssget "_P"))
  83.             (vl-cmdf "_.-block" (cdr (assoc 02 l1)) "_Y" "_non" (cdr (assoc 10 l1)) e3ss "")
  84.             (vl-cmdf "_.UCS" "p")
  85.             (vl-catch-all-apply 'vl-cmdf
  86.                 (list "_.-insert"
  87.                     (cdr (assoc 02 l1)) "_R" "0.0" "_non"
  88.                     '(0.0 0.0 0.0) "_C" "\\"
  89.                 )
  90.             )
  91.             (if (and (not (eq e2 (setq e2 (entlast))))
  92.                      (= "INSERT" (cdr (assoc 0 (setq l2 (entget e2)))))
  93.                 )
  94.                 (progn
  95.                     (vl-cmdf "_.UCS" "w")
  96.                     (vl-cmdf "_.rotate" e2 "" (cdr (assoc 10 l1)) (- (cvunit (cdr (assoc 50 l1)) "radians" "degrees")))
  97.                     (vl-cmdf "_.explode" e2 "")
  98.                     (entdel e2)
  99.                     (setq e3ss (ssget "_P"))
  100.                     (entdel e2)
  101.                     (vl-cmdf "_.-block" (cdr (assoc 02 l1)) "_Y" (cdr (assoc 10 l1)) e3ss "")
  102.                     (vl-cmdf "_.UCS" "p")
  103.                     (vl-cmdf "_.-insert" (cdr (assoc 02 l1)) "_R" "0.0" "_non" '(0.0 0.0 0.0) "1.0" "")
  104.                     (entmod (subst (assoc 8 l1) (assoc 8 (entget (entlast))) (entget (entlast))))
  105.                     (if (assoc 62 l1) (entmod (append (list (assoc 62 l1)) (entget (entlast)))))
  106.                     (entupd (entlast))
  107.                 )
  108.             )
  109.         )
  110.         (alert "\nPick block - picked object wasn't block entity")
  111.     )
  112.     (vl-cmdf "_.UCS" "p")
  113.     (vl-cmdf "_.UCS" "p")
  114.     (princ)
  115. )
  116.  

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube