Vertical Distance Quickly

[ctpgamage]

I want to review vertical Distance across horizontal lines quickly (not one by one).you can see attached image there are few layers horizontally i want to check the dimesion of vertical gap between that layers along vertical line very quickly not one by one.anyone have a lisp routine for that....?

[ВeekeeCZ]

How you want to check dimensions? Vertical dimensions? Or list to the command-line, eg. 0.46 - 0.35 - 0.15 - 0.15

[ctpgamage]

dimension is better.if dificalt command line also ok...

[ВeekeeCZ]

No difference.

(vl-load-com)

(defun c:DimVerticalInters ( / LM:intersections LM:intersectionsbetweensets ss ent pts)
  
  ;; Intersections  -  Lee Mac
  ;; Returns a list of all points of intersection between two objects
  ;; for the given intersection mode.
  ;; ob1,ob2 - [vla] VLA-Objects
  ;;     mod - [int] acextendoption enum of intersectwith method
  
  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
             )
      (repeat (/ (length lst) 3)
        (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
              lst (cdddr lst))))
    (reverse rtn))
  
  ;; Intersections Between Sets  -  Lee Mac
  ;; Returns a list of all points of intersection between objects in two selection sets.
  ;; ss1,ss2 - [sel] Selection sets
  
  (defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength ss1))
      (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1)))))
      (repeat (setq id2 (sslength ss2))
        (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2))))
              rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn))))
    (apply 'append (reverse rtn)))
  
  ;; -------------------------------------------------
  
  (if (and (princ "\nHorizontal lines: ")
           (setq ss (ssget ":S"))
           (setq ent (car (entsel "\nVertical line: ")))
           (setq pts (LM:intersectionsbetweensets ss (ssadd ent)))
           (setq pts (vl-sort pts '(lambda (y1 y2)
                                     (< (cadr y1) (cadr y2)))))
           (setq i 0)
           )
    (repeat (1- (length pts))
      (command "_.DIMVERTICAL"
               "_none" (nth i pts)
               "_none" (nth (setq i (1+ i)) pts)
               "_none" "@")))
  (princ)
  )

[ctpgamage]

thanks beekeecs its works fine...can you make it dimensions?

[ВeekeeCZ]

What do you mean by "make it dimensions". A layer?

[ctpgamage]

yes..make a dimension is better....

[ВeekeeCZ · Accepted solution]

Ok, change the layer name if needed (blue)

(vl-load-com)

(defun c:DimVerticalInters ( / LM:intersections LM:intersectionsbetweensets ss ent pts)
  
  ;; Intersections  -  Lee Mac
  ;; Returns a list of all points of intersection between two objects
  ;; for the given intersection mode.
  ;; ob1,ob2 - [vla] VLA-Objects
  ;;     mod - [int] acextendoption enum of intersectwith method
  
  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
             )
      (repeat (/ (length lst) 3)
        (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
              lst (cdddr lst))))
    (reverse rtn))
  
  ;; Intersections Between Sets  -  Lee Mac
  ;; Returns a list of all points of intersection between objects in two selection sets.
  ;; ss1,ss2 - [sel] Selection sets
  
  (defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength ss1))
      (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1)))))
      (repeat (setq id2 (sslength ss2))
        (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2))))
              rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn))))
    (apply 'append (reverse rtn)))
  
  ;; -------------------------------------------------
  
  (if (and (princ "\nHorizontal lines: ")
           (setq ss (ssget ":S"))
           (setq ent (car (entsel "\nVertical line: ")))
           (setq pts (LM:intersectionsbetweensets ss (ssadd ent)))
           (setq pts (vl-sort pts '(lambda (y1 y2)
                                     (< (cadr y1) (cadr y2)))))
           (setq i 0)
           (vl-cmdf "_.LAYER" "_T" "Dimensions" "_M" "Dimensions" "")
           )
    (repeat (1- (length pts))
      (command "_.DIMVERTICAL"
               "_none" (nth i pts)
               "_none" (nth (setq i (1+ i)) pts)
               "_none" "@"
               "_.chprop" "_Last" "" "_Layer" "Dimensions" "")))
  (princ)
  )

[ctpgamage · Accepted solution]

thanks brother ...

[ctpgamage]

its working fine for new drawing.but not working for existing drawing. can you tell me why is that?

[ctpgamage]

its ok i found the reason..its not working for named ucs only work for ucs world

[ВeekeeCZ]

---

@ctpgamage wrote:

its ok i found the reason..its not working for named ucs only work for ucs world

---

All we need to do is translate coordinates from WCS to UCS using the (trans) function. 

Have fun!

(vl-load-com)

(defun c:DimVerticalInters ( / LM:intersections LM:intersectionsbetweensets ss ent pts)
  
  ;; Intersections  -  Lee Mac
  ;; Returns a list of all points of intersection between two objects
  ;; for the given intersection mode.
  ;; ob1,ob2 - [vla] VLA-Objects
  ;;     mod - [int] acextendoption enum of intersectwith method
  
  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
             )
      (repeat (/ (length lst) 3)
        (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
              lst (cdddr lst))))
    (reverse rtn))
  
  ;; Intersections Between Sets  -  Lee Mac
  ;; Returns a list of all points of intersection between objects in two selection sets.
  ;; ss1,ss2 - [sel] Selection sets
  
  (defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength ss1))
      (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1)))))
      (repeat (setq id2 (sslength ss2))
        (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2))))
              rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn))))
    (apply 'append (reverse rtn)))
  
  ;; -------------------------------------------------
  
  (if (and (princ "\nHorizontal lines: ")
           (setq ss (ssget ":S"))
           (setq ent (car (entsel "\nVertical line: ")))
           (setq pts (LM:intersectionsbetweensets ss (ssadd ent)))
           (setq pts (vl-sort pts '(lambda (y1 y2)
                                     (< (cadr y1) (cadr y2)))))
           (setq i 0)
           (vl-cmdf "_.LAYER" "_T" "Dimensions" "_M" "Dimensions" "")
           )
    (repeat (1- (length pts))
      (command "_.DIMVERTICAL"
               "_none" (trans (nth i pts) 0 1)
               "_none" (trans (nth (setq i (1+ i)) pts) 0 1)
               "_none" "@"
               "_.chprop" "_Last" "" "_Layer" "Dimensions" "")))
  (princ)
  )