Distance between two intersections

[alanjt]

Thanks Alan, I'm always at a loss as to what TextSize to use...

 

I've seen this also used:

 

(getvar 'DIMTXT)

Which may be better in this situation.

 

Lee

That's why I just use MText. Plus, you can add a mask, if needed.

 

(getvar 'dimtxt) will still be off if annotative.

 

Command: (getvar 'textsize)
0.08

Command: (getvar 'dimtxt)
0.08

 

I've seen Alan (CAB) use that, but he's 00 and 06 (no Annotative objects).

[pontifex]

About text height and drawing scale. Don't really know how or where to lisp it, but maybe it would be possible to let the user choose the drawing scale at the beginning jus like it is in this code (btw the code You wrote, Lee:) ). It seem to work great there so maybe could work here too.

(defun c:elleve (/ *error* #Dimzin Line Text P1 P2 PT TSZE X Y)
 ;; Lee Mac  ~  01.03.10

 (defun *error* (msg)
   (and #Dimzin (setvar 'dimzin #Dimzin))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun Line (p1 p2)
   (entmakex (list (cons 0 "LINE")
                   (cons 10 p1) (cons 11 p2))))

 (defun Text (pt hgt str)
   (entmakex (list (cons 0 "TEXT") (cons 10  pt)
                   (cons 40 hgt)   (cons 1  str)
                   (cons 50 (angle '(0 0 0) (getvar 'UCSXDIR)))
                   (cons 7  (getvar 'TEXTSTYLE)))))

 (setq #Dimzin (getvar 'dimzin))
 (setvar 'dimzin 0)
 
 (or *scl (setq *scl 100)) (initget 6)
 (setq *scl (cond ((getint (strcat "\nEnter Drawing Scale <" (itoa *scl) "> : "))) (*scl)))

 (setq tsze (* 0.002 *scl))

 (while (setq pt (getpoint "\nPick Elevation Line Point: "))
   (setq x (car pt) y (cadr pt))

   (setq p1 (trans (list (- x (/ tsze 2)) (+ y tsze) 0.) 1 0)
         p2 (trans (list (+ x (/ tsze 2)) (+ y tsze) 0.) 1 0))

   (mapcar (function (lambda (x) (line (trans pt 1 0) x))) (list p1 p2))
   (line p1 p2)

   (Text (trans (list x (+ y tsze) 0.) 1 0) tsze (strcat (if (<= 0 y) "+" "") (rtos y 2 2))))

 (and #Dimzin (setvar 'dimzin #Dimzin))

 (princ))

[Lee Mac]

I've seen Alan (CAB) use that, but he's 00 and 06 (no Annotative objects).

 

Yeah, that's where I've picked it up from...

[alanjt]

I forgot to mention. I noticed this typo...

 

                      (setq tObj
                            (vla-AddText
                              (if
                                (zerop
                                  (vla-get-ActiveSpace *doc)
                                ) ;_  zerop
                                 (if
                                   (eq :vlax-true
                                       (vla-get-MSpace [color=Red]*doc_[/color])
                                   ) ;_  eq
                                    (vla-get-ModelSpace *doc)
                                    (vla-get-PaperSpace *doc)
                                 ) ;_  if
                                 (vla-get-ModelSpace *doc)
                              ) ;_  if
                              (rtos dist 2 2)
                              (vlax-3D-point
                                '(0 0 0)
                              ) ;_  vlax-3D-point
                              (getvar 'TEXTSIZE)
                            ) ;_  vla-AddText
                     ) ;_  setq

[Lee Mac]

Nice spot! I think I perhaps wrote it too quickly ... I knew exactly what I wanted to code, but my fingers couldn't type fast enough...

[alanjt]

Nice spot! I think I perhaps wrote it too quickly ... I knew exactly what I wanted to code, but my fingers couldn't type fast enough...

Happens to the best of 'em.

[Kerry Brown]

Well, spurred on from Kerry's comments I thoughts I'd see how it would look - but I don't like it to be honest, so I'll probably go back to my old style.

 

 

get rid of the closing comments and it will be perfect

 

 

[Lee Mac]

get rid of the closing comments and it will be perfect

 

 

 

Hehe, I wondered how long it'd be before you stumbled across this... I bet your ears were burning

[Kerry Brown]

Hehe, I wondered how long it'd be before you stumbled across this... I bet your ears were burning

 

yep,

 

how does this look to you ??

 

(defun c:int_dist (/          *error*    iscurveobj ss->list
                  vlax-list->3d-point   sortfrompt dist
                  ent        ilst       lang       ma
                  mi         mpt        obj        pt
                  ss         tobj       uflag
                 )
 (vl-load-com)
 ;;
 ;; Lee Mac  ~  04.03.10
 ;;
 (setq *doc (cond (*doc)
                  ((vla-get-activedocument (vlax-get-acad-object)))
            )
 )
 (defun *error* (msg)
   (and uflag (vla-endundomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **"))
   )
   (princ)
 )
 (defun iscurveobj (ent)
   (not (vl-catch-all-error-p
          (vl-catch-all-apply (function vlax-curve-getendparam)
                              (list ent)
          )
        )
   )
 )
 (defun ss->list (ss / i ent objlst)
   (setq i -1)
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq objlst (cons (vlax-ename->vla-object ent) objlst))
   )
   objlst
 )
 (defun vlax-list->3d-point (lst)
   (if lst
     (cons (list (car lst) (cadr lst) (caddr lst))
           (vlax-list->3d-point (cdddr lst))
     )
   )
 )
 (defun sortfrompt (pt lst)
   (vl-sort
     lst
     (function (lambda (a b) (< (distance a pt) (distance b pt))))
   )
 )
 (while
   (progn
     (setq ent (entsel)
           pt  (cadr ent)
           ent (car ent)
     )
     (cond
       ((eq 'ename (type ent))
        (if (iscurveobj ent)
          (progn
            (vla-getboundingbox
              (setq obj (vlax-ename->vla-object ent))
              'mi
              'ma
            )
            (mapcar
              (function set)
              '(mi ma)
              (mapcar (function vlax-safearray->list) (list mi ma))
            )
            (setq ss (ssget "_C"
                            (list (car mi) (cadr ma) 0.)
                            (list (car ma) (cadr mi) 0.)
                     )
            )
            (if (and (setq ilst
                            (apply
                              (function append)
                              (vl-remove
                                'nil
                                (mapcar
                                  (function (lambda (x)
                                              (vlax-list->3d-point
                                                (vlax-invoke obj
                                                             'intersectwith
                                                             x
                                                             acextendnone
                                                )
                                              )
                                            )
                                  )
                                  (ss->list (ssdel ent ss))
                                )
                              )
                            )
                     )
                     (< 1 (length ilst))
                )
              (progn
                (setq uflag (not (vla-startundomark *doc)))
                (setq ilst (sortfrompt
                             (vlax-curve-getclosestpointto ent pt)
                             ilst
                           )
                      ilst (list (car ilst) (cadr ilst))
                )
                (setq mpt
                       (vlax-curve-getpointatdist
                         ent
                         (/ (+ (vlax-curve-getdistatpoint ent
                                                          (cadr ilst)
                               )
                               (vlax-curve-getdistatpoint ent
                                                          (car ilst)
                               )
                            )
                            2.
                         )
                       )
                )
                (setq dist
                       (abs
                         (- (vlax-curve-getdistatpoint ent
                                                       (cadr ilst)
                            )
                            (vlax-curve-getdistatpoint ent (car ilst))
                         )
                       )
                )
                (setq lang
                       (angle '(0 0 0)
                              (vlax-curve-getfirstderiv
                                ent
                                (vlax-curve-getparamatpoint ent mpt)
                              )
                       )
                )
                (cond ((and (> lang (/ pi 2)) (<= lang pi))
                       (setq lang (- lang pi))
                      )
                      ((and (> lang pi) (<= lang (/ (* 3 pi) 2)))
                       (setq lang (+ lang pi))
                      )
                )
                (setq tobj
                       (vla-addtext
                         (if (zerop (vla-get-activespace *doc))
                           (if (eq :vlax-true (vla-get-mspace *doc))
                             (vla-get-modelspace *doc)
                             (vla-get-paperspace *doc)
                           )
                           (vla-get-modelspace *doc)
                         )
                         (rtos dist 2 2)
                         (vlax-3d-point '(0 0 0))
                         (getvar 'textsize)
                       )
                )
                (vla-put-alignment tobj acalignmentmiddlecenter)
                (vla-put-textalignmentpoint
                  tobj
                  (vlax-3d-point
                    (polar mpt (+ lang (/ pi 2.)) (getvar 'textsize))
                  )
                )
                (vla-put-stylename tobj (getvar 'dimtxsty))
                (vla-put-rotation tobj lang)
                (setq uflag (vla-endundomark *doc))
              )
              (princ "\n** Object Has less than Two Intersections **"
              )
            )
          )
          (princ "\n** Invalid Object Selected **")
        )
       )
     )
   )
 )
 (princ)
)
;|«Visual LISP© Format Options»
(70 2 45 2 nil "end of " 70 60 1 1 0 nil nil nil T)
;*** DO NOT add text below the comment! ***|;

[Kerry Brown]

Nice functionality, BTW

[Lee Mac]

Thanks Kerry

 

Yeah, it does flow, but I do struggle to read it if I'm honest... but that's just because I have gotten so used to my style.

 

I've never liked the Visual LISP format options at the bottom, I've always thought that was the worst thing to come from the Visual LISP Editor... its so intrusive..

 

I take it you don't like capitals then... I love my CamelCase

[Kerry Brown]

Thanks Kerry

 

Yeah, it does flow, but I do struggle to read it if I'm honest... but that's just because I have gotten so used to my style.

 

I've never liked the Visual LISP format options at the bottom, I've always thought that was the worst thing to come from the Visual LISP Editor... its so intrusive..

 

I take it you don't like capitals then... I love my CamelCase

 

Yes I prefer camelCase personally

 

I left the definition at the bottom in case you wanted to import it and try.

 

I've heard some whispers about an update for the VLIDE ... will be interesting to see what they come up with.

[Lee Mac]

I've heard some whispers about an update for the VLIDE ... will be interesting to see what they come up with.

 

Ooo I can't wait

[walton10]

I came across this thread while looking for a LISP to measure a polyline. I like what it does, but one thing that would work better for the purposes I need it for would be if the segment of polyline measured was determined from intersecting lines from two lines selected by the user or as another solution, from a specific, preset layer.

 

This code is probably beyond my capacity to edit (without breaking), but if someone was able to help I would be very thankful.

 

(I am using AutoCAD 2008, but our office uses 2008 and 2010. We save all files to 2000, if that is relevant.)

 

 

Also, I was looking at the code to see how to make it use my current text style (our company uses styles with pre-determined heights, etc), or make the lisp use a larger size. I only saw a limited number of references to 'TEXTSIZE and was unable to determine where it was defined.

[Lee Mac]

Hi Walton,

 

Welcome to CADTutor

 

Glad you like the code, I'm not sure that I understand your request completely.

 

There are currently two codes on this topic, the first will label all distances between intersections, and the second will label the length of the section selected by the user. Is there something that neither of these codes can achieve?

 

(defun c:int_dist  (/ *error* isCurveObj SortbyParam ss->list vlax-list->3D-point
                   
                     DIST ENT ILST LANG MA MI MPT OBJ PT SS TOBJ UFLAG X Y)
 (vl-load-com)
 ;; Lee Mac  ~  04.03.10

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))

 (defun *error*  (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))


 (defun isCurveObj  (ent)
   (not
     (vl-catch-all-error-p
       (vl-catch-all-apply
         (function vlax-curve-getEndParam) (list ent)))))


 (defun ss->list  (ss / i ent ObjLst)
   (setq i -1)
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq ObjLst (cons (vlax-ename->vla-object ent) Objlst)))
   
   ObjLst)
 

 (defun vlax-list->3D-point  (lst)
   (if lst
     (cons (list (car lst) (cadr lst) (caddr lst))
           (vlax-list->3D-point (cdddr lst)))))


 (defun SortByParam  (ent lst)
   (vl-sort lst
     (function
       (lambda (a b)
         (< (vlax-curve-getParamatPoint ent a)
            (vlax-curve-getParamatPoint ent b))))))


 (while
   (progn
     (setq ent (car (entsel)))

     (cond (  (eq 'ENAME (type ent))

              (if (isCurveObj ent)
                (progn

                  (vla-getBoundingBox
                    (setq obj (vlax-ename->vla-object ent)) 'Mi 'Ma)

                  (mapcar (function set) '(Mi Ma)
                          (mapcar
                            (function vlax-safearray->list) (list Mi Ma)))

                  (setq ss (ssget "_C" (trans (list (car Mi) (cadr Ma) 0.) 0 1)
                                       (trans (list (car Ma) (cadr Mi) 0.) 0 1)))

                  (if (setq iLst (apply (function append)
                                        (vl-remove 'nil
                                          (mapcar
                                            (function
                                              (lambda (x)
                                                (vlax-list->3D-point
                                                  (vlax-invoke obj 'IntersectWith x acExtendNone))))
                                            
                                          (ss->list (ssdel ent ss))))))
                     (progn

                       (setq iLst (SortByParam ent iLst))

                       (or (equal (vlax-curve-getStartParam ent)
                                  (vlax-curve-getParamatPoint ent (car iLst))  0.001)
                           
                           (setq iLst (cons (vlax-curve-getStartPoint ent) iLst)))

                       (or (equal (vlax-curve-getEndParam ent)
                                  (vlax-curve-getParamatPoint ent (last iLst)) 0.001)

                           (setq iLst (append iLst (list (vlax-curve-getEndPoint ent))))))

                     (setq iLst (list (vlax-curve-getStartPoint ent)
                                      (vlax-curve-getEndPoint ent))))

                  (while (cadr iLst)
                     (setq x (car iLst) y (cadr iLst))
                    
                     (setq mPt  (vlax-curve-getPointatDist ent
                                  (/ (+ (vlax-curve-getDistatPoint ent y)
                                        (vlax-curve-getDistAtPoint ent x)) 2.))

                           dist (abs (- (vlax-curve-getDistatPoint ent y)
                                        (vlax-curve-getDistAtPoint ent x)))

                           lAng (angle '(0 0 0)
                                       (vlax-curve-getFirstDeriv ent
                                         (vlax-curve-getParamatPoint ent mPt))))

                     (cond (  (and (> lAng (/ pi 2)) (<= lAng pi))
                              (setq lAng (- lAng pi)))
                           
                           (  (and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                              (setq lAng (+ lAng pi))))

                     (setq uFlag (not (vla-StartUndoMark *doc)))

                     (setq tObj  (vla-AddText
                                   
                                   (if (zerop (vla-get-ActiveSpace *doc))
                                     (if (eq :vlax-true (vla-get-MSpace *doc))
                                       (vla-get-ModelSpace *doc)
                                       (vla-get-PaperSpace *doc))
                                     (vla-get-ModelSpace *doc))

                                   (rtos dist)

                                   (vlax-3D-point '(0 0 0)) (getvar 'TEXTSIZE)))

                     (vla-put-Alignment tObj acAlignmentMiddleCenter)

                     (vla-put-TextAlignmentPoint tObj
                       (vlax-3D-point
                         (polar mPt (+ lAng (/ pi 2.)) (getvar 'TEXTSIZE))))

                     (vla-put-rotation tObj lAng)

                     (setq iLst (cdr iLst)))

                  (setq uFlag (vla-EndUndomark *doc)))

                (princ "\n** Invalid Object Selected **"))))))

 (princ))

 

(defun c:int_dist_seg  (/  *error* isCurveObj ss->list vlax-list->3D-point SortFromPt

                          DIST ENT ILST LANG MA MI MPT OBJ PT SS TOBJ UFLAG)
 (vl-load-com)
 ;; Lee Mac  ~  04.03.10
 
 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))
 
 (defun *error*  (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 
 (defun isCurveObj  (ent)
   (not (vl-catch-all-error-p
          (vl-catch-all-apply
            (function vlax-curve-getEndParam) (list ent)))))

 
 (defun ss->list  (ss / i ent ObjLst)
   (setq i -1)
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq ObjLst (cons (vlax-ename->vla-object ent) Objlst)))
   
   ObjLst)

 
 (defun vlax-list->3D-point  (lst)
   (if lst
     (cons (list (car lst) (cadr lst) (caddr lst))
           (vlax-list->3D-point (cdddr lst)))))

 
 (defun SortFromPt  (pt lst)
   (vl-sort lst (function
                  (lambda (a b)
                    (< (distance a pt) (distance b pt))))))

 
 (while
   (progn
     (setq ent (entsel) pt  (cadr ent) ent (car ent))
     
     (cond (  (eq 'ENAME (type ent))
            
              (if (isCurveObj ent)
                (progn
                  
                  (vla-getBoundingBox
                    (setq obj (vlax-ename->vla-object ent)) 'Mi 'Ma)
                  
                  (mapcar (function set) '(Mi Ma)
                          (mapcar
                            (function vlax-safearray->list) (list Mi Ma)))
                  
                  (setq ss (ssget "_C" (trans (list (car Mi) (cadr Ma) 0.) 0 1)
                                       (trans (list (car Ma) (cadr Mi) 0.) 0 1)))

                  (if (and (setq iLst
                             (apply (function append)
                                    (vl-remove 'nil
                                      (mapcar
                                        (function
                                          (lambda (x)
                                            (vlax-list->3D-point
                                              (vlax-invoke obj 'IntersectWith x acExtendNone))))
                                        
                                        (ss->list (ssdel ent ss))))))
                           
                           (< 1 (length iLst)))                     
                    (progn                       
                      (setq uFlag (not (vla-StartUndoMark *doc)))
                      
                      (setq iLst (SortFromPt
                                   (vlax-curve-getClosestPointto ent pt) iLst)
                            
                            iLst (list (car iLst) (cadr iLst)))
                      
                      (setq mPt  (vlax-curve-getPointatDist ent
                                   (/ (+ (vlax-curve-getDistatPoint ent (cadr iLst)) 
                                         (vlax-curve-getDistAtPoint ent (car ilst))) 2.))

                            dist (abs (- (vlax-curve-getDistatPoint ent (cadr iLst))
                                         (vlax-curve-getDistAtPoint ent (car ilst))))

                            lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv ent
                                                   (vlax-curve-getParamatPoint ent mPt))))
                      
                      (cond (  (and (> lAng (/ pi 2)) (<= lAng pi))
                               (setq lAng (- lAng pi)))
                            
                            (  (and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                               (setq lAng (+ lAng pi))))
                      
                      (setq tObj (vla-AddText
                                   
                                   (if (zerop (vla-get-ActiveSpace *doc)) 
                                     (if (eq :vlax-true (vla-get-MSpace *doc)) 
                                       (vla-get-ModelSpace *doc)
                                       (vla-get-PaperSpace *doc)) 
                                     (vla-get-ModelSpace *doc))

                                   (rtos dist 2 2)
                                   
                                   (vlax-3D-point '(0 0 0)) (getvar 'TEXTSIZE)))
                      
                      (vla-put-Alignment tObj acAlignmentMiddleCenter)
                      
                      (vla-put-TextAlignmentPoint tObj
                        (vlax-3D-point
                          (polar mPt (+ lAng (/ pi 2.)) (getvar 'TEXTSIZE))))
                      
                      (vla-put-StyleName tObj (getvar 'TEXTSTYLE))
                      (vla-put-rotation tObj lAng)
                      
                      (setq uFlag (vla-EndUndomark *doc)))
                    
                    (princ "\n** Object Has less than Two Intersections **")))
                
                (princ "\n** Invalid Object Selected **"))))))
 
 (princ))

 

Lee

[kasra]

Hi everyone.

I like this froum. cause i love solving all my problems in autocad with programming. But I'm fresh in lisp programming.

The routine that provided by Mr. Lee is so useful and I'm so thankful for that.

But it will be more completed if it shows all distances between two intersections, while there is an End point of line or Start point of arc between intersections.

I'm so glad if you complete that routine.

[Lee Mac]

Thanks Kasra, I'm glad you like it

 

I'm not sure what you are getting at, I believe the first routine in the above post should include the endpoints of the curve.

[kasra]

Thanks Kasra, I'm glad you like it

 

I'm not sure what you are getting at, I believe the first routine in the above post should include the endpoints of the curve.

 

Thanks for your attention.

I used the first routine. but it doesn't work as I want. I 've sent a picture that indicates what i mean. The magenta dimentions do not display with this routine.

I hope you understand what i mean.

[Lee Mac]

Hi Kasra,

 

With my quick testing of the first routine from post #35, I obtain this:

 

[kasra]

Hi Kasra,

 

With my quick testing of the first routine from post #35, I obtain this:

 

[ATTACH]18479[/ATTACH]

 

 

Thanks a lot.

I tested the routine again.

I found that if my axis be a polyline, the routine cann't display all distances between two intersections (such as lines and curves) and just display distance between them.

Is my conclusion ture?