Dimension intersection

[titoprax]

Hi!!!

 

Great lisp!!!!!

Is possible with add dimlinear?

[renkor]

On 7/9/2010 at 11:51 PM, Lee Mac said:

No-one seems to want to learn to learn it/try it anymore

 

Ah well, its useless sitting on my HD:

 

 

(defun c:iDim ( / doc spc p1 p2 ss lst )
 ;; © Lee Mac 2010
 (vl-load-com)

 (LM:ActiveSpace 'doc 'spc)

 (if (and
       (setq p1 (getpoint "\nSpecify First Point: "))
       (setq p2 (getpoint "\nSpecify Second Point: " p1))
       (setq ss
         (apply 'ssget
           (append (list "_C")
             (mapcar
              '(lambda ( foo )
                 (apply 'mapcar (cons foo (list p1 p2)))
               )
              '(min max)
             )
             (list '((0 . "~*DIMENSION")))
           )
         )
       )
       (setq lst
         (
           (lambda ( l / i )
             (setq i (LM:GetObjIntersectionsinSS l ss))
             (vla-delete l)
             i
           )
           (vlax-ename->vla-object
             (entmakex
               (list
                 (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2)
               )
             )
           )
         )
       )
     )
   (progn
     (setq lst
       (vl-sort lst
        '(lambda ( a b ) (< (distance p1 a) (distance p1 b)))
       )
     )
     (mapcar
      '(lambda ( p1 p2 )
         (vla-AddDimAligned spc
           (vlax-3D-point p1) (vlax-3D-point p2) (vlax-3D-point p1)
         )
       )
       (reverse (cdr (reverse lst))) (cdr lst)
     )
   )
 )
 (princ)
)


(defun LM:GetObjIntersectionsinSS ( obj ss )
 ;; © Lee Mac 2010
 (
   (lambda ( i / j a b iLst )

     (while (setq e (ssname ss (setq i (1+ i))))
       (setq iLst
         (append iLst
           (LM:GroupByNUm
             (vlax-invoke obj 'IntersectWith
               (vlax-ename->vla-object e) acExtendNone
             )
             3
           )
         )
       )
     )
   )
   -1
 )
)


(defun LM:GroupByNum ( l n / a b )
 ;; © Lee Mac 2010
 (while l
   (
     (lambda ( i )
       (while (< 0 i)
         (setq a (cons (car l) a) l (cdr l) i (1- i))
       )
       (setq b (cons (reverse a) b) a nil)
     )
     n
   )
 )
 (reverse b)
)

(defun LM:ActiveSpace ( *doc *spc )
 (set *spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (set *doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace (eval *doc)))
     )
     (vla-get-ModelSpace (eval *doc))
     (vla-get-PaperSpace (eval *doc))
   )
 )
)
 

 

 

wow, nice code lee...

 

Could it work with already made lines?

and what about if line turns as showed in attached drawing?

 

Thanks in advance

1.dwg