Jump to content

measure distance between polylines


phoenix2009

Recommended Posts

Hi good people!

 

I like measure distance between polylines and I found nice visualLISP for starting point. This lisp make lines between polylines with can be measure.

 

But I have some problems:

1. In EX1 is new lines right angle but "step 50" is for polyline 1, I like that "step 50" is for polyline 2 like in EX2 but in EX2 is new lines wrong angle.

It's difficult to explain:)

2. New lines must be in red color

3. How measure these new lines

 

Thanks for all tips or maybe is something similar already made8)

 

Untitled.jpg

 

;; written by Fatty T.O.H. ()2005 * all rights removed
;; edited 5/14/12
;; draw perpendicular lines
;;load ActiveX library
(vl-load-com)
;;local defuns

;;//
(defun start (curve)
 (vl-catch-all-apply (function (lambda()
 (vlax-curve-getclosestpointto curve
 (vlax-curve-getstartpoint curve
   )
 )
)
   )
 )
 )
;;//
(defun end (curve)
 (vl-catch-all-apply (function (lambda()
 (vlax-curve-getclosestpointto curve
 (vlax-curve-getendpoint curve
   )
 )
)
   )
 )
 )
;;//
(defun pointoncurve (curve pt)
 (vl-catch-all-apply (function (lambda()
 (vlax-curve-getclosestpointto curve
 pt
   )
 )
)
   )
 )
;;//
(defun paramatpoint (curve pt)
 (vl-catch-all-apply (function (lambda()
 (vlax-curve-getparamatpoint curve
 pt
   )
 )
)
   )
 )
;;//
(defun distatpt (curve pt)
 (vl-catch-all-apply (function (lambda()
 (vlax-curve-getdistatpoint curve
   (vlax-curve-getclosestpointto curve pt)
   )
 )
   )
   )
 )
;;//
(defun pointatdist (curve dist)
 (vl-catch-all-apply (function (lambda()
 (vlax-curve-getclosestpointto curve
 (vlax-curve-getpointatdist curve dist)
   )
 )
)
   )
 )
;;//
(defun curvelength (curve)
 (vl-catch-all-apply (function (lambda()
 (vlax-curve-getdistatparam curve
 (- (vlax-curve-getendparam curve)
    (vlax-curve-getstartparam curve)
   )
 )
 )
)
   )
 )
;;//
(defun distatparam (curve param)
 (vl-catch-all-apply (function (lambda()
 (vlax-curve-getdistatparam curve
 param
 )
 )
   )
   )
 )
