Jump to content

Orthogonal polyline lisp....a little help here


Utah_Indie

Recommended Posts

I started developing a lisp that will check all the polylines in a drawing for either the x or the y coordinate to be equal and change the color of each polyline that does not meet the criteria to red from "bylayer".

 

I am having trouble with looping through each object sequentially and also the loop comparison of each vertex within the current object.

 

Where I am trying to get to again is to check that all polylines within an architectural type of drawing are square and to alert which ones are not.

 

I'm not a lisp expert so bear with me. If you want to correct my syntax great, or tutor me on what I'm doing so dreadfully wrong--even better.

Thanks,

Randy (first post)

 

The code so far:

 

(defun C:perp()

 

(defun A1()

 

(setq eFilter(list (cons 0 "polyline"))); entity names into a list

(ssget "X" eFilter)

); ends defun A1

(defun B1()

(setq eLen(length eList)); gets length of list

); ends defun b1

(defun D1()

(setq Lwn 0); variable initial definition

(setq e 0); ditto

(repeat eLen ; repeat for length of entity list

(setq e1(car (nth n e)))

(if

(= e1 10)

(progn

(terpri)

(princ (cdr(nth n e)))

); closes progn

 

); closes if

(setq Lwn (+ 1 Lwn))

(setq a (cdr (nth n e)))

); closes repeat

); closes D1

(defun Esub()

(trace Esub)

(setq coordLen(length e1))

); closes Esub

(repeat coordLen; repeat for length of coordinate list

(defun G1() ;parse coordinates into xa ya xb yb

(setq a (cdr (nth coordLen e)))

(setq b (cdr (nth (+ coordLen 1) (+ e 1))))

) ; ends G1

;---------------BEGIN SUBROUTINE H1----------------------

(defun H1()

(setq xa(car a))

(setq ya(cadr a))

(setq xb(car b))

(setq yb(cadr b))

); closes H1

(defun H2()

(= 0 (- xa xb))

(= 0 (- ya yb))

(T (Command "chprop" "p" "" "c" "red" ""))

); closes h2

); closes repeat

)

Link to comment
Share on other sites

Are you sure all of the entities are old style heavy weight polyines, not LWPolylines? They have to be handled in 2 distinct manners. Also, you will need to determine a tolerance for the comparisons. The (=) is too stringent for most of these type calculations. -David

Link to comment
Share on other sites

If you are sure the points are snapped to fairly high tolerences, this could be the basic test for a point list:

 

