How about this? I used the quadrant system rather than 1-16, so the user
enter 1-4 for the base quadrant the 1-4 for the sub quadrant. I also based
it on a closed LWPline defining the section boundary that consists of 4
points, it should probably be modified to allow a 5 vertex pline where the
5th vertex is identical to the starting vertex (the user manually closed the
pline).
Enjoy!
[code]
;| Command to draw the 1/4, 1/4 section of a known section. User enters
a number 1, 2, 3 or 4 for the NE, SE, SW, NW quadrant of both quarters.
For instance, user enters 1 & 3 and the southwest 1/4 of the northeast
1/4 of the section will be drawn.
Sparked by idea from Stan Bohnsack.
Authored by Jeff Mishler - April 23, 2005
|;
(defun c:qqsec (/ centerne centernw centerse centersect centersw coords
east-ang east-len eastcenter eastnorth eastsouth ne-sect
north-ang north-len northcenter northeast northwest nw-ne
nw-sect p1 p2 p3 p4 prmt qtr quad se-ne se-sect sect sect_data
south-ang south-len southcenter southeast southwest sw-nw sw-se
sw-sect west-ang west-len westcenter westnorth westsouth)
(and (setq sect (car (entsel)))
(setq sect_data (entget sect))
(eq (cdr (assoc 0 sect_data)) "LWPOLYLINE")
(= (cdr (assoc 90 sect_data)) 4)
(progn
(princ "\n Use NE=1, SE=2, SW=3, NW=4 for quadrant & section.....")
(initget 7 "1 2 3 4")
(setq quad (atoi (getkword "\nWhich quadrant? {1-4}: ")))
(initget 7 "1 2 3 4")
(setq qtr (atoi (getkword "\nWhich quarter? {1-4}: ")))
)
(setq coords (list (vlax-curve-getpointatparam sect 0)
(vlax-curve-getpointatparam sect 1)
(vlax-curve-getpointatparam sect 2)
(vlax-curve-getpointatparam sect 3)
))
(setq coords (vl-sort coords '(lambda (x y)
(< (car x) (car y)))))
(if (< (cadar coords)(cadr (car (cdr coords))))
(setq sw-sect (car coords)
nw-sect (car (cdr coords))
)
(setq nw-sect (car coords)
sw-sect (car (cdr coords))
)
)
(setq coords (vl-sort coords '(lambda (x y)
(> (car x) (car y)))))
(if (> (cadar coords)(cadr (car (cdr coords))))
(setq ne-sect (car coords)
se-sect (car (cdr coords))
)
(setq se-sect (car coords)
ne-sect (car (cdr coords))
)
)
(setq west-len (distance sw-sect nw-sect)
north-len (distance nw-sect ne-sect)
east-len (distance ne-sect se-sect)
south-len (distance se-sect sw-sect)
west-ang (angle sw-sect nw-sect)
north-ang (angle nw-sect ne-sect)
east-ang (angle se-sect ne-sect)
south-ang (angle sw-sect se-sect)
)
(setq westsouth (polar sw-sect west-ang (/ west-len 4))
westcenter (polar sw-sect west-ang (/ west-len 2))
westnorth (polar westcenter west-ang (/ west-len 4))
northwest (polar nw-sect north-ang (/ north-len 4))
northcenter (polar nw-sect north-ang (/ north-len 2))
northeast (polar northcenter north-ang (/ north-len 4))
southwest (polar sw-sect south-ang (/ south-len 4))
southcenter (polar sw-sect south-ang (/ south-len 2))
southeast (polar southcenter south-ang (/ south-len 4))
eastsouth (polar se-sect east-ang (/ east-len 4))
eastcenter (polar se-sect east-ang (/ east-len 2))
eastnorth (polar eastcenter east-ang (/ east-len 4))
centersect (inters westcenter eastcenter southcenter northcenter)
centerne (inters westnorth eastnorth southeast northeast)
centerse (inters westsouth eastsouth southeast northeast)
centersw (inters westsouth eastsouth southwest northwest)
centernw (inters westnorth eastnorth southwest northwest)
se-ne (inters westcenter eastcenter southeast northeast)
sw-se (inters westsouth eastsouth southcenter northcenter)
sw-nw (inters westcenter eastcenter southwest northwest)
nw-ne (inters westnorth eastnorth southcenter northcenter)
)
(cond ((= 1 quad)
(cond ((= 1 qtr)(setq p1 ne-sect
p2 eastnorth
p3 centerne
p4 northeast)
(setq prmt "\nNortheast 1/4 of Northeast 1/4 created....."))
((= 2 qtr) (setq p1 eastnorth
p2 eastcenter
p3 se-ne
p4 centerne)
(setq prmt "\nSoutheast 1/4 of Northeast 1/4 created....."))
((= 3 qtr) (setq p1 centerne
p2 se-ne
p3 centersect
p4 nw-ne)
(setq prmt "\nSouthwest 1/4 of Northeast 1/4 created....."))
(t (setq p1 northeast
p2 centerne
p3 nw-ne
p4 northcenter)
(setq prmt "\nNorthwest 1/4 of Northeast 1/4 created....."))
)
)
((= 2 quad)
(cond ((= 1 qtr)(setq p1 eastcenter
p2 eastsouth
p3 centerse
p4 se-ne)
(setq prmt "\nNortheast 1/4 of Southeast 1/4 created....."))
((= 2 qtr) (setq p1 eastsouth
p2 se-sect
p3 southeast
p4 centerse)
(setq prmt "\nSoutheast 1/4 of Southeast 1/4 created....."))
((= 3 qtr) (setq p1 centerse
p2 southeast
p3 southcenter
p4 sw-se)
(setq prmt "\nSouthwest 1/4 of Southeast 1/4 created....."))
(t (setq p1 se-ne
p2 centerse
p3 sw-se
p4 centersect)
(setq prmt "\nNorthwest 1/4 of Southeast 1/4 created....."))
)
)
((= 3 quad)
(cond ((= 1 qtr)(setq p1 centersect
p2 sw-se
p3 centersw
p4 sw-nw)
(setq prmt "\nNortheast 1/4 of Southwest 1/4 created....."))
((= 2 qtr) (setq p1 sw-se
p2 southcenter
p3 southwest
p4 centersw)
(setq prmt "\nSoutheast 1/4 of Southwest 1/4 created....."))
((= 3 qtr) (setq p1 centersw
p2 southwest
p3 sw-sect
p4 westsouth)
(setq prmt "\nSouthwest 1/4 of Southwest 1/4 created....."))
(t (setq p1 centersw
p2 westsouth
p3 westcenter
p4 sw-nw)
(setq prmt "\nNorthwest 1/4 of Southwest 1/4 created....."))
)
)
((= 4 quad)
(cond ((= 1 qtr)(setq p1 northcenter
p2 nw-ne
p3 centernw
p4 northwest)
(setq prmt "\nNortheast 1/4 of Northwest 1/4 created....."))
((= 2 qtr) (setq p1 nw-ne
p2 centersect
p3 sw-nw
p4 centernw)
(setq prmt "\nSoutheast 1/4 of Northwest 1/4 created....."))
((= 3 qtr) (setq p1 centernw
p2 sw-nw
p3 westcenter
p4 westnorth)
(setq prmt "\nSouthwest 1/4 of Northwest 1/4 created....."))
(t (setq p1 northwest
p2 centernw
p3 westnorth
p4 nw-sect)
(setq prmt "\nNorthwest 1/4 of Northwest 1/4 created....."))
)
)
)
(command "pline" p1 p2 p3 p4 "c")
)
(if prmt
(princ prmt)
)
(princ)
)
[/code]
--
Jeff
check out www.cadvault.com
"Stan Bohnsack" wrote in message
news:4823898@discussion.autodesk.com...
>I have a lisp routine that I am trying to write, and could use some
> input. This routine is designed to take a typical state section and
> subdivide it into quarter-quarter sections, based on 4 user selected
> points (4 corners of section). It will then draw a closed polygon around
> 1 of the 16 possible quarter-quarter sections that the user inputs.
> Below is what I have written so far. If someone could please help me
> finish it, it would be very appreciated.
>
>
> --
> Stan D. Bohnsack
> WWC Engineering
> 1849 Terra Ave
> Sheridan, Wy. 82801
> (307) 672-0761
>
>
>
>
> Watch for word wrap...
>
>
> engqtr.LSP SDB 5/05
>
> User picks the four corners of a typical land section, then
> the routine sub-divides the area and draws individual quarter-quarter
> sections depending on user input.
>
> (defun C:engqtr ( / asnp,osm,p1,p2,p3,p4)
> (setq asnp (getvar "autosnap"))
> (setq osm (getvar "osmode"))
> (setvar "osmode" 33)
> (setq p1 (getpoint "\nPick northwest corner of section:...")) (TERPRI)
> (setq p2 (getpoint "\nPick northeast corner of section:...")) (TERPRI)
> (setq p3 (getpoint "\nPick southwest corner of section:...")) (TERPRI)
> (setq p4 (getpoint "\nPick southeast corner of section:...")) (TERPRI)
> (setq NUM (getint "\nEnter numeric value of Q/Q section to be
> drawn:..(1-16)"))
> (setvar "autosnap" asnp)
> (setvar "osmode" 0)
> (setq
> p1x (car p1)
> p2x (car p2)
> p12x (/ (+ p2x p1x) 2)
> p1y (cadr p1)
> p2y (cadr p2)
> p12y (/ (+ p2y p1y) 2)
> q1 (list p12x p12y)
> p3x (car p3)
> p4x (car p4)
> p3y (cadr p3)
> p4y (cadr p4)
> p34x (/ (+ p4x p3x) 2)
> p34y (/ (+ p4y p3y) 2)
> q2 (list p34x p34y)
> p13x (/ (+ p3x p1x) 2)
> p13y (/ (+ p3y p1y) 2)
> q3 (list p13x p13y)
> p24x (/ (+ p4x p2x) 2)
> p24y (/ (+ p4y p2y) 2)
> q4 (list p24x p24y)
> qq1x (/ (+ q1x p1x) 2)
> qq1y (/ (+ q1y p1y) 2)
> qq1 (list qq1x qq1y)
> qq2x (/ (+ q2x p3x) 2)
> qq2y (/ (+ q2y p3y) 2)
> qq2 (list qq2x qq2y)
> qq3x (/ (+ p2x q1x) 2)
> qq3y (/ (+ p2y q1y) 2)
> qq3 (list qq3x qq3y)
> qq4x (/ (+ p4x q2x) 2)
> qq4y (/ (+ p4y q2y) 2)
> qq4 (list qq4x qq4y)
> qq5x (/ (+ q3x p1x) 2)
> qq5y (/ (+ q3y p1y) 2)
> qq5 (list qq5x qq5y)
> qq6x (/ (+ q4x p2x) 2)
> qq6y (/ (+ q4y p2y) 2)
> qq6 (list qq6x qq6y)
> qq7x (/ (+ p3x q3x) 2)
> qq7y (/ (+ p3y q3y) 2)
> qq7 (list qq7x qq7y)
> qq8x (/ (+ p4x q4x) 2)
> qq8y (/ (+ p4y q4y) 2)
> qq8 (list qq8x qq8y)
> cp1x (/ (+ q2x q1x) 2)
> cp1y (/ (+ q2y q1y) 2)
> cp1 (list cp1x cp1y)
> cp2x (/ (+ qq2x qq1x) 2)
> cp2y (/ (+ qq2y qq1y) 2)
> cp2 (list cp2x cp2y)
> cp3x (/ (+ qq4x qq3x) 2)
> cp3y (/ (+ qq4y qq3y) 2)
> cp3 (list cp3x cp3y)
> cp4x (/ (+ cp1x q1x) 2)
> cp4y (/ (+ cp1y q1y) 2)
> cp4 (list cp4x cp4y)
> cp5x (/ (+ cp2x qq1x) 2)
> cp5y (/ (+ cp2y qq1y) 2)
> cp5 (list cp5x cp5y)
> cp6x (/ (+ cp3x qq3x) 2)
> cp6y (/ (+ cp3y qq3y) 2)
> cp6 (list cp6x cp6y)
> cp7x (/ (+ q2x cp1x) 2)
> cp7y (/ (+ q2y cp1y) 2)
> cp7 (list cp7x cp7y)
> cp8x (/ (+ qq2x cp2x) 2)
> cp8y (/ (+ qq2y cp2y) 2)
> cp8 (list cp8x cp8y)
> cp9x (/ (+ qq4x cp3x) 2)
> cp9y (/ (+ qq4y cp3y) 2)
> cp9 (list cp9x cp9y)
> )
>
> (If (= NUM 1)
> (COMMAND "PLINE" p2 qq3 cp6 qq6 p2 "")
> )
> (If (= NUM 2)
> (command "PLINE" qq3 q1 cp4 cp6 qq3 "")
> )
> (If (= NUM 3)
> (command "PLINE" cp6 cp4 cp1 cp3 cp6 "")
> )
> (If (= NUM 4)
> (command "PLINE" qq6 cp6 cp3 q4 qq6 "")
> )
> (If (= NUM 5)
> (command "PLINE" q1 qq1 cp5 cp4 q1 "")
> )
> (If (= NUM 6)
> (command "PLINE" qq1 p1 qq5 cp5 qq1 "")
> )
> (If (= NUM 7)
> (command "PLINE" cp5 qq5 q3 cp2 cp5 "")
> )
> (If (= NUM 😎
> (command "PLINE" cp4 cp5 cp2 cp1 cp4 "")
> )
> (If (= NUM 9)
> (command "PLINE" cp1 cp2 cp8 cp7 cp1 "")
> )
> (If (= NUM 10)
> (command "PLINE" cp2 q3 qq7 cp8 cp2 "")
> )
> (If (= NUM 11)
> (command "PLINE" cp8 qq7 p3 qq2 cp8 "")
> )
> (If (= NUM 12)
> (command "PLINE" cp7 cp8 qq2 q2 cp7 "")
> )
> (If (= NUM 13)
> (command "PLINE" q4 cp3 cp9 qq8 q4 "")
> )
> (If (= NUM 14)
> (command "PLINE" cp3 cp1 cp7 cp9 cp3 "")
> )
> (If (= NUM 15)
> (command "PLINE" cp9 cp7 q2 qq4 cp9 "")
> )
> (If (= NUM 16)
> (command "PLINE" qq8 cp9 qq4 p4 qq8 "")
> )
> )
![Autodesk Design & Make Report](https://forums.autodesk.com/t5/image/serverpage/image-id/1350519iCB55845EBFC43016/image-size/large?v=v2&px=999" "Autodesk Design & Make Report")