;;// written by VovKa (Vladimir Kleshev)
(defun gettangent (curve pt)

 (setq param (paramatpoint curve pt)
       ang ((lambda (deriv)
    (if (zerop (cadr deriv))
      (/ pi 2)
      (atan (apply '/ deriv))
    )
  )
   (cdr (reverse
   (vlax-curve-getfirstderiv curve param)
        )
   )
 )
)
 ang
 )
;;// main program
;;--------------------------------------------------;;
(defun c:DIP (/ *error* acsp adoc cnt div en en2 ent ent2 ip lastp leng ln lnum mul num pt rot sign start step)

 (defun *error* (msg)
     (vla-endundomark (vla-get-activedocument
             (vlax-get-acad-object))
      )
   (cond ((or (not msg)
       (member msg '("console break" "Function cancelled" "quit / exit abort"))
       )
   )
  ((princ (strcat "\nError: " msg)))
  )

   (princ)
   )

 (setq adoc (vla-get-activedocument (vlax-get-acad-object))
   acsp (vla-get-block (vla-get-activelayout adoc))
    )



(while (not
  (and
    (or
      (initget 6)
      (setq step (getreal "\nEnter step <50>: "))
      (if (not step)
 (setq step 50.)))
    ))
  (alert "\nEnter a step")
  )

(if (and
 (setq
   ent (entsel
  "\nSelect polyline 1 >>"
  )
   )
(setq
   ent2 (entsel
  "\nSelect polyline 2  >>"
  )
   )
 )
  (progn
    (setq en (car ent)
   pt (pointoncurve en (cadr ent))
   leng (distatparam en (vlax-curve-getendparam en))
   en2 (car ent2)
   )
    (setq num (fix (/ leng step))
   )
    (setq div (fix (/ 100. step)
     )
   )
    (setq mul (- leng
   (* (setq lnum (fix (/ leng (* step div)))) (* step div))))
    (if (not (zerop mul))
      (setq lastp T)
      (setq lastp nil)
      )
    (if (> (- (paramatpoint en pt)
       (paramatpoint en (vlax-curve-getstartpoint en))
       )
    (- (paramatpoint en (vlax-curve-getendpoint en))
       (paramatpoint en pt)
       )
    )
      (progn
 (setq start leng
       sign  -1
       )
 )
      (progn
 (setq start (distatparam en (vlax-curve-getstartparam en))
       sign  1
       )
 )
      )

    (vla-startundomark
      (vla-get-activedocument (vlax-get-acad-object))
      )
    (setq cnt 0)
    (repeat (1+ num)
      (setq pt  (pointatdist en start)
     rot (gettangent en pt)
     )

(setq ln (vlax-invoke-method acsp 'addline (setq ip (vlax-3d-point pt))(vlax-3d-point(pointoncurve en2 pt))))
      (setq cnt   (1+ cnt)
     start (+ start (* sign step))
     )
      )

    (if lastp
      (progn
 (if (= sign -1)
   (progn
     (setq pt  (vlax-curve-getstartpoint en)
    rot (gettangent en pt)
    )
     )
   (progn
     (setq pt  (vlax-curve-getendpoint en)
    rot (gettangent en pt)
    )
     )
   )
(setq ln (vlax-invoke-method acsp 'addline (setq ip (vlax-3d-point pt))(vlax-3d-point(pointoncurve en2 pt))))

 )
      )

    )
  (princ "\nNothing selected")
  )
 (*error* nil)
(princ)
)
(prompt "\n   >>>   Type DIP to execute...")
(prin1)

pencil.png

Link to comment
Share on other sites

  • Replies 30
  • Created
  • Last Reply

Top Posters In This Topic

  • phoenix2009

    10

  • Lee Mac

    7

  • irneb

    5

  • zamri_uut

    3

Top Posters In This Topic

Posted Images

In Example 1 the lines are perpendicular to Polyline 2 and in Example 2 the lines are perpendicular to Polyline 1.

 

It looks as though you need to consider which polyline should be picked first. It is important to the LISP routine which line is picked first.

Link to comment
Share on other sites

Thank You for Your response!

Yes You are correct. I like Example 1 the lines are perpendicular to Polyline 2 but I need that "step 50" is also to Polyline 2 not Polyline 1. It's difficult.

Link to comment
Share on other sites

Thank You for Your response!

Yes You are correct. I like Example 1 the lines are perpendicular to Polyline 2 but I need that "step 50" is also to Polyline 2 not Polyline 1. It's difficult.

 

You are more than welcome.

 

Step 50 is the distance between the lines on the first polyline that was picked, hence the two differnt situations. You can not have Step 50 on both polylines because it is mathematically not possible. In my opinion, it would be possible to do what you want but that would require the LISP routine to be rewritten and ufortunately I am not your man to do that. There are other members here on the forum that could do that.

Link to comment
Share on other sites

Thanks anyway Tyke!

I have learned some visualLisp functions and trying to fix it myself, but it's just to difficult for me. To me autoLisp functions are much easier. If there is some good people and smart member then I am so thankful;)

Link to comment
Share on other sites

If you don't mind having the lines non-perp to either of the polylines, then it is possible. Perhaps try something like this:

(defun c:DrawLinesBetweenPollys  (/ dist poly1 poly2 dist1 len1 len2 getPoly2Corresponding clay)
 (or *DistBetweenLines* (setq *DistBetweenLines* 50.0))
 (if (and (or (setq dist (getdist (strcat "\nHow far between lines <" (rtos *DistBetweenLines*) ">: ")))
              (setq dist *DistBetweenLines*))
          (setq poly1 (entsel "\nPick first defining polyline: "))
          (setq poly2 (entsel "\nPick 2nd polyline: ")))
   (progn (setq poly1 (car poly1)
                poly2 (car poly2)
                dist1 0.0
                len1  (vlax-curve-getDistAtParam poly1 (vlax-curve-getEndParam poly1))
                len2  (vlax-curve-getDistAtParam poly2 (vlax-curve-getEndParam poly2))
                clay  (getvar "CLayer"))
          ;; Check if poly's are not co-directional - swap directions
          (if (inters (vlax-curve-getPointAtParam poly1 0.0)
                      (vlax-curve-getPointAtParam poly2 0.0)
                      (vlax-curve-getPointAtParam poly1 (vlax-curve-getEndParam poly1))
                      (vlax-curve-getPointAtParam poly2 (vlax-curve-getEndParam poly2)))
            (defun getPoly2Corresponding (d) (vlax-curve-getPointAtDist poly2 (- len2 (* (/ dist1 len1) len2))))
            (defun getPoly2Corresponding (d) (vlax-curve-getPointAtDist poly2 (* (/ dist1 len1) len2))))
          (while (<= dist1 len1)
            (entmake (list '(0 . "LINE")
                           (cons 10 (vlax-curve-getPointAtDist poly1 dist1))
                           (cons 11 (getPoly2Corresponding dist1))
                           (cons 8 clay)))
            (setq dist1 (+ dist1 dist)))))
 (princ))

Link to comment
Share on other sites

Very nice code, but the new lines should be perpendicular and red colour.

Thank You for response!

To get them in red colour, add a line like '(62 . 1) somewhere into that entmake list. Or simply set a layer which has colour = red current before running the code (that would actually be my choice as I avoid drawing with overridden colours as much as possible - rather use a different layer and keep to colour ByLayer).

 

As for perpendicular, it's impossible to get what you're after. You're either going to end up with something looking like EX2 (in some cases - note it might happen somewhere along Polyline 2 also depending on its shape) or you're going to end up with lines crossing each other (which I think is not what you want). It's physically impossible to have lines drawn perpendicular to one polyline but eqally spaced between two. One of those rules will have to break.

 

Try drawing this manually and see if you can get at what you're after. If you can, then post that DWG here so we can understand what you did and calculate the lisp from that.

Link to comment
Share on other sites

What I like to have is something similar like below:

The new lines is perpendicular to polyline 1 and and "step 50" is also on polyline 1 and then that lines measurements.

Thanks for going deeper into!

Untitled2.jpg

Link to comment
Share on other sites

If the lines is shortest way to between polylines and step 50 is also to upper polyline (in last case), then it would be nice:) But how about dimensions, is it doable?

Link to comment
Share on other sites

So you want a lisp which alternates between 3 possibilities:

 

  1. Always perpendicular to one of the polylines; or
  2. If the distance between the non-perp ends of the lines is less than the specified distance, then swap to be perp to the other polyline; or
  3. If lines are going to cross each other then use my method from post #6

Am I understanding correctly?

 

 

Sorry, what would you want with dimensions? Referring to the 50 units? Or do you somehow want to also place dimension in this somewhere?

Link to comment
Share on other sites

It's ok if the lines going to cross each other but yes always perpendicular and "step 50" to first of the polylines.

I like to place dimension of the new lines like I show on my post 9.

Link to comment
Share on other sites

Unless I have misunderstood, perhaps try something like:

 

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] d1 d2 d3 e1 e2 ip p1 sp xl )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] e1 (LM:ssget [color=MAROON]"\nSelect 1st Polyline: "[/color] '([color=MAROON]"_+.:E:S"[/color] ((0 . [color=MAROON]"LWPOLYLINE"[/color])))))
           ([color=BLUE]setq[/color] e2 (LM:ssget [color=MAROON]"\nSelect 2nd Polyline: "[/color] '([color=MAROON]"_+.:E:S"[/color] ((0 . [color=MAROON]"LWPOLYLINE"[/color])))))
           ([color=BLUE]progn[/color]
               ([color=BLUE]initget[/color] 6)
               ([color=BLUE]setq[/color] d1 ([color=BLUE]getdist[/color]  [color=MAROON]"\nSpecify Step Distance: "[/color]))
           )
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] d3 ([color=BLUE]-[/color] d1)
                 e1 ([color=BLUE]ssname[/color] e1 0)
                 e2 ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] e2 0))
                 d2 ([color=BLUE]vlax-curve-getdistatparam[/color] e1 ([color=BLUE]vlax-curve-getendparam[/color] e1))
                 sp ([color=BLUE]vlax-get-property[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))
                        ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'cvport)) 'paperspace 'modelspace)
                    )
           )
           ([color=BLUE]while[/color] ([color=BLUE]<=[/color] ([color=BLUE]setq[/color] d3 ([color=BLUE]+[/color] d3 d1)) d2)
               ([color=BLUE]setq[/color] p1 ([color=BLUE]vlax-curve-getpointatdist[/color] e1 d3))
               ([color=BLUE]setq[/color] xl
                   ([color=BLUE]vlax-invoke[/color] sp 'addxline p1
                       ([color=BLUE]trans[/color]
                           ([color=BLUE]polar[/color] ([color=BLUE]trans[/color] p1 0 1)
                               ([color=BLUE]+[/color]
                                   ([color=BLUE]angle[/color] '(0.0 0.0)
                                       ([color=BLUE]trans[/color]
                                           ([color=BLUE]vlax-curve-getfirstderiv[/color] e1
                                               ([color=BLUE]vlax-curve-getparamatpoint[/color] e1 p1)
                                           )
                                           0 1
                                       )
                                   )
                                   ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.0)
                                )
                                1.0
                            )
                            1 0
                        )
                    )
               )
               ([color=BLUE]if[/color] ([color=BLUE]setq[/color] ip ([color=BLUE]vlax-invoke[/color] xl 'intersectwith e2 [color=BLUE]acextendthisentity[/color]))
                   ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 p1) ([color=BLUE]list[/color] 11 ([color=BLUE]car[/color] ip) ([color=BLUE]cadr[/color] ip) ([color=BLUE]caddr[/color] ip))))
               )
               ([color=BLUE]vla-delete[/color] xl)
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; ssget  -  Lee Mac[/color]
[color=GREEN];; A wrapper for the ssget function to permit the use of a custom selection prompt[/color]
[color=GREEN];;[/color]
[color=GREEN];; Arguments:[/color]
[color=GREEN];; msg    - selection prompt[/color]
[color=GREEN];; params - list of ssget arguments[/color]

