Dimension intersection

[alanjt]

 

Oops, I deleted it without thinking: DimContinue

 

 

I'm not sure DimContinue will yield the exact desired results. I used no commands. I basically gave me exact procedure in an earlier post.

[raed_jammal]

hi ALAN

is there any hope that you gave us the lisp ???

[Lee Mac]

You do like to tease them Mr Thompson

[alanjt]

You do like to tease them Mr Thompson

I just want people to at least try. I had hoped that it might give a little inspiration. Oh well.

[alanjt]

BTW, good to see you back, Lee. How'd exams go?

[Lee Mac]

BTW, good to see you back, Lee. How'd exams go?

 

Thanks Alan, exams went quite well - better than I though they would anyway, but I still think I perhaps could've done more work in a few subject areas.

[alanjt]

Thanks Alan, exams went quite well - better than I though they would anyway, but I still think I perhaps could've done more work in a few subject areas.

Good to hear.

[Lee Mac]

That is a fun one to write

 

[Icantdraw]

Who's being a tease now?

 

Wait a minute... I see a small extension line in those dims! Fail...

 

[Lee Mac]

Wait a minute... I see a small extension line in those dims! Fail...

 

Nah, that's just my dodgy dimstyle settings...

[raed_jammal]

hi Lee

 

is there any way to get that code u did?

[Lee Mac]

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))
   )
 )
)
 

[raed_jammal]

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

 

Ah well, its useless sitting on my HD:

 

thanks Lee

it not the matter i don't wan to try it ,, but i don't know the way to script it or code it ,,, soon i will try to learn it and do it by my self ,,thank you very much ,,,

[antistar]

Lee,

First of all, thanks for the help.

There are how to make a change in this routine does not scale TEXTs?

[Lee Mac]

Lee,

First of all, thanks for the help.

There are how to make a change in this routine does not scale TEXTs?

 

I don't know what you are talking about - this routine doesn't involve 'TEXTs'

[antistar]

See this example:

[alanjt]

So, add an ignore of *TEXT to the ssget selection filter.

[Lee Mac]

So, add an ignore of *TEXT to the ssget selection filter.

 

^^^ WHS

[sachindkini]

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))
)
)
)

 

dear sir

nice code

very usefull

thx for sharing

[Lee Mac]

You're welcome Sachindkini