Need help finding or creating an unusual lisp

Hi all

This is a hard one to try to explain, I've searched the site, the net looking for this but I've come up empty handed, this maybe partly due to not knowing what to enter in the search fields or no-one has asked for anything like this yet

Hopefully someone has and a link is all this needs..

So what I'm looking for is a lisp to help with drawing some lines.. (the easy part to explain, now the awkward bit), however I want to select an endpoint and have it automatically draw 2 lines perpendicular from the startpoint to the nearest other line

(hope that makes some sense? I've rewritten it 3 times..

I tried making my own lisp but failed miserably (I've never written my own before, only tweaked others to suit my needs)

Could anyone help? I would really appreciate it..

This is an example of what I'm trying to do

Click an endpoint (highlighted by the red circle) and draw 2 lines (shown green) from the endpoint to the nearest line perpendicular from the startpoint

test.dwg

Here is my failing lisp attempt

Although it does not work it may help you understand what I'm asking for, better than my question does

(defun c:test (/ pt1 pt2)

(setq pt1 (getpoint "\nSelect endpoint"))

(setq pt2 (osnap pt1 "per"))

(command "line" pt1 pt2)

(princ)

)

Also I would like to add.... The distance from the endpoint will vary from drawing to drawing, however the 2 lines are always the same length as each other.

At present I am drawing these manually with line command from endpoint to perpendicular (using osnaps)

There are anywhere from 10 to 100 of these per drawing and between 10 to 20 drawings per day 5 days a week.

As you can imagine after 10 years its now becoming a tedious task, if I could down my clicking by even half, I would be over the moon..

Welcome to CADTutor

Do you have access to Visual LISP on AutoCAD 2000? (to check, type (vl-load-com) at the command-line, this should return nil or nothing at all if successful).

That question I can't answer till Monday I'm afraid, Its on a company PC... To be honest I don't think it does, its not even got Express Tools...

I'm using a friends PC which has AutoCAD 2015 on it here atm. I believe in the next week or 2 The AutoCAD 2000 will be replaced/upgraded with 2015 (just waiting for the company to buy the licences)

OK, assuming you will eventually have access to VL, the following code should allow you to simply window over all of your circles/arcs (any size / any angle) and will construct the necessary lines as per your example drawing:

(defun c:test ( / cir ent enx idx lst pt1 pt2 sel )
   (if
       (setq sel
           (ssget
              '(
                   (-4 . "<OR")
                       (-4 . "<AND")
                           (0 . "ARC")
                           (8 . "PP1")
                       (-4 . "AND>")
                       (-4 . "<AND")
                           (0 . "CIRCLE")
                           (8 . "PP2")
                       (-4 . "AND>")
                   (-4 . "OR>")
               )
           )
       )
       (progn
           (repeat (setq idx (sslength sel))
               (setq ent (ssname sel (setq idx (1- idx)))
                     enx (entget ent)
               )
               (if (= "ARC" (cdr (assoc 0 enx)))
                   (setq lst (consunique (vlax-curve-getstartpoint ent) (consunique (vlax-curve-getendpoint ent) lst)))
                   (setq cir (cons ent cir))
               )
           )
           (foreach pt1 lst
               (mapcar
                  '(lambda ( pt2 x )
                       (entmake (list '(0 . "LINE") '(8 . "Layer2") (cons 10 pt1) (cons 11 pt2)))
                   )
                   (vl-sort (mapcar '(lambda ( x ) (vlax-curve-getclosestpointto x pt1)) cir)
                      '(lambda ( a b ) (< (distance pt1 a) (distance pt1 b)))
                   )
                  '(0 1)
               )   
           )
       )
   )
   (princ)
)

(defun consunique ( itm lst )
   (if (vl-some '(lambda ( x ) (equal x itm 1e-) lst)
       lst
       (cons itm lst)
   )
)

(vl-load-com) (princ)

Here's a quick demo:

I may be able to put together a Vanilla AutoLISP version if I find some time.

Lee

Wow... That looks awesome

I'll give it a try on Monday and get back to you

Thank you so much for the quick reply Lee

You're welcome!

Here's a Vanilla version if necessary:

(defun c:test ( / cir ent enx idx lst pt1 pt2 sel )
   (if
       (setq sel
           (ssget
              '(
                   (-4 . "<OR")
                       (-4 . "<AND")
                           (0 . "ARC")
                           (8 . "PP1")
                       (-4 . "AND>")
                       (-4 . "<AND")
                           (0 . "CIRCLE")
                           (8 . "PP2")
                       (-4 . "AND>")
                   (-4 . "OR>")
               )
           )
       )
       (progn
           (repeat (setq idx (sslength sel))
               (setq ent (ssname sel (setq idx (1- idx)))
                     enx (entget ent)
               )
               (if (= "ARC" (cdr (assoc 0 enx)))
                   (foreach pnt (LM:arcendpoints ent) (setq lst (consunique pnt lst)))
                   (setq cir (cons (list (trans (cdr (assoc 10 enx)) ent 0) (cdr (assoc 40 enx))) cir))
               )
           )
           (foreach pt1 lst
               (mapcar
                  '(lambda ( pt2 x )
                       (entmake (list '(0 . "LINE") '(8 . "Layer2") (cons 10 pt1) (cons 11 pt2)))
                   )
                   (LM:quicksort (mapcar '(lambda ( x ) (polar (car x) (angle (car x) pt1) (cadr x))) cir)
                      (lambda ( a b ) (< (distance pt1 a) (distance pt1 b)))
                   )
                  '(0 1)
               )   
           )
       )
   )
   (princ)
)

(defun consunique ( itm lst / tmp tst )
   (setq tmp lst)
   (while (and (setq tst (car tmp)) (not (equal itm tst 1e-))
       (setq tmp (cdr tmp))
   )
   (if tmp lst (cons itm lst))
)

;; Arc Endpoints  -  Lee Mac
;; Returns the endpoints of an Arc expressed in WCS

(defun LM:ArcEndpoints ( ent / cen nrm rad )
   (setq ent  (entget ent)
         nrm  (cdr (assoc 210 ent))
         cen  (cdr (assoc 010 ent))
         rad  (cdr (assoc 040 ent))
   )
   (mapcar
       (function
           (lambda ( ang )
               (trans (mapcar '+ cen (list (* rad (cos ang)) (* rad (sin ang)) 0.0)) nrm 0)
           )
       )
       (list (cdr (assoc 50 ent)) (cdr (assoc 51 ent)))
   )
)

;; Quicksort  -  Lee Mac
;; An implementation of the quicksort algorithm

(defun LM:quicksort ( lst fun )
   (if lst (LM:quicksort-recurse (car lst) (cdr lst) fun))
)
(defun LM:quicksort-recurse ( itm lst fun / ls1 ls2 )
   (foreach x lst
       (if (fun itm x)
           (setq ls1 (cons x ls1))
           (setq ls2 (cons x ls2))
       )
   )
   (append (LM:quicksort (reverse ls2) fun) (cons itm (LM:quicksort (reverse ls1) fun)))
)

(princ)

Thank You once again..

One day hopefully I will be able to create my own lisps, rather than just tweaking others..

I've spent the last 2 weeks reading the Autodesk AutoLisp guide... Just waiting for the information to sink in (must have a dense head lol)

Hi Lee (or anyone else) Could I ask you to tweak this slightly?

I forgot to mention the layers that I need ( sorry )

The outer Shapes should have been on layer PP1 and the inner shapes on layer PP2, the line on Layer2 should be drawn from the endpoint of PP1 to the perpendicular of pp2.

I hope this isn't too much hassle to change?

Thanks yet again

Hi buzzerknocker,

The current code should allow you to select & process arcs & circles residing on any layers, and does not restrict the user to selecting objects on specific layers in the drawing; are you saying that you wish to restrict the selection?

Lee

If that is possible yes...

The drawings usually contain many used layers, but I would only like the lines to start from the pp1 layer (endpoint) and finish on the pp2 layer (perpendicular).

My apologies for not explaining this at the start, to be honest after searching for so long I didn't expect such promising results

OK, I have updated my two earlier code posts.

Your the Man! Thankyou

Your the Man! Thankyou

No worries!

Hi Lee

I used the Lisp that you created at work today, oh my gosh it worked like a dream... I actually Completed all of my drawing with 2 hours to spare, that's how much I needed this.

My hat is off and I salute you...

I checked the For Visual-Lisp on my AutoCAD2000 and it has got it. so the first Lisp worked first time.

Now I don't want to seem cheeky, I would like to ask for another revamp to this Lisp (if possible?)

We started making some more complex drawings a while back, I've not had to create any myself yet but I will have to once the new AutoCad2015 comes in. I tried the lisp on one of those but it didn't do anything, I think it may have something to do with the linetype?

The Lines drawn are Polylines, they will also have some data assigned to them (not sure if that makes a difference) but because if the data they cannot be exploded as the data will be lost.

Here is a file attached, again on the left is the raw shape on layers pp1 and pp2 and the right shows the new lines (I think on layer 0 but that doesn't matter much) drawn from the endpoints to perpendicular as before.

If this is not possible, or too much work then please don't worry to tell me so, as I said before you have saved me so much time today and will do for the next coming time I'm already happy..

Oops I forgot the file

TEST2.dwg

Certainly possible to automate, but will take more work to design the code - unfortunately more time than I can justify donating without charge.

Feel free to drop me a message through my site, and we can take the development from there.

Lee

Cool.. Thanks Lee. I'll be in touch