([color=BLUE]defun[/color] LM:ssget ( msg params [color=BLUE]/[/color] sel )
   ([color=BLUE]princ[/color] msg)
   ([color=BLUE]setvar[/color] 'nomutt 1)
   ([color=BLUE]setq[/color] sel ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]ssget[/color] params))
   ([color=BLUE]setvar[/color] 'nomutt 0)
   ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] sel)) sel)
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Link to comment
Share on other sites

Or perhaps:

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] a1 d1 d2 d3 e1 e2 ip p1 p2 sp xl zv )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] e1 (LM:ssget [color=MAROON]"\nSelect 1st Polyline: "[/color] '([color=MAROON]"_+.:E:S"[/color] ((0 . [color=MAROON]"LWPOLYLINE"[/color])))))
           ([color=BLUE]setq[/color] e2 (LM:ssget [color=MAROON]"\nSelect 2nd Polyline: "[/color] '([color=MAROON]"_+.:E:S"[/color] ((0 . [color=MAROON]"LWPOLYLINE"[/color])))))
           ([color=BLUE]progn[/color]
               ([color=BLUE]initget[/color] 6)
               ([color=BLUE]setq[/color] d1 ([color=BLUE]getdist[/color]  [color=MAROON]"\nSpecify Step Distance: "[/color]))
           )
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] d3 ([color=BLUE]-[/color] d1)
                 e1 ([color=BLUE]ssname[/color] e1 0)
                 e2 ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] e2 0))
                 d2 ([color=BLUE]vlax-curve-getdistatparam[/color] e1 ([color=BLUE]vlax-curve-getendparam[/color] e1))
                 zv ([color=BLUE]trans[/color] '(0.0 0.0 1.0) 1 0 [color=BLUE]t[/color])
                 sp ([color=BLUE]vlax-get-property[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))
                        ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'cvport)) 'paperspace 'modelspace)
                    )
           )
           ([color=BLUE]while[/color] ([color=BLUE]<=[/color] ([color=BLUE]setq[/color] d3 ([color=BLUE]+[/color] d3 d1)) d2)
               ([color=BLUE]setq[/color] p1 ([color=BLUE]vlax-curve-getpointatdist[/color] e1 d3)
                     a1 ([color=BLUE]-[/color] ([color=BLUE]angle[/color] '(0.0 0.0) ([color=BLUE]trans[/color] ([color=BLUE]vlax-curve-getfirstderiv[/color] e1 ([color=BLUE]vlax-curve-getparamatpoint[/color] e1 p1)) 0 1)) ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.0))
                     xl ([color=BLUE]vlax-invoke[/color] sp 'addxline p1 ([color=BLUE]trans[/color] ([color=BLUE]polar[/color] ([color=BLUE]trans[/color] p1 0 1) a1 1.0) 1 0))
               )
               ([color=BLUE]if[/color] ([color=BLUE]setq[/color] ip ([color=BLUE]vlax-invoke[/color] xl 'intersectwith e2 [color=BLUE]acextendthisentity[/color]))
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]setq[/color] p2 ([color=BLUE]list[/color] ([color=BLUE]car[/color] ip) ([color=BLUE]cadr[/color] ip) ([color=BLUE]caddr[/color] ip)))
                       ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 p1) ([color=BLUE]cons[/color] 11 p2)))
                       ([color=BLUE]entmake[/color]
                           ([color=BLUE]list[/color]
                              '(0 . [color=MAROON]"TEXT"[/color])
                               ([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] p1 0 zv))
                               ([color=BLUE]cons[/color] 11 ([color=BLUE]trans[/color] p1 0 zv))
                               ([color=BLUE]cons[/color] 50 ([color=BLUE]+[/color] a1 ([color=BLUE]angle[/color] '(0.0 0.0) ([color=BLUE]trans[/color] ([color=BLUE]getvar[/color] 'ucsxdir) 0 zv [color=BLUE]t[/color]))))
                               ([color=BLUE]cons[/color] 40 ([color=BLUE]getvar[/color] 'textsize))
                               ([color=BLUE]cons[/color] 07 ([color=BLUE]getvar[/color] 'textstyle))
                               ([color=BLUE]cons[/color] 01 ([color=BLUE]strcat[/color] [color=MAROON]"L="[/color] ([color=BLUE]rtos[/color] ([color=BLUE]distance[/color] p1 p2) 2) [color=MAROON]"m"[/color]))
                              '(72 . 0)
                              '(73 . 2)
                               ([color=BLUE]cons[/color] 210 zv)
                           )
                       )
                   )                                
               )
               ([color=BLUE]vla-delete[/color] xl)
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; ssget  -  Lee Mac[/color]
[color=GREEN];; A wrapper for the ssget function to permit the use of a custom selection prompt[/color]
[color=GREEN];;[/color]
[color=GREEN];; Arguments:[/color]
[color=GREEN];; msg    - selection prompt[/color]
[color=GREEN];; params - list of ssget arguments[/color]

([color=BLUE]defun[/color] LM:ssget ( msg params [color=BLUE]/[/color] sel )
   ([color=BLUE]princ[/color] msg)
   ([color=BLUE]setvar[/color] 'nomutt 1)
   ([color=BLUE]setq[/color] sel ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]ssget[/color] params))
   ([color=BLUE]setvar[/color] 'nomutt 0)
   ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] sel)) sel)
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