[b][color=BLACK]([/color][/b]setq pl '[b][color=FUCHSIA]([/color][/b][b][color=NAVY]([/color][/b]0 1 0[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]0 4 0[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]0 6 0[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

[b][color=BLACK]([/color][/b]defun ortholst [b][color=FUCHSIA]([/color][/b]pl / xvals yvals xeq yeq[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq xvals [b][color=NAVY]([/color][/b]mapcar 'car pl[b][color=NAVY])[/color][/b]
       yvals [b][color=NAVY]([/color][/b]mapcar 'cadr pl[b][color=NAVY])[/color][/b]
       xeq [b][color=NAVY]([/color][/b]apply '= xvals[b][color=NAVY])[/color][/b]
       yeq [b][color=NAVY]([/color][/b]apply '= yvals[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]or xeq yeq[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

[b][color=BLACK]([/color][/b]prin1 [b][color=FUCHSIA]([/color][/b]ortho_lst pl[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

 

Returns T if either all X or Y values are equal. -David

Link to comment
Share on other sites

Thanks David. They do need to be snapped or upon importing to an ESRI GIS platform, a sliver 'parcel' will be created in any void areas. I think I can probably navigate testing either LWPOLYLINES or POLYLINE objects separately. Do you have a sense of where my loop is breaking down? I may have objects to evaluate with 30 or so vertices. Also, I may need to duplicate the first coordinate for the first test as n+1=0 is a clumsy first comparison if that makes any sense.

Link to comment
Share on other sites

I think I grasp what you are trying to do.

 

This could be a starting point LWPOLYINES:

[b][color=BLACK]([/color][/b]defun massoc [b][color=FUCHSIA]([/color][/b]key alist / x nlist[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]foreach x alist
   [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]eq key [b][color=GREEN]([/color][/b]car x[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
       [b][color=MAROON]([/color][/b]setq nlist [b][color=GREEN]([/color][/b]cons [b][color=BLUE]([/color][/b]cdr x[b][color=BLUE])[/color][/b] nlist[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]reverse nlist[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

[b][color=BLACK]([/color][/b]defun ortholst [b][color=FUCHSIA]([/color][/b]pl / xvals yvals xeq yeq[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq xvals [b][color=NAVY]([/color][/b]mapcar 'car pl[b][color=NAVY])[/color][/b]
       yvals [b][color=NAVY]([/color][/b]mapcar 'cadr pl[b][color=NAVY])[/color][/b]
       xeq [b][color=NAVY]([/color][/b]apply '= xvals[b][color=NAVY])[/color][/b]
       yeq [b][color=NAVY]([/color][/b]apply '= yvals[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]or xeq yeq[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

[color=#8b4513];[b][color=BLACK]([/color][/b]setq pl '[b][color=FUCHSIA]([/color][/b][b][color=NAVY]([/color][/b]0 1 0[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]0. 4 0[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]0. 6 0[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b][/color]

[b][color=BLACK]([/color][/b]and [b][color=FUCHSIA]([/color][/b]setq i -1
         cs [b][color=NAVY]([/color][/b]ssadd[b][color=NAVY])[/color][/b]
         ss [b][color=NAVY]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]0 . [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
    [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq en [b][color=MAROON]([/color][/b]ssname ss [b][color=GREEN]([/color][/b]setq i [b][color=BLUE]([/color][/b]1+ i[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
           [b][color=NAVY]([/color][/b]setq ed [b][color=MAROON]([/color][/b]entget en[b][color=MAROON])[/color][/b]
                 pl [b][color=MAROON]([/color][/b]massoc 10 ed[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
           [b][color=NAVY]([/color][/b]cond [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]ortholst pl[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
                 [b][color=MAROON]([/color][/b]T [b][color=GREEN]([/color][/b]ssadd en cs[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
    [b][color=FUCHSIA]([/color][/b]if cs [b][color=NAVY]([/color][/b]command [color=#2f4f4f]"_.CHPROP"[/color] cs [color=#2f4f4f]""[/color] [color=#2f4f4f]"_C"[/color] 1 [color=#2f4f4f]""[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

Again this would be for plines that are created with 3 maybe 4 decimal precision. -David

Link to comment
Share on other sites

David, thank you. This looks like a nice clean solution. I hope I can bother you for some additional troubleshooting. I took the most recent code you posted and pasted it into the Visual Lisp console, drew a number of orhto and non ortho closed polylines in the current drawing and ran the code. It turned all of the polylines red regardless of ortho or non-ortho status.

 

I changed the last stanza of code to (to no effect):

 

(if cs (command "_.CHPROP" cs "" "_C" 2 "")

(command "_.CHPROP" cs "" "_C" 1 "")

 

The next lines are experimental to see if I can embed the formatting etc. but I have added some questions ;in the form of commented out statements to see if I am understanding the steps

 

[b]([/b]defun ortholst [b][color=fuchsia]([/color][/b]pl / xvals yvals xeq yeq[color=fuchsia][b])[/b] [/color][u][color=black];defines the subroutine ortholst, defines variables pl and temporarily xvals yvals xeq and yeq[/color]
[/u]  [b][color=fuchsia]([/color][/b]setq xvals [b][color=navy]([/color][/b]mapcar 'car pl[b][color=navy]) [/color][/b];[u]sets the variable xvals as a real number extracted from the first entry of the list pl[/u]        yvals [b][color=navy]([/color][/b]mapcar 'cadr pl[b][color=navy]) [/color][/b][u]; sets the variable yvals as a real number extracted from the second entry of the list pl[/u]
       xeq [b][color=navy]([/color][/b]apply '= xvals[b][color=navy])[/color][/b]
       yeq [b][color=navy]([/color][/b]apply '= yvals[b][color=navy])[/color][/b][b][color=fuchsia]) [/color][/b][u]; tests xvals and yvals for any equivalency to the other ordered pairs, thus xeq and yeq become a T/F or 1/0 value?
[/u]  [color=fuchsia][b]([/color][/b]or xeq yeq[b][color=fuchsia])[/color][/b][b][color=black]) [/color][/b][u];if either the x or y coordinate is equal then true else false[/u]

[color=#8b4513];[b][color=black]([/color][/b]setq pl '[b][color=fuchsia]([/color][/b][b][color=navy]([/color][/b]0 1 0[b][color=navy])[/color][/b] [b][color=navy]([/color][/b]0. 4 0[b][color=navy])[/color][/b] [b][color=navy]([/color][/b]0. 6 0[b][color=navy])[/color][/b][b][color=fuchsia])[/color][/b][b][color=black])[/color][/b][/color]

[b][color=black]([/color][/b]and [b][color=fuchsia]([/color][/b]setq i -1  [u];and, returns true if all conditions are true, else false, what are all the 'and' comparisons, and we are still under the 'or' xeq yeq comparison for true condition aren't we?
[/u]          cs [b][color=navy]([/color][/b]ssadd[b][color=navy]) [/color][/b][u];not sure what cs is as a variable or first operator under the 'and' function[/u]
         ss [b][color=navy]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=maroon]([/color][/b][b][color=green]([/color][/b]0 . [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=green])[/color][/b][b][color=maroon])[/color][/b][b][color=navy])[/color][/b][b][color=fuchsia]) [/color][/b][u];also not sure what the ss argument does[/u]
    [b][color=fuchsia]([/color][/b]while [b][color=navy]([/color][/b]setq en [b][color=maroon]([/color][/b]ssname ss [b][color=green]([/color][/b]setq i [b][color=blue]([/color][/b]1+ i[b][color=blue])[/color][/b][b][color=green])[/color][/b][b][color=maroon])[/color][/b][b][color=navy]) [/color][/b][u];looping through coordinate pairs?[/u]
           [b][color=navy]([/color][/b]setq ed [b][color=maroon]([/color][/b]entget en[b][color=maroon])  [/color][/b]
                 pl [b][color=maroon]([/color][/b]massoc 10 ed[b][color=maroon])[/color][/b][b][color=navy]) [/color][/b][u];runs the subroutine massoc for each of the number 'ed' coordinate pairs?[/u]
           [b][color=navy]([/color][/b]cond [b][color=maroon]([/color][/b][b][color=green]([/color][/b]ortholst pl[b][color=green])[/color][/b][b][color=maroon]) [/color][/b][u];condition test of 'and' comparison?[/u]
                 [b][color=maroon]([/color][/b]T [b][color=green]([/color][/b]ssadd en cs[b][color=green])[/color][/b][b][color=maroon])[/color][/b][b][color=navy])[/color][/b][b][color=fuchsia]) [/color][/b][u];not sure what the effect of this code is, explanation would help me
[/u]     [b][color=fuchsia]([/color][/b]if cs [b][color=navy]([/color][/b]command [color=#2f4f4f]"_.CHPROP"[/color] cs [color=#2f4f4f]""[/color] [color=#2f4f4f]"_C"[/color] 1 [color=#2f4f4f]""[/color][b][color=navy])[/color][/b][b][color=fuchsia])[/color][/b][b][color=black]) [/color][/b][u];I understand the basics of an if argument, but I am guessing that the syntax "(if cs (command..." means that "cs" is a test comparison? such as (setq cs(= 1 0))[/u]
[u]

[/u]

I can't thank you enough. You are most gracious for taking this on.

Randy

Link to comment
Share on other sites

1st off, Kudos to you for your interest and obvious effort to understanding the code!

 

Some comments on your comments:

 

; [color="red"]I added a command line call c:orth-lwp in the updated version[/color]

(defun ortholst (pl / xvals yvals xeq yeq) ;defines the subroutine ortholst, 
     ; [color="red"]declares the aurgment pl[/color]
     ; d[color="red"]efines variables xvals yvals xeq and yeq as local to this function only[/color]
 
 (setq xvals (mapcar 'car pl) ; sets the variable xvals as a [color="red"]list of [/color]real numbers extracted from the first [color="red"]atom[/color] of the list pl 
         yvals (mapcar 'cadr pl) ; sets the variable yvals as a [color="red"]list of[/color] real numbers extracted from the second [color="red"]atom[/color] of the list pl
       xeq (apply '= xvals)
       yeq (apply '= yvals)) 
; tests xvals and yvals atoms for all equivalency, thus xeq and yeq [color="red"]are bound to T / nil[/color]
; [color="red"]here is where the problem may be   The = call returns T ONLY if all of the atom are exactly equal.  
; Point values are stored as REAL numbers and autocad uses 15 significant digits.
; If all of the the points are not exactly equal, then it will reurn nil  [/color]
 (or xeq yeq)) ;[color="red"]if either the x or y coordinates are equal then return T else nil[/color]
 
(and (setq i -1  ;and, [color="red"]evaluate all expressions until a nil return is encountered[/color]
; what are all the 'and' comparisons
[color="red"]; the color helps here. All of the magenta tests in the original ( blue in the updated ) post are evaluated
; the last call will return nil either way, but it dosen't matter as it is the last espression [/color]
, and we are still under the 'or' xeq yeq comparison for true condition aren't we? [color="red"]No[/color]
         cs (ssadd) ;[color="red"]create an empty PICKSET named cs ( ChangeSet )[/color]
         ss (ssget '((0 . "X" LWPOLYLINE")))) ; [color="red"]Create a PICKSET named ss of all LWPOLYLINEs in the drawing [/color]
    (while (setq en (ssname ss (setq i (1+ i)))) ;looping through a PICKESET
           (setq ed (entget en)  ; [color="red"]Get the entity definition[/color]
                 pl (massoc 10 ed)) ; [color="red"]extract all group 10 point values from the entity definition[/color]
           (cond ((ortholst pl)) ; [color="red"]Conditional test : If the subroutine othro_test returns T, Then do nothing [/color]
                 (T (ssadd en cs)))) ; [color="red"]Elseif, then add the entity to the change set cs[/color]
    (if cs (command "_.CHPROP" cs "" "_C" 1 ""))) ; [color="red"]if the changes set is bound to a value, then issue the CHPROP command[/color]
 ; [color="red"]I changed this test to test if the length of  set is greater than 0 for clarity[/color]

 

The updated routine:

 

 

[b][color=BLACK]([/color][/b]defun c:orth-lwp [b][color=FUCHSIA]([/color][/b]/ i cs ss en ed pl[b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]defun massoc [b][color=NAVY]([/color][/b]key alist / nlist[b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]foreach x alist
     [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]eq key [b][color=BLUE]([/color][/b]car x[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
         [b][color=GREEN]([/color][/b]setq nlist [b][color=BLUE]([/color][/b]cons [b][color=RED]([/color][/b]cdr x[b][color=RED])[/color][/b] nlist[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]reverse nlist[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]defun ortholst [b][color=NAVY]([/color][/b]pl / xvals yvals xeq yeq[b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]setq xvals [b][color=MAROON]([/color][/b]mapcar 'car pl[b][color=MAROON])[/color][/b]
         yvals [b][color=MAROON]([/color][/b]mapcar 'cadr pl[b][color=MAROON])[/color][/b]
         xeq [b][color=MAROON]([/color][/b]apply '= xvals[b][color=MAROON])[/color][/b]
         yeq [b][color=MAROON]([/color][/b]apply '= yvals[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]or xeq yeq[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq i -1
           cs [b][color=MAROON]([/color][/b]ssadd[b][color=MAROON])[/color][/b]
           ss [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss [b][color=BLUE]([/color][/b]setq i [b][color=RED]([/color][/b]1+ i[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                   pl [b][color=GREEN]([/color][/b]massoc 10 ed[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]cond [b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]ortholst pl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]T [b][color=BLUE]([/color][/b]ssadd en cs[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]> [b][color=GREEN]([/color][/b]sslength cs[b][color=GREEN])[/color][/b] 0[b][color=MAROON])[/color][/b]
          [b][color=MAROON]([/color][/b]command [color=#2f4f4f]"_.CHPROP"[/color] cs [color=#2f4f4f]""[/color] [color=#2f4f4f]"_C"[/color] 1 [color=#2f4f4f]""[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

My test bed dwg file attached.

 

I hope this helps. Feel free to come back to the trough anytime. -David

 

By the way, you are testing for a single vector pline, not a rectangular shape??? Major difference:shock:

 

PS PS It looks like you are proficient in a computer language, As a side note, in Autolisp, we don't have a FALSE. In most languages, FALSE is NOT TRUE. We have nil, which is an empty list.

All of these return T:

(equal nil '())
(eq nil '())
(= nil '())
(not nil)
(null nil)
(listp nil)

test.dwg

Edited by David Bethel
Link to comment
Share on other sites

Randy,

 

After rereading post #6, I'm now guessing that you are in fact trying to test for closed rectangular shapes.

 

To test for orthogonal closed LWPOLYLINEs:

 

[b][color=BLACK]([/color][/b]defun c:orth-lwr [b][color=FUCHSIA]([/color][/b]/ i cs ss en ed pl[b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]defun massoc [b][color=NAVY]([/color][/b]key alist / nlist[b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]foreach x alist
     [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]eq key [b][color=BLUE]([/color][/b]car x[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
         [b][color=GREEN]([/color][/b]setq nlist [b][color=BLUE]([/color][/b]cons [b][color=RED]([/color][/b]cdr x[b][color=RED])[/color][/b] nlist[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]reverse nlist[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]defun orthorct [b][color=NAVY]([/color][/b]pl / tmp tst[b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]setq tmp [b][color=MAROON]([/color][/b]cons [b][color=GREEN]([/color][/b]last pl[b][color=GREEN])[/color][/b] pl[b][color=MAROON])[/color][/b]
         tst T[b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]repeat [b][color=MAROON]([/color][/b]length pl[b][color=MAROON])[/color][/b]
           [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]not
                [b][color=BLUE]([/color][/b]equal
                 [b][color=RED]([/color][/b]rem
                  [b][color=PURPLE]([/color][/b]angle [b][color=TEAL]([/color][/b]car tmp[b][color=TEAL])[/color][/b] [b][color=TEAL]([/color][/b]cadr tmp[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
                  [b][color=PURPLE]([/color][/b]* pi 0.5[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] 0 1e-8[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
               [b][color=GREEN]([/color][/b]setq tst nil[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
           [b][color=MAROON]([/color][/b]setq tmp [b][color=GREEN]([/color][/b]cdr tmp[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   tst[b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq i -1
           cs [b][color=MAROON]([/color][/b]ssadd[b][color=MAROON])[/color][/b]
           ss [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]-4 . [color=#2f4f4f]"<="[/color][b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]70 . 1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss [b][color=BLUE]([/color][/b]setq i [b][color=RED]([/color][/b]1+ i[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                   pl [b][color=GREEN]([/color][/b]massoc 10 ed[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]cond [b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]orthorct pl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]T [b][color=BLUE]([/color][/b]ssadd en cs[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]> [b][color=GREEN]([/color][/b]sslength cs[b][color=GREEN])[/color][/b] 0[b][color=MAROON])[/color][/b]
          [b][color=MAROON]([/color][/b]command [color=#2f4f4f]"_.CHPROP"[/color] cs [color=#2f4f4f]""[/color] [color=#2f4f4f]"_C"[/color] 1 [color=#2f4f4f]""[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

The shape may have a unlimited number of vertices as long as the angle formed by adjacent line segments is a multiple of 90 degrees. Have fun! -David

TESTR.dwg

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