Topic: Code contest

[Mark]

TGIF everyone.........

Everybody ready for a little coding contest today?

The instructions are contained in this -> http://www.theswamp.org/swamp.files/mark/2000-test-52104.dwg <- dwg.

Alright lets see how good you are! Bonus points for creativity.

[Mark]

Here's my weak attempt.

Code: [Select]


;;; returns the entity type
(defun ent-type (ent)
  (if (= (type ent) 'ENAME)
    (cdr (assoc 0 (entget ent)))
    )
  )

(defun near-pt (pt_lst / pt)
  (if (= (type pt_lst) 'LIST)
    (progn
      (setq d1 (distance (car pt_lst)(last pt_lst))
            d2 (distance (cadr pt_lst)(last pt_lst))
            )
      (cond ((<= d1 d2)(setq pt "p1"))
            ((>= d1 d2)(setq pt "p2"))
            ((= d1 d2)(setq pt "p1"))
            )
      ); progn
    ); if
  pt
  )

; Degree to Radian conversion
(defun dtr (x)
  (/ (* x pi) 180.0)
  )

; Radian to Degree conversion
(defun rtd (x)
  (/ (* x 180.0) pi)
  )

(defun c:contest (/ ent_s sel_pt osm ent p1 p2 pt_lst near_pt
                    dir dst start_pt ang end_pt)

  (if (setq ent_s (entsel "\nSelect line: "))
    (if (= (ent-type (car ent_s)) "LINE")
      (setq sel_pt (cadr ent_s))
      ; else
      (progn (alert "Selection MUST be a LINE")(exit))
      )
    (exit)
    )

  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)

  (setq ent (car ent_s)
        p1 (cdr (assoc 10 (entget ent)))
        p2 (cdr (assoc 11 (entget ent)))
        pt_lst (list p1 p2 sel_pt)
        near_pt (near-pt pt_lst)
        )

  (cond ((= near_pt "p1")
         (setq dir (angle p1 p2)
               dst (* (distance p1 p2) 0.85)
               start_pt (polar p1 dir dst)
               )
         )
        ((= near_pt "p2")
         (setq dir (angle p2 p1)
               dst (* (distance p2 p1) 0.85)
               start_pt (polar p2 dir dst)
               )
         )
        )

  (setq ang (dtr (+ (rtd dir) 90))
        end_pt (polar start_pt ang (/ dst 2))
        )

  (command "_.line" start_pt end_pt "")

  (setvar 'osmode osm)
  (princ)
  )


[David Bethel]

Code: [Select]


(defun linep (p1 p2 d / p3 p4)
  (setq p3 (polar p1 (angle p1 p2) (* (distance p1 p2) d))
        p4 (polar p3 (+ (angle p1 p2) (/ pi 2)) (* (distance p1 p2) (* d 0.5))))
  (list p3 p4))

(defun c:swamp (/ en es ed sp p1 p2)

  (while (or (not en)
             (/= "LINE" (cdr (assoc 0 (entget en)))))
         (setq es (entsel)
               en (car es)
               ed (entget en)
               sp (cadr es)))

  (setq p1 (cdr (assoc 10 ed))
        p2 (cdr (assoc 11 ed)))

  (command "_.LINE")
  (foreach p  (if (>= (distance sp p1)
                      (distance sp p2))
                  (linep p1 p2 0.85)
                  (linep p2 p1 0.85))
       (command p))
  (command "")

(princ))


-David

[Keith™]

Ok, I feel compelled to add a short bit of code to do the same....it is relatively plain so I doubt I will get any extra credit....

Code: [Select]


(defun C:85Line( / linelist point1 point2 point3 point4 ang1 len)
  (setq linelist (entget (car (entsel "\Select line: ")))
        point1 (cdr(assoc 10 linelist))
point2 (cdr(assoc 11 linelist))
point3 (polar point1 (setq ang1 (angle point1 point2))(setq len (* (distance point1 point2) 0.85)))
point4 (polar point3 (+ ang1 (angtof "90")) (/ len 2))
  )
  (entmake
    (list
      (cons 0 "LINE")
      (cons 10 point3)
      (cons 11 point4)
    )
  )
)


[SMadsen]

Version with some vlax-curve functions:

Code: [Select]

(defun C:contest (/ obj pt1 pt2 dl)
  (vl-load-com)
  (cond ((setq obj (car (entsel)))
         (setq obj (vlax-ename->vla-object obj)
               pt1 (vlax-curve-getStartPoint obj)
               pt2 (vlax-curve-getpointatparam obj
                      (setq dl (* (vlax-curve-getEndParam obj) 0.85)))
        )
        (entmake (list '(0 . "LINE") (cons 10 pt2)
                   (cons 11 (polar pt2 (+ (angle pt1 pt2)(/ pi 2.0))(/ dl 2.0)))))
    )
  )
)

[JohnK]

What dahell are your doing Mark??? (Get back to Cpp!!?)

[Mark]

What dahell are your doing Mark??? (Get back to Cpp!!?)

Sorry.......... had a weak moment there. Besides, I'm waiting on YOU to catch up.

nice examples there guys.

[CAB]

Well it hard to compete with the big guns,
Mark, you should have held them off so us little guys could have a chance.

I did tweak keith's code to follow the rules exactly though.

I can't tweak Stigs code. But It breaks the same rule.

Code: [Select]

(defun C:85Line (/ linelist ptpk p1 p2 p3 p4 ang len)
  (setq ptpk     (entsel "\Select line: ")
        linelist (entget (car ptpk))
        ptpk     (cadr ptpk)
        p1       (cdr (assoc 10 linelist))
        p2       (cdr (assoc 11 linelist))  )
  (if (> (distance p1 ptpk) (distance p2 ptpk))
    (setq ptpk p1
          p1  p2
          p2  ptpk  ) )
  (setq p3 (polar p1
                  (setq ang (angle p1 p2))
                  (setq len (* (distance p1 p2) 0.85))  )
        p4 (polar p3 (+ ang (angtof "90")) (/ len 2))  )
  (entmake
    (list      (cons 0 "LINE") (cons 10 p3) (cons 11 p4) )  )
)

[Mark]

so us little guys could have a chance.

"little guy" Yea, sure you are..........


message to Stig

I use NO VL stuff and you use ALL VL stuff, this isn't like us Stig, whats up with that!!  

[Keith™]

I did tweak keith's code to follow the rules exactly though.

I didn't quite understand the rules...

I thought the rules were that it had to do the job... I guess I should have taken it to mean that the pseudo code was all inclusive.

Oh well....

[Noah]

Here's my version:

   

Code: [Select]



(defun C:CL ()
  (if (and (setq e (entsel "\nPick Line: "))
           (setq ed (entget (car e)))
           (= "LINE" (cdr (assoc 0 ed)))
      )
    (progn
      (setq pt (cadr e)
            pt1 (cdr (assoc 10 ed))
            pt2 (cdr (assoc 11 ed))
            dst (* 0.85 (distance pt1 pt2))
      )
      (if (<= (distance pt pt1) (distance pt pt2))
        (setq ang (angle pt1 pt2)
              spt (polar pt1 ang dst)
        )
        (setq ang (angle pt2 pt1)
              spt (polar pt2 ang dst)
        )
      )
      (setq ept (polar spt (+ ang (* pi 0.5)) (* dst 0.5)))
      (command "_.line" spt ept "")            
    )
    (C:CL)
  )
  (princ)
)  

     

[CAB]

Well this is what I picked up..

Calculate the distance from the nearest end point to the point of selection

I just assumed it was a rule.  
It does the job quite well though.


Good job Noah, and error checking too.

[Mark]

What I was looking for, was for the line to be drawn at the furthest point from the selected point. Does that make sense!

[Mark]

-Noah

Nice touch.

Code: [Select]


 )
    (C:CL)
  )
  (princ)
)


[CAB]

What I was looking for, was for the line to be drawn at the furthest point
from the selected point. Does that make sense!

Yes, that was the alteration I made to Keith's code.
He wrote it so fast he must have blew by that little Easter egg.

[Keith™]

What easter egg? what did I miss? which way did he go?

[SMadsen]

Guess I missed that rule ...