The above should also perform correctly in all UCS & Views.

Link to comment
Share on other sites

It's like christmas again and present for me :shock::shock::shock: Thank You so much!!!

But how to put all new lines and dimensions to layer "dimensions" and make them red color and linetype dashed2.

Is it possible write if statement for case when polylines is crossing each other. Make the lines yellow color and dimensions negative(see image below). That would be perfect!!!

 

Untitled3.jpg

Link to comment
Share on other sites

You're welcome, you caught me in a generous mood ;)

 

The property changes are simple, the test for crossing polylines is not so simple:

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] a1 d1 d2 d3 e1 e2 ip p1 p2 sp xl zv )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] e1 (LM:ssget [color=MAROON]"\nSelect 1st Polyline: "[/color] '([color=MAROON]"_+.:E:S"[/color] ((0 . [color=MAROON]"LWPOLYLINE"[/color])))))
           ([color=BLUE]setq[/color] e2 (LM:ssget [color=MAROON]"\nSelect 2nd Polyline: "[/color] '([color=MAROON]"_+.:E:S"[/color] ((0 . [color=MAROON]"LWPOLYLINE"[/color])))))
           ([color=BLUE]progn[/color]
               ([color=BLUE]initget[/color] 6)
               ([color=BLUE]setq[/color] d1 ([color=BLUE]getdist[/color] [color=MAROON]"\nSpecify Step Distance: "[/color]))
           )
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] d3 ([color=BLUE]-[/color] d1)
                 e1 ([color=BLUE]ssname[/color] e1 0)
                 e2 ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] e2 0))
                 d2 ([color=BLUE]vlax-curve-getdistatparam[/color] e1 ([color=BLUE]vlax-curve-getendparam[/color] e1))
                 zv ([color=BLUE]trans[/color] '(0.0 0.0 1.0) 1 0 [color=BLUE]t[/color])
                 sp ([color=BLUE]vlax-get-property[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))
                        ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'cvport)) 'paperspace 'modelspace)
                    )
           )
           ([color=BLUE]while[/color] ([color=BLUE]<=[/color] ([color=BLUE]setq[/color] d3 ([color=BLUE]+[/color] d3 d1)) d2)
               ([color=BLUE]setq[/color] p1 ([color=BLUE]vlax-curve-getpointatdist[/color] e1 d3)
                     a1 ([color=BLUE]-[/color] ([color=BLUE]angle[/color] '(0.0 0.0) ([color=BLUE]trans[/color] ([color=BLUE]vlax-curve-getfirstderiv[/color] e1 ([color=BLUE]vlax-curve-getparamatpoint[/color] e1 p1)) 0 1)) ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.0))
                     xl ([color=BLUE]vlax-invoke[/color] sp 'addxline p1 ([color=BLUE]trans[/color] ([color=BLUE]polar[/color] ([color=BLUE]trans[/color] p1 0 1) a1 1.0) 1 0))
               )
               ([color=BLUE]if[/color] ([color=BLUE]setq[/color] ip ([color=BLUE]vlax-invoke[/color] xl 'intersectwith e2 [color=BLUE]acextendthisentity[/color]))
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]setq[/color] p2 ([color=BLUE]list[/color] ([color=BLUE]car[/color] ip) ([color=BLUE]cadr[/color] ip) ([color=BLUE]caddr[/color] ip)))
                       ([color=BLUE]entmake[/color]
                           ([color=BLUE]list[/color]
                              '(00 . [color=MAROON]"LINE"[/color])
                              '(08 . [color=MAROON]"Dimensions"[/color])
                              '(62 . 1)
                               ([color=BLUE]cons[/color] 06 ([color=BLUE]if[/color] ([color=BLUE]tblsearch[/color] [color=MAROON]"LTYPE"[/color] [color=MAROON]"DASHED2"[/color]) [color=MAROON]"DASHED2"[/color] [color=MAROON]"Continuous"[/color]))
                               ([color=BLUE]cons[/color] 10 p1)
                               ([color=BLUE]cons[/color] 11 p2)
                           )
                       )
                       ([color=BLUE]entmake[/color]
                           ([color=BLUE]list[/color]
                              '(00 . [color=MAROON]"TEXT"[/color])
                              '(08 . [color=MAROON]"Dimensions"[/color])
                               ([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] p1 0 zv))
                               ([color=BLUE]cons[/color] 11 ([color=BLUE]trans[/color] p1 0 zv))
                               ([color=BLUE]cons[/color] 50 ([color=BLUE]+[/color] a1 ([color=BLUE]angle[/color] '(0.0 0.0) ([color=BLUE]trans[/color] ([color=BLUE]getvar[/color] 'ucsxdir) 0 zv [color=BLUE]t[/color]))))
                               ([color=BLUE]cons[/color] 40 ([color=BLUE]getvar[/color] 'textsize))
                               ([color=BLUE]cons[/color] 07 ([color=BLUE]getvar[/color] 'textstyle))
                               ([color=BLUE]cons[/color] 01 ([color=BLUE]strcat[/color] [color=MAROON]"L="[/color] ([color=BLUE]rtos[/color] ([color=BLUE]distance[/color] p1 p2) 2) [color=MAROON]"m"[/color]))
                              '(72 . 0)
                              '(73 . 2)
                              '(62 . 1)
                               ([color=BLUE]cons[/color] 210 zv)
                           )
                       )
                   )                                
               )
               ([color=BLUE]vla-delete[/color] xl)
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; ssget  -  Lee Mac[/color]
[color=GREEN];; A wrapper for the ssget function to permit the use of a custom selection prompt[/color]
[color=GREEN];;[/color]
[color=GREEN];; Arguments:[/color]
[color=GREEN];; msg    - selection prompt[/color]
[color=GREEN];; params - list of ssget arguments[/color]

([color=BLUE]defun[/color] LM:ssget ( msg params [color=BLUE]/[/color] sel )
   ([color=BLUE]princ[/color] msg)
   ([color=BLUE]setvar[/color] 'nomutt 1)
   ([color=BLUE]setq[/color] sel ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]ssget[/color] params))
   ([color=BLUE]setvar[/color] 'nomutt 0)
   ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] sel)) sel)
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...