Vport Scale as Field Txt.

[jyan2000]

Hello Forums,

I've tried to adjust a lisp which is trying to field text of vport scale. However there is something  or wrong command doesn't work at all.. Anyone could help me ? 

Regars

Victor

 

[CADaSchtroumpf · Accepted solution]

Hi,

And this can help you?

(defun make_field (obj p / nw_obj)
  (setq
    nw_obj
    (vla-addMtext Space
      (vlax-3d-point p)
      0.0
      (strcat
        "{\\fArial|b0|i0|c0|p34;"
        "%<\\AcVar ctab>%"
        " - Scale 1/"
        "%<\\AcExpr (1000/"
        "%<\\AcObjProp Object(%<\\_ObjId "
        (itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
        ">%).CustomScale \\f \"%lu2%qf2816\">%"
        ") \\f \"%lu2%pr0\">%"
      )
    )
  )
  (mapcar
    '(lambda (pr val)
      (vlax-put nw_obj pr val)
    )
    (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'BackgroundFill)
    (list 7 3.5 5 p "Standard" "0" 0.0 -1)
  )
)
(defun c:Field_Layout_Scale ( / el AcDoc Space js n ent dxf_ent pt_v l h pt)
  (vl-load-com)
  (foreach el (layoutlist)
    (setvar "CTAB" el)
    (setq
      AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
      Space (vla-get-PaperSpace AcDoc)
    )
    (setq js
      (ssget "_X"
        (list
          '(0 . "VIEWPORT")
          '(67 . 1)
          (cons 410 el)
          '(-4 . "!=")
          '(69 . 1)
        )
      )
    )
    (repeat (setq n (sslength js))
      (setq
        pt_v (cdr (assoc 10 (setq dxf_ent (entget (setq ent (ssname js (setq n (1- n))))))))
        l (cdr (assoc 40 dxf_ent))
        h (cdr (assoc 41 dxf_ent))
        pt (list (- (car pt_v) (* 0.5 l)) (- (cadr pt_v) (* 0.5 h)) 0.0)
      )
      (make_field ent pt)
    )
  )
  (prin1)
)

[jyan2000]

Thank you very much for respond. It's woks perfectly fine.. 

Best Regards

Victor