Drawing Polylines with AutoLISP 3

Here is the complete AutoLISP program for drawing polylines. Run it in your CAD program and see how it works.


Oh. You see all the slashes. And now you are thinking. What is that? Let me tell you what it is. It is done to make things clear.


In a Blogger blog I cannot add a listing with spaces. The spaces are removed by Blogger. So you do not see spaces.


What I did. I have replaced all spaces with a slash. You can do the same after copyin gthe program. Replaced slashes with spaces.


(defun-c:drwpl-(/-ct-ls-et-sp)
---(start)
---(drlns)
---(setq-ct-T)
---(while-ct
------(setq-ls-(fndet)
------------et-(nth-0-ls)
------------sp-(nth-1-ls)
------)
------(if-(null-et)
---------(setq-ct-nil)
---------(progn
------------(delpl)
------------(drwpl-et-sp)
---------)
------)
---)
---(endpr)
)


(defun-start-(/-p1-p2-ss)
---(setvar-"cmdecho"-0)
---(setvar-"pickbox"-10)
---(graphscr)
---(command-"limits"-(list-0.0-0.0)
---------------------(list-120.0-120.0)
---)
---(command-"snap"-10)
---(command-"grid"-10)
---(command-"zoom"-"extents")
---(setq-p1-(getvar-"vsmin")
---------p2-(getvar-"vsmax")
---)
---(setq-ss-(ssget-"c"-p1-p2))
---(if-ss
------(command-"erase"-"all"-"")
---)
---(command-"zoom"-"all")
---(command-"zoom"-"0.8x")
)


(defun-drlns-()
---(command-"line"-(list-120-0)
-------------------(list-10-0)
-------------------(list-10-120)
-------------------(list-120-120)
-------------------""
---)
---(command-"line"-(list-10-60)
-------------------(list-120-60)
-------------------""
---)
)


(defun-fndet-(/-an-el-et-ls-p1-p2-pt-sl-sp-ss-tp)
---(setq-sl-(entsel-"\nSelect-line"-))
---(if-sl
------(progn
---------(setq-et-(car-sl)
---------------el-(entget-et)
---------------sp-(cadr-sl)
---------------sp-(osnap-sp-"nea")
---------------tp-(cdr-(assoc-0-el))
---------)
---------(setq-ls-nil)
---------(if-(=-tp-"LWPOLYLINE")
------------(progn
---------------(while-(setq-nr-(caar-el))
------------------(if-(=-nr-10)
---------------------(progn
------------------------(setq-pt-(cdar-el))
------------------------(if-ls
---------------------------(setq-ls-(append-
-------------------------------------(list-pt)
-------------------------------------ls
------------------------------------)
---------------------------)
---------------------------(setq-ls-(list-pt))
------------------------)
---------------------)
------------------)
------------------(setq-el-(cddr-el))
---------------)
---------------(setq-p1-(nth-1-ls)
---------------------p2-(nth-0-ls)
---------------------an-(angle-p1-p2)
---------------)
---------------(command-"erase"-et-"")
---------------(setq-ss-(ssget-"c"-(polar-p1-an-1)
-----------------------------------(polar-p2-(+-an-pi)
-----------------------------------1)
------------------------)
---------------)
---------------(setq-et-(ssname-ss-0))
------------)
---------)
------)
------(setq-et-nil
------------sp-nil
------)
---)
---(list-et-sp)
)


(defun-delpl-(/-et-el-tp)
---(setq-et-(entlast)
---------el-(entget-et)
---------tp-(cdr-(assoc-0-el))
---)
---(if-(=-tp-"LWPOLYLINE")
------(command-"erase"-(entlast)-"")
---)
)


(defun-drwpl-(et-sp-/-el-p1-p2-an-ss)
---(setq-el-(entget-et)
---------p1-(cdr-(assoc-10-el))
---------p2-(cdr-(assoc-11-el))
---------an-(angle-p1-p2)
---------ss-(ssget-"c"-(polar-p1-an-1)
-----------------------(polar-p2-(+-an-pi)-1)
------------)
---)
---(if-(=-(sslength-ss)-1)
------(command-"pline"-p1
-----------------------"w"
-----------------------2.5
-----------------------2.5
-----------------------p2
-----------------------""
------)
------(dplip-et-sp-ss)
---)
)


(defun-dplip-(et-sp-ss-/-e1-el-ip-p1-p2-p3-p4)
---(setq-el-(entget-et)
---------p1-(cdr-(assoc-10-el))
---------p2-(cdr-(assoc-11-el))
---)
---(setq-e1-(ssname-ss-0))
---(if-(equal-et-e1)
------(setq-e1-(ssname-ss-1))
---)
---(setq-el-(entget-e1)
---------p3-(cdr-(assoc-10-el))
---------p4-(cdr-(assoc-11-el))
---)
---(if-(or-(=-(angle-p1-p2)(angle-p1-p3))-
-----------(=-(angle-p1-p2)-(angle-p2-p3))
-------)
------(setq-ip-p3)
------(setq-ip-p4)
---)
---(if-(=-(+-(distance-p1-sp)
-------------(distance-sp-ip)
----------)
----------(distance-p1-ip)
-------)
------(command-"pline"-p1
-----------------------"w"
-----------------------2.5
-----------------------2.5
-----------------------ip
-----------------------""
------)
------(command-"pline"-p2
-----------------------"w"
-----------------------2.5
-----------------------2.5
-----------------------ip
-----------------------""
------)
---)---
)


(defun-endpr-()
---(setvar-"cmdecho"-1)
---(princ)
)


(c:drwpl)


Next Posts


In the next posts I'm going to talk about all the functions of the AutoLISP program. I already have told what they are.


Something Completely Different


Here is something completely different from what you normally read in this blog. It is an imagination.


Imagine this. One day you wake up and you are a millionaire! Look at how different your life will be:


- You no longer have to worry about your debts, bills, and slaving for money.


- You can spend your time doing things you love, spend your time with your beloved family and friends.


- You no longer have to worry about money or have to be poor again. Never again living the life you used to have.


Do you want to be a millionaire? Make your dream lifestyle came true. Here's your chance to be a millionaire. Check this out.


Wake Up Millionaire:
http://l1nk.com/rfbzla



To Your Success


Free AutoLISP Course


Sorry. This offer is only for my readers from Malaysia. I want to give an AutoLISP course to them. Free of charge.


I have more than 900 readers. The majority of them is from the USA. More than 500. But I also have readers from Malaysia. About 120.


I don't know what my readers from Malaysia are doing. Are they with an engineering firm or architecture? Or just interested in AutoLISP?


I offer them a free AutoLISP course. It works like this. You let me know if interested and I'll come to your place.


I will give the AutoLISP course at your office. Your people can attend the AutoLISP course. The course consist of 15 lessons.


The first ten lessons are about AutoLISP. All the functions of AutoLISP are explained and there is talked about the system variables.


During the last five lessons we are going to write an AutoLISP program. The people attending the course come with a wish.


That is why this offer is only for my readers from Malaysia. I live in Malaysia. And I do not see how I could travel abroad.


The AutoLISP course is completely free. I will not charge you for the course. But I will ask you to refund my travel expenses.



The people attending the course will get an e-book about AutoLISP. The e-book is a PDF file. What is said in the course, can be found in the book.