Lisp create ScaleBar from viewport (all scale)
(defun c:demo ( / VPScale blocks vp viewportScale bname ipoint)
(defun VPScale (e)
(cond
(
(and e
(eq "VIEWPORT" (cdr (assoc 0 (setq e (entget e)))))
)
(/ (cdr (assoc 45 e)) (cdr (assoc 41 e)))
)
)
)
(setq blocks '( (250.0 "A-GraphicalScale250")
(500.0 "A-GraphicalScale500")
(1000.0 "A-GraphicalScale1000")))
(if (and
(setq vp (car (entsel "\nSelect Viewport")))
(eq (cdr (assoc 0 (entget vp))) "VIEWPORT")
(setq viewportScale (VPScale vp))
(setq bname (vl-some '(lambda (s)
(if (equal viewportScale (Car s) 0.1) (Cadr s))) blocks))
(tblsearch "BLOCK" bname)
(setq ipoint (getpoint "\nPick point for scale bar")) ;<-- this can be hardcoded to a specific coordinate
)
(vlax-invoke (vlax-get
(vla-get-ActiveLayout (vla-get-activedocument
(vlax-get-acad-object)))
'Block)
'InsertBlock
ipoint
bname
1 1 1 0)
)
)
Or you can use a Dynamic block with visibility, that way you only need one block.
@Edwin.Saez wrote:
...When selecting the viewport, the bar with the scale of the viewport must be created....
Try this
(defun c:demo ( / bname vp isvport viewportScale scalebarblock ipoint)
;;; pBe Sep 2017 ;;;
(if (and
(setq vp (car (entsel "\nSelect Viewport")))
(setq isvport (eq (cdr (assoc 0 (setq vp (entget vp)))) "VIEWPORT"))
(setq bname (cdr (assoc 2 (tblsearch "BLOCK" "BLOCK")))) ;<-- your block name
(setq ipoint (getpoint "\nPick point for scale bar")) ;<-- this can be hardcoded to a specific coordinate
)
(progn
(setq viewportScale (/ (cdr (assoc 45 vp)) (cdr (assoc 41 vp))))
(setq attribfactor (* viewportScale 10.0))
(setq scalebarblock
(vlax-invoke (vlax-get
(vla-get-ActiveLayout (vla-get-activedocument
(vlax-get-acad-object)))
'Block) 'InsertBlock
ipoint bname 1 1 1 0))
(foreach itm (Vlax-invoke scalebarblock 'GetAttributes)
(cond
( (setq f (assoc (setq CurrentTag (Vla-get-tagstring itm))
'(("NUM01" . 2)("NUM02" . 1)("NUM03" . 2) ("NUM04" . 4)("NUM05" . 8))))
(vlax-put itm 'Textstring (rtos (* (cdr f) attribfactor) 2
(if (< attribfactor 1.0) 2 0)))
)
( (eq "FACTOR" CurrentTag)
(vlax-put itm 'Textstring (strcat "ESCALA 1 : "
(rtos (* viewportScale 1000) 2 0)))
)
)
)
)
(print
(cond
((null vp) "Failed to select Object")
((null isvport) "Invalid Selection")
((null bname) "Block not found")
((null ipoint) "No basepoint for block insertion"))
)
)
(princ)
)
HTH
it's great.
works fine, but do you think there would be a way that lisp does not depend on the block exists in the drawing?
maybe you could add a path from where you can load the block automatically, or maybe the lisp can contain the definition of the block?
any of them would be the solution for me!
Thank you for your help and patience.. 
@Edwin.Saez wrote:
works fine, but do you think there would be a way that lisp does not depend on the block exists in the drawing?
maybe you could add a path from where you can load the block automatically,
We would go for the first option, but the program still need to check for the existence of the block, first on the drawing itself, if that fails then from the source
(and
(setq bname
(cond
( bname )
( (cdr (assoc 2 (tblsearch "Block" "block")))) ;<-- your block name
( (findfile "T:\\Edwin\\block.dwg"))
)
)
(setq vp (car (entsel "\nSelect Viewport")))
(setq isvport (eq (cdr (assoc 0 (setq vp (entget vp)))) "VIEWPORT"))
(setq ipoint (getpoint "\nPick point for scale bar")) ;<-- this can be hardcoded to a specific coordinate
)
@Edwin.Saez wrote:
..maybe the lisp can contain the definition of the block?
That is certainly an option.
But we will stick with the first option.
HTH
@Edwin.Saez wrote:
could you tell me how to solve this error?
Open the file "D:\\escala\\BLOCK.dwg" select and explode the block. Save.
I'm guessing when you WBLOCK you use "Objects" as source rather than "Block", that is why you ended up with "BLOCK references itself"
@Edwin.Saez wrote:
... a problem arose, when selecting a viewport created from an irregular polyline, the lisp does not work.
can you help me with the solution?
(defun c:demo ( / bname vp isvport viewportScale scalebarblock ipoint) ;;; pBe Sep 2017 ;;; ;;; pBe Oct 2017 ;;;
(defun _isvport (ent / otype) (setq otype (cdr (assoc 0 ent))) (cond ( (and (= "VIEWPORT" otype) (< 1 (cdr (assoc 69 ent)))) ent ) ( (and (= "LWPOLYLINE" otype)(member '(102 . "{ACAD_REACTORS") ent)) (entget (cdr (assoc 330 ent))) ) ) ) (if (and (setq bname (cond ( bname ) ( (cdr (assoc 2 (tblsearch "Block" "block")))) ;<-- your block name ( (findfile "T:\\Edwin\\block.dwg")) ) ) (setq vp (car (entsel "\nSelect Viewport"))) (setq vport (_isvport (entget vp))) (setq ipoint (getpoint "\nPick point for scale bar")) ;<-- this can be hardcoded to a specific coordinate ) (progn (setq viewportScale (/ (cdr (assoc 45 vport)) (cdr (assoc 41 vport)))) (setq attribfactor (* viewportScale 10.0)) (setq scalebarblock (vlax-invoke (vlax-get (vla-get-ActiveLayout (vla-get-activedocument (vlax-get-acad-object))) 'Block) 'InsertBlock ipoint bname 1 1 1 0)) (foreach itm (Vlax-invoke scalebarblock 'GetAttributes) (cond ( (setq f (assoc (setq CurrentTag (Vla-get-tagstring itm)) '(("NUM01" . 2)("NUM02" . 1)("NUM03" . 2) ("NUM04" . 4)("NUM05" . 8)))) (vlax-put itm 'Textstring (rtos (* (cdr f) attribfactor) 2 (if (< attribfactor 1.0) 2 0))) ) ( (eq "FACTOR" CurrentTag) (vlax-put itm 'Textstring (strcat "ESCALA 1 : " (rtos (* viewportScale 1000) 2 0))) ) ) ) ) (print (cond ((null vp) "Failed to select Object") ((null vport) "Not a Viewport") ((null bname) "Block not found") ((null ipoint) "No basepoint for block insertion")) ) ) (princ) )
