Room-info-table, measure length from objects to roomcorner (delta-x)+(delta-y) and write into

[Philipp]

 

I`m searching for a Lisp that asks for polygon or polyline and then creates a room Info-table which should be a Block with automated parameters (like area,...) and parameters with attributes that can be overwritten. Has anyone who is into architecture something like this?

 

Next thing I'd like to realise I want to determine where in the room an object (Block) is, and from that, what the sum of the nearest crossing point lenghts in x and y-direction (from the Block and in block-wks) is. 

Then write the sum in an attribute of the blocks.

The polyline will always be on a specific layer.

It would also be nice if it would work for many blocks in different polygons at once.

 

can someone help me or nows polling lisps that do something like this?

[marko_ribar]

This should help you although some of your request is not understandable :

 

[marko_ribar]

I think I get what you want in second part of your request...

In newer versions of AutoCAD, it is implemented new functionality of quick measure command, but AFAIK that's just visual effect - I don't know if those dimensions can be placed directly in DWG...

Look this :

https://videos.autodesk.com/zencoder/content/dam/autodesk/www/products/autocad/fy21/features/videos/quick-measure-video-v2-1920x1080.mp4

[Philipp]

Thanks marko_ribar! 

This information is exactly what I want to know and place in each block,  for example: a Floorplan of a building. Unfortunately it's an visual effect as it looks, and not so interesting for me in first place because I don't use Autocad at home. 

 

But I don't want to use a tool that shows areas. I'd like a program simple as is can be.

In ARES Commander it's easy to put in an ifc file and write out a floor plan dwg

So I want to use the ifc parameter ifc-space to use the room dimensions for measuring the element-location for distribution-length calculating. 

Concept:

-Take x/y 0/0 of blocks

-Measure arrow in x and y-direction to nearest point on the sorrounding pline or polygon of a specific layer in each selected block

Sum both and write in an attribute in each Bock > "att_length" 

-Than you can extract the values and use for calculating

 

[BIGAL]

With no dwg to look at some assumptions are being made, like are the rooms always a rectang and dont have nibs or odd shapes. It is fairly straight forward to pull the pline details and get say X & Y plus Area. Need more info like a dwg.

[marko_ribar]

Here, I've coded (c:quickmeasure) tool so that it can be used in any version of AutoCAD/BricsCAD...

For now you'll have to be satisfied and with this functionality - it uses ordinary (grread) with no GrSnap implemented - even built-in command IMHO don't have this supported and beside this, how would you see changes if OSNAPs are functioning... Nevermind, if there are more time, perhaps someone may chime in like Mr. Lee Mac (once I got critics from him for using GrSnap, so maybe author himself would do implementation)...

 

(defun c:quickmeasure ( / *error* screenbb car-sort processdir ss ray gr r pt rr txt txtl cmde dimtih dimtxt dimlunit )

  (vl-load-com)

  (defun *error* ( m )
    (redraw)
    (foreach tt txtl
      (if (and (cadr tt) (not (vlax-erased-p (cadr tt))))
        (entdel (cadr tt))
      )
    )
    (if (and ray (not (vlax-erased-p ray)))
      (entdel ray)
    )
    (command-s "_.UNDO" "_E")
    (if (and cmde dimtih dimtxt dimlunit)
      (mapcar (function setvar) '(cmdecho dimtih dimtxt dimlunit) (list cmde dimtih dimtxt dimlunit))
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun screenbb ( / w h scz vsz vc )
    (setq w (* (car (setq scz (getvar 'screensize))) (/ (setq vsz (getvar 'viewsize)) (cadr scz)))
          h vsz
    )
    (list (list (- (car (setq vc (getvar 'viewctr))) (/ w 2.0)) (- (cadr vc) (/ h 2.0))) (list (+ (car vc) (/ w 2.0)) (+ (cadr vc) (/ h 2.0))))
  )

  (defun car-sort ( lst cmp / rtn )
    (setq rtn (car lst))
    (foreach itm (cdr lst)
      (if (apply cmp (list itm rtn))
        (setq rtn itm)
      )
    )
    rtn
  )

  (defun processdir ( ss pt dir / intpt ss elst e r )

    (defun intpt ( pt dir e / r x rr )
      (setq r (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object e) acextendnone))
      (repeat (/ (length r) 3)
        (setq x (list (car r) (cadr r) (caddr r)))
        (setq rr (cons x rr))
        (setq r (cdddr r))
      )
      (car-sort rr (function (lambda ( a b ) (< (distance pt a) (distance pt b)))))
    )

    (setq ray (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") (cons 10 pt) (cons 11 (append dir (list 0.0))))))
    (if ss
      (progn
        (setq elst (vl-remove-if (function (lambda ( x ) (null (intpt pt dir x)))) (vl-remove-if-not (function (lambda ( x / catch ) (and (setq catch (vl-catch-all-apply (function vlax-curve-getstartpoint) (list x))) (not (vl-catch-all-error-p catch))))) (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss))))))
        (if elst
          (setq e (car-sort elst (function (lambda ( a b ) (< (distance pt (intpt pt dir a)) (distance pt (intpt pt dir b)))))))
        )
        (if e
          (setq r (list (setq pp (intpt pt dir e)) (distance pt pp)))
        )
      )
    )
    (entdel ray)
    r
  )

  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vl-cmdf "_.UNDO" "_E")
  )
  (vl-cmdf "_.UNDO" "_G")
  (setq ss (ssget "_A" '((0 . "~VIEWPORT"))))
  (while (= 5 (car (setq gr (grread t))))
    (redraw)
    (foreach dir (list (list 1.0 0.0) (list -1.0 0.0) (list 0.0 1.0) (list 0.0 -1.0))
      (setq r (processdir ss (setq pt (cadr gr)) dir))
      (if (and r (not (equal r rr 1e-6)))
        (progn
          (grdraw pt (car r) 3 0)
          (if (setq txt (cadr (assoc dir txtl)))
            (entupd (cdr (assoc -1 (entmod (subst (cons 1 (rtos (cadr r) 2 6)) (assoc 1 (setq txtx (entget txt))) (subst (cons 10 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt (car r))) (assoc 10 txtx) (subst (cons 11 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt (car r))) (assoc 11 txtx) txtx)))))))
            (setq txt (entmakex (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt (car r))) (cons 11 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt (car r))) (cons 50 (if (zerop (cadr dir)) 0.0 (* 0.5 pi))) (cons 40 (* 10.0 (/ (getvar 'viewsize) (cadr (getvar 'screensize))))) (cons 1 (rtos (cadr r) 2 6)) (cons 71 0) (cons 72 1) (cons 73 2))))
          )
          (if (not (vl-position (list dir txt) txtl))
            (setq txtl (cons (list dir txt) txtl))
          )
        )
        (if (null r)
          (if (and (setq txt (cadr (assoc dir txtl))) (not (vlax-erased-p txt)))
            (progn
              (entdel txt)
              (setq txtl (vl-remove (assoc dir txtl) txtl))
            )
          )
        )
      )
      (setq rr r)
    )
  )
  (foreach tt txtl
    (if (and (cadr tt) (not (vlax-erased-p (cadr tt))))
      (entdel (cadr tt))
    )
  )
  (if (= (car gr) 3)
    (progn
      (setq dimtih (getvar 'dimtih))
      (setq dimtxt (getvar 'dimtxt))
      (setq dimlunit (getvar 'dimlunit))
      (setvar 'dimtih 0)
      (setvar 'dimtxt (* 10.0 (/ (getvar 'viewsize) (cadr (getvar 'screensize)))))
      (setvar 'dimlunit 6)
      (setq pt (cadr (grread t)))
      (foreach dir (list (list 1.0 0.0) (list -1.0 0.0) (list 0.0 1.0) (list 0.0 -1.0))
        (setq r (processdir ss pt dir))
        (if r
          (vl-cmdf "_.DIMLINEAR" "_non" pt "_non" (car r) (if (or (equal dir (list 1.0 0.0)) (equal dir (list -1.0 0.0))) "_H" "_V") "_non" (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt (car r)))
        )
      )
    )
  )
  (*error* nil)
)

 

HTH.

M.R.

Edited November 7, 2021 by marko_ribar

[Philipp]

should it do more than placing a ray?

 

In the following example is  a block that i want to use:

It would be nice to place an room-info Block and relate it to the poligon (here its layer is named: ifc_space), so it can print out room-area in an attribute

Next thing would be to measure the lenghts as it is drawn in the dwg and sum the 2 lower values, then write it in the attribute "KABEL" to have a value for each block in a drawing for cable-lenght

 

example_1.dwg

[marko_ribar]

Look, I don't want to look to request if you haven't tried to solve it... All we can offer is assitence when you stuck and can't go further... I'll take this oportunity to post implemented GrSnap into quickmeasure tool... If you have block(s), you'll just have to specify "ins" OSNAP and point with mouse to block base point... If you need better precision of measurments, change output of dimensions by setting desired "dimlunit" variable - currently it works with 6 decimal places... For creating table(s) and filling attribute(s) with values, you have to code on your own... As far as I can see, this what you already have is pretty enough for pulling data out of drawing... For today that's all from me... See you later...

 

(defun c:quickmeasure-grsnap ( / *error* LM:grsnap:snapfunction LM:grsnap:displaysnap LM:grsnap:snapsymbols LM:grsnap:parsepoint LM:grsnap:snapmode LM:OLE->ACI LM:OLE->RGB LM:RGB->ACI LM:acapp screenbb car-sort processdir osf osm ss ray gr1 gr2 msg str ff r pt rr txt txtl cmde ape dimtih dimtxt dimlunit done )

  (vl-load-com)

  (defun *error* ( m )
    (if (= 8 (logand 8 (getvar 'undoctl)))
      (command-s "_.UNDO" "_E")
    )
    (redraw)
    (foreach tt txtl
      (if (and (cadr tt) (not (vlax-erased-p (cadr tt))))
        (entdel (cadr tt))
      )
    )
    (if (and ray (not (vlax-erased-p ray)))
      (entdel ray)
    )
    (if (and cmde ape dimtih dimtxt dimlunit)
      (mapcar (function setvar) '(cmdecho aperture dimtih dimtxt dimlunit) (list cmde ape dimtih dimtxt dimlunit))
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  ;; Object Snap for grread: Snap Function  -  Lee Mac
  ;; Returns: [fun] A function requiring two arguments:
  ;; p - [lst] UCS Point to be snapped
  ;; o - [int] Object Snap bit code
  ;; The returned function returns either the snapped point (displaying an appropriate snap symbol)
  ;; or the supplied point if the snap failed for the given Object Snap bit code.
  (defun LM:grsnap:snapfunction ( )
    (eval
      (list 'lambda '( p o / q )
        (list 'if '(zerop (logand 16384 o))
          (list 'if
           '(setq q
              (cdar
                (vl-sort
                  (vl-remove-if 'null
                    (mapcar
                      (function
                        (lambda ( a / b )
                          (if (and (= (car a) (logand (car a) o)) (setq b (osnap p (cdr a))))
                            (list (distance p b) b (car a))
                          )
                        )
                      )
                     '(
                        (0001 . "_end")
                        (0002 . "_mid")
                        (0004 . "_cen")
                        (0008 . "_nod")
                        (0016 . "_qua")
                        (0032 . "_int")
                        (0064 . "_ins")
                        (0128 . "_per")
                        (0256 . "_tan")
                        (0512 . "_nea")
                        (2048 . "_app")
                        (8192 . "_par")
                      )
                    )
                  )
                 '(lambda ( a b ) (< (car a) (car b)))
                )
              )
            )
            (list 'LM:grsnap:displaysnap '(car q)
              (list 'cdr
                (list 'assoc '(cadr q)
                  (list 'quote
                    (LM:grsnap:snapsymbols
                      (atoi (cond ((getenv "AutoSnapSize")) ("5")))
                    )
                  )
                )
              )
              (LM:OLE->ACI
                (if (= 1 (getvar 'cvport))
                  (atoi (cond ((getenv "Layout AutoSnap Color")) ("117761")))
                  (atoi (cond ((getenv  "Model AutoSnap Color")) ("104193")))
                )
              )
            )
          )
        )
       '(cond ((car q)) (p))
      )
    )
  )

  ;; Object Snap for grread: Display Snap  -  Lee Mac
  ;; pnt - [lst] UCS point at which to display the symbol
  ;; lst - [lst] grvecs vector list
  ;; col - [int] ACI colour for displayed symbol
  ;; Returns nil
  (defun LM:grsnap:displaysnap ( pnt lst col / dpnt )
    (setq dpnt (trans pnt 1 2))
    (grvecs (cons col (mapcar '(lambda ( x ) (mapcar '+ dpnt x)) lst))
      (list
        (list 1.0 0.0 0.0 0.0)
        (list 0.0 1.0 0.0 0.0)
        (list 0.0 0.0 1.0 0.0)
        (list 0.0 0.0 0.0 1.0)
      )
    )
  )

  ;; Object Snap for grread: Snap Symbols  -  Lee Mac
  ;; p - [int] Size of snap symbol in pixels
  ;; Returns: [lst] List of vector lists describing each Object Snap symbol
  (defun LM:grsnap:snapsymbols ( p / scl -p -q -r a c i l q r )
    (setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize))))
    (setq -p (- (* p scl)) q (* (1+ p) scl)
          -q (- q) r (* (+ 2 p) scl)
          -r (- r) i (/ pi 6.0)
           a 0.0   p (* p scl)
    )
    (repeat 12
      (setq l (cons (list (* r (cos a)) (* r (sin a))) l)
            a (- a i)
      )
    )
    (setq c (apply 'append (cdr (mapcar 'list (cons (last l) l) l))))
    (list
      (list 0001
        (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
        (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
      )
      (list 0002
        (list -r -q) (list 0  r) (list 0  r) (list r -q)
        (list -p -p) (list p -p) (list p -p) (list 0  p) (list 0  p) (list -p -p)
        (list -q -q) (list q -q) (list q -q) (list 0  q) (list 0  q) (list -q -q)
      )
      (cons 0004 c)
      (vl-list* 0008 (list -r -r) (list r r) (list r -r) (list -r r) c)
      (list 0016
        (list p 0) (list 0 p) (list 0 p) (list -p 0) (list -p 0) (list 0 -p) (list 0 -p) (list p 0)
        (list q 0) (list 0 q) (list 0 q) (list -q 0) (list -q 0) (list 0 -q) (list 0 -q) (list q 0)
        (list r 0) (list 0 r) (list 0 r) (list -r 0) (list -r 0) (list 0 -r) (list 0 -r) (list r 0)
      )
      (list 0032
        (list  r r) (list -r -r) (list  r q) (list -q -r) (list  q r) (list -r -q)
        (list -r r) (list  r -r) (list -q r) (list  r -q) (list -r q) (list  q -r)
      )
      (list 0064
        '( 0  1) (list  0  p) (list  0  p) (list -p  p) (list -p  p) (list -p -1) (list -p -1) '( 0 -1)
        '( 0 -1) (list  0 -p) (list  0 -p) (list  p -p) (list  p -p) (list  p  1) (list  p  1) '( 0  1)
        '( 1  2) (list  1  q) (list  1  q) (list -q  q) (list -q  q) (list -q -2) (list -q -2) '(-1 -2)
        '(-1 -2) (list -1 -q) (list -1 -q) (list  q -q) (list  q -q) (list  q  2) (list  q  2) '( 1  2)
      )
      (list 0128
        (list (1+ -p) 0) '(0 0) '(0 0) (list 0 (1+ -p))
        (list (1+ -p) 1) '(1 1) '(1 1) (list 1 (1+ -p))
        (list -p q) (list -p -p) (list -p -p) (list q -p)
        (list -q q) (list -q -q) (list -q -q) (list q -q)
      )
      (vl-list* 256 (list -r r)  (list r r) (list -r (1+ r)) (list r (1+ r)) c)
      (list 0512
        (list -p -p) (list  p -p) (list -p  p) (list p p) (list -q -q) (list  q -q)
        (list  q -q) (list -q  q) (list -q  q) (list q q) (list  q  q) (list -q -q)
      )
      (list 2048
        (list   -p     -p) (list    p      p) (list   -p      p) (list    p     -p)
        (list (+ p 05) -p) (list (+ p 06) -p) (list (+ p 05) -q) (list (+ p 06) -q)
        (list (+ p 09) -p) (list (+ p 10) -p) (list (+ p 09) -q) (list (+ p 10) -q)
        (list (+ p 13) -p) (list (+ p 14) -p) (list (+ p 13) -q) (list (+ p 14) -q)
        (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
        (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
      )
      (list 8192 (list r 1) (list -r -q) (list r 0) (list -r -r) (list r q) (list -r -1) (list r r) (list -r 0))
    )
  )

  ;; Object Snap for grread: Parse Point  -  Lee Mac
  ;; bpt - [lst] Basepoint for relative point input, e.g. @5,5
  ;; str - [str] String representing point input
  ;; Returns: [lst] Point represented by the given string, else nil
  (defun LM:grsnap:parsepoint ( bpt str / str->lst lst )
    (defun str->lst ( str / pos )
      (if (setq pos (vl-string-position 44 str))
        (cons (substr str 1 pos) (str->lst (substr str (+ pos 2))))
        (list str)
      )
    )
    (if (wcmatch str "`@*")
      (setq str (substr str 2))
      (setq bpt '(0.0 0.0 0.0))
    )
    (if
      (and
        (setq lst (mapcar 'distof (str->lst str)))
        (vl-every 'numberp lst)
        (< 1 (length lst) 4)
      )
      (mapcar '+ bpt lst)
    )
  )

  ;; Object Snap for grread: Snap Mode  -  Lee Mac
  ;; str - [str] Object Snap modifier
  ;; Returns: [int] Object Snap bit code for the given modifier, else nil
  (defun LM:grsnap:snapmode ( str )
    (vl-some
      (function
        (lambda ( x )
          (if (wcmatch (car x) (strcat (strcase str t) "*"))
            (progn (setq ff t) (princ (cadr x)) (caddr x))
          )
        )
      )
     '(
        ("endpoint"      " of " 0001)
        ("midpoint"      " of " 0002)
        ("center"        " of " 0004)
        ("node"          " of " 0008)
        ("quadrant"      " of " 0016)
        ("intersection"  " of " 0032)
        ("insert"        " of " 0064)
        ("perpendicular" " to " 0128)
        ("tangent"       " to " 0256)
        ("nearest"       " to " 0512)
        ("appint"        " of " 2048)
        ("parallel"      " to " 8192)
        ("none"          ""     16384)
      )
    )
  )

  ;; OLE -> ACI  -  Lee Mac
  ;; Args: c - [int] OLE Colour
  (defun LM:OLE->ACI ( c )
    (apply 'LM:RGB->ACI (LM:OLE->RGB c))
  )

  ;; OLE -> RGB  -  Lee Mac
  ;; Args: c - [int] OLE Colour
  (defun LM:OLE->RGB ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8))
  )

  ;; RGB -> ACI  -  Lee Mac
  ;; Args: r,g,b - [int] Red, Green, Blue values
  (defun LM:RGB->ACI ( r g b / c o )
    (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
      (progn
        (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))
        (vlax-release-object o)
        (if (vl-catch-all-error-p c)
          (prompt (strcat "\nError: " (vl-catch-all-error-message c)))
          c
        )
      )
    )
  )

  ;; Application Object  -  Lee Mac
  ;; Returns the VLA Application Object
  (defun LM:acapp nil
    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
    (LM:acapp)
  )

  (defun screenbb ( / w h scz vsz vc )
    (setq w (* (car (setq scz (getvar 'screensize))) (/ (setq vsz (getvar 'viewsize)) (cadr scz)))
          h vsz
    )
    (list (list (- (car (setq vc (getvar 'viewctr))) (/ w 2.0)) (- (cadr vc) (/ h 2.0))) (list (+ (car vc) (/ w 2.0)) (+ (cadr vc) (/ h 2.0))))
  )

  (defun car-sort ( lst cmp / rtn )
    (setq rtn (car lst))
    (foreach itm (cdr lst)
      (if (apply cmp (list itm rtn))
        (setq rtn itm)
      )
    )
    rtn
  )

  (defun processdir ( ss pt dir / intpt ss elst e r )

    (defun intpt ( pt dir e / r x rr )
      (setq r (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object e) acextendnone))
      (repeat (/ (length r) 3)
        (setq x (list (car r) (cadr r) (caddr r)))
        (setq rr (cons x rr))
        (setq r (cdddr r))
      )
      (setq r (car-sort rr (function (lambda ( a b ) (< (distance pt a) (distance pt b))))))
      (if (and r (zerop (distance pt r)) (= (length rr) 2))
        (setq r (car (vl-remove r rr)))
      )
      r
    )

    (setq ray (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") (cons 10 pt) (cons 11 (append dir (list 0.0))))))
    (if ss
      (progn
        (setq elst (vl-remove-if (function (lambda ( x ) (null (intpt pt dir x)))) (vl-remove-if-not (function (lambda ( x / catch ) (and (setq catch (vl-catch-all-apply (function vlax-curve-getstartpoint) (list x))) (not (vl-catch-all-error-p catch))))) (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss))))))
        (if elst
          (setq e (car-sort elst (function (lambda ( a b ) (< (distance pt (intpt pt dir a)) (distance pt (intpt pt dir b)))))))
        )
        (if e
          (setq r (list (setq pp (intpt pt dir e)) (distance pt pp)))
        )
      )
    )
    (entdel ray)
    r
  )

  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (setq ape (getvar 'aperture))
  (setvar 'aperture 18)
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vl-cmdf "_.UNDO" "_E")
  )
  (vl-cmdf "_.UNDO" "_G")
  (setq osf (LM:grsnap:snapfunction))
  (setq osm (getvar 'osmode))
  (setq msg "\nPick or specify point, or shift+right click for OSNAP dialog, or just type desired OSNAP : ")
  (setq str "")
  (setq ss (ssget "_A" (list (cons 0 "~VIEWPORT") (cons 60 0) (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))
  (prompt msg)
  (while
    (and
      (null done)
      (progn
        (setq gr1 (grread t 15 0)
              gr2 (if (not (equal gr2 (cadr gr1))) (progn (redraw) (cadr gr1)) (cadr gr1))
              gr1 (car gr1)
        )
        (cond
          ( (or (= 5 gr1) (and (= gr1 11) (or (= gr2 1000) (= gr2 2000))))
            t
          )
          ( (= 3 gr1)
            (setq done t)
          )
          ( (= 2 gr1)
            (if ff
              (progn
                (setq ff nil)
                (princ msg)
              )
            )
            (cond
              ( (= 6 gr2)
                (if (zerop (logand 16384 (setq osm (setvar 'osmode (boole 6 16384 (getvar 'osmode))))))
                  (princ "\n<Osnap on>")
                  (princ "\n<Osnap off>")
                )
              )
              ( (= 8 gr2)
                (if (< 0 (strlen str))
                  (progn
                    (princ "\010\040\010")
                    (setq str (substr str 1 (1- (strlen str))))
                  )
                )
                t
              )
              ( (< 32 gr2 127)
                (setq str (strcat str (princ (chr gr2))))
              )
              ( (member gr2 '(13 32))
                (cond
                  ( (= "" str) nil )
                  ( (setq gr2 (LM:grsnap:parsepoint (osf (cadr (grread t)) osm) str))
                    (setq str "")
                    (setq done t gr1 3)
                  )
                  ( (setq tmp (LM:grsnap:snapmode str))
                    (setq str "")
                    (setvar 'osmode tmp)
                    (setq osm tmp)
                    (setq gr2 (osf (cadr (grread t)) osm))
                    (setq ff t)
                  )
                )
              )
            )
          )
        )
      )
    )
    (redraw)
    (setq osm (getvar 'osmode))
    (if (and (= gr1 11) (or (= gr2 1000) (= gr2 2000)))
      (progn
        (initdia)
        (vl-cmdf "_.OSNAP")
        (princ msg)
        (setq gr1 (grread t 15 0)
              gr2 (if (not (equal gr2 (cadr gr1))) (progn (redraw) (cadr gr1)) (cadr gr1))
              gr1 (car gr1)
        )
      )
    )
    (if (= str "")
      (foreach dir (list (list 1.0 0.0) (list -1.0 0.0) (list 0.0 1.0) (list 0.0 -1.0))
        (setq r (processdir ss (setq pt (osf gr2 osm)) dir))
        (if (and r (not (equal r rr 1e-6)))
          (progn
            (grdraw pt (car r) 3 0)
            (if (setq txt (cadr (assoc dir txtl)))
              (entupd (cdr (assoc -1 (entmod (subst (cons 1 (rtos (cadr r) 2 6)) (assoc 1 (setq txtx (entget txt))) (subst (cons 10 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt (car r))) (assoc 10 txtx) (subst (cons 11 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt (car r))) (assoc 11 txtx) txtx)))))))
              (setq txt (entmakex (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt (car r))) (cons 11 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt (car r))) (cons 50 (if (zerop (cadr dir)) 0.0 (* 0.5 pi))) (cons 40 (* 10.0 (/ (getvar 'viewsize) (cadr (getvar 'screensize))))) (cons 1 (rtos (cadr r) 2 6)) (cons 71 0) (cons 72 1) (cons 73 2))))
            )
            (if (not (vl-position (list dir txt) txtl))
              (setq txtl (cons (list dir txt) txtl))
            )
          )
          (if (null r)
            (if (and (setq txt (cadr (assoc dir txtl))) (not (vlax-erased-p txt)))
              (progn
                (entdel txt)
                (setq txtl (vl-remove (assoc dir txtl) txtl))
              )
            )
          )
        )
        (setq rr r)
      )
    )
  )
  (foreach tt txtl
    (if (and (cadr tt) (not (vlax-erased-p (cadr tt))))
      (entdel (cadr tt))
    )
  )
  (setq dimtih (getvar 'dimtih))
  (setq dimtxt (getvar 'dimtxt))
  (setq dimlunit (getvar 'dimlunit))
  (setvar 'dimtih 0)
  (setvar 'dimtxt (* 10.0 (/ (getvar 'viewsize) (cadr (getvar 'screensize)))))
  (setvar 'dimlunit 6)
  (setq pt (osf (if (null done) (cadr (grread t)) gr2) osm))
  (foreach dir (list (list 1.0 0.0) (list -1.0 0.0) (list 0.0 1.0) (list 0.0 -1.0))
    (setq r (processdir ss pt dir))
    (if r
      (vl-cmdf "_.DIMLINEAR" "_non" pt "_non" (car r) (if (or (equal dir (list 1.0 0.0)) (equal dir (list -1.0 0.0))) "_H" "_V") "_non" (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt (car r)))
    )
  )
  (*error* nil)
)

 

Edited February 14, 2022 by marko_ribar

[Philipp]

How do I use it?

When I start the program it says: *cancel* and its gone

 

But I can load it without errors

Edited November 9, 2021 by Philipp

[Guest]

Hi marko_ribar. Is it possible to update the code not to split the dimension to two, but  insert one vertical and one horizontal dimension.

 

Thanks

[Guest]

Any ideas?

 

Thanks

[Guest]

Hi marko_ribar. The quick measure work with one vertical and one horizontal dimension. It is not helpful to divide the dimension in two. Can you update the code?

Thanks

[BIGAL]

Why don;t you have a go your always asking but not providing 851 posts.

 

Maybe pay for 

Edited April 28, 2022 by BIGAL

[kirby]

Notwithstanding parasites, a better way to do this is the compass method.  Measure two arcs from endpoints of a known baseline (two ends of the same wall, where wall is of known length).