Topic: Uniformly Scaled Drawings

[Harrie]

I know how I can see that the block reference is prevented from being non-uniformly scaled.

Code: [Select]

(defun IsUniform (BlockName /)
  (vl-load-com)
  (= acUniform
     (vla-get-blockscaling
       (vla-item (vla-get-blocks
  (vla-get-activedocument (vlax-get-acad-object))
)
BlockName
       )
     )
  )
)
When write such a block with the command WBLOCK to the harddisk,
how can I see that the drawing is prevented from being non-uniformly scaled.

Code: [Select]

(if Uniform (command "_.INSERT" BlockName pause "1" "0")
(command "_.INSERT" BlockName pause "1" "1" "0"))

Regards Harrie.

[HofCAD]

It is not elegant, but it works.

Code: [Select]

(defun c:InsBlk (/ @UFS BlockName ~Att)
  (defun @UFS (BlockName)
    (vl-load-com)
    (vla-get-BlockScaling
      (vla-item
(vla-get-blocks
 (vla-get-activedocument
   (vlax-get-acad-object)
 )
)
BlockName
      )
    )
  )
 (setq BlockName (getstring "\n Enter block name:"))
  (if (or (tblsearch "BLOCK" BlockName)
 (findfile (strcat BlockName ".dwg"))
      )
    (progn
      (setq ~Att (getvar "ATTREQ"))
      (setvar "ATTREQ" 0)
      (command "_.INSERT" BlockName)
      (command);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;not elegant
      (If (= (@UFS BlockName) 1)
(command "_.INSERT" BlockName pause "1" "0")
(command "_.INSERT" BlockName pause "1" "1" "0")
      )
      (setvar "ATTREQ" ~Att)
    )
    (princ (strcat "\nFile " BlockName ".dwg is not in search path."))
  )
  (princ)
)
Instead of the above @UFS you can use:

Code: [Select]

(defun @UFS (BlockName)
  (cdr
    (assoc 281
  (entget (cdr (assoc 330 (entget (tblobjname "BLOCK" BlockName))))
  )
    )
  )
)
HofCAD CSI