Help me finish my lisp...Please

Hello guys,

I'm having trouble with my while statement and hoping you can help me out. I want to draw a line from the block perpendicular to the nearest line. I want to achieve this by window selection.

(defun C:QQ ()(load "C:\\Lisp\\driveway.lsp"))
(vl-load-com)
(defun _line ( a b c) (entmakex (list (cons 0 "LINE") (cons 10 a) (cons 11 b) (cons 8 c))))


(defun C:AA (/)

(setq ss (ssget ":L" '((0 . "INSERT,LINE") (8 . "CHOUSE,CROAD"))))

(setq ssb (ssadd));;blocks-selection set;;
(setq ssl (ssadd));;line-selection set;; 


(setq ct 0)  
(while (< ct (sslength ss))
(setq en (ssname ss ct))
(if (= "INSERT" (cdr (assoc 0 (entget en)))) (ssadd en ssb))
(setq ct (+ ct 1))
)


(setq ct 0)  
(while (< ct (sslength ss))
(setq en (ssname ss ct))
(if (= "LINE" (cdr (assoc 0 (entget en)))) (ssadd en ssl))
(setq ct (+ ct 1))
)


(setq ctb 0)
(setq ctl 0)

(while (< ctb (sslength ssb))[color="red"]from this part, it's driving me insane[/color]
(setq ed (ssname ssb ctb))
(setq cd (cdr(assoc 10 (entget ed))))
(setq d1 '(0 0))
  
   (while (< ctl (sslength ssl))
       (setq el (ssname ssl ctl))
(setq vla-el (vlax-ename->vla-object el))
(setq d (vlax-curve-getClosestPointToProjection vla-el cd '(0 0 0)))
(if (< (distance cd d) (distance d1 cd)) (setq d1 d))
(setq ctl (+ ctl 1))
)

(_line cd d1 "CDRIVEWAY")
(setq ctb (+ ctb 1))[color="red"]I'm really insane right here[/color]

)
(princ)
)

Thanks!

I think your brackets are not right I put ) ; end if ) ; end while so i can see where the group of lines end makes it easier to find missing bracket.

Add ) ; end defun and check

I have modified the code a little bit and still not doing as I intended. Now it just creates perpendicular lines from the block to only 1 line. There is something wrong with my statement "on red" which I can't figure out. Thank you for your time Bigal, really appreciate it.

(defun C:test (/ dl ss  ct en ssl ssb ctl ctb cd ed d el vla-el p)

(setq ss (ssget ":L" '((0 . "INSERT,LINE") (8 . "CHOUSE,CROAD"))))

(setq ssb (ssadd)[color="green"];;blocks-selection set;;[/color]
     ssl (ssadd))[color="green"];;line-selection set;; [/color]


(setq ct 0)  [color="green"];;;begin ssadd ssb;;;[/color]
(while (< ct (sslength ss))
(setq en (ssname ss ct))
(if (= (cdr (assoc 0 (entget en))) "INSERT") (ssadd en ssb))
(setq ct (+ ct 1))
)[color="green"] ;;;;end ssadd ssb;;;[/color]

(setq ct 0)  [color="green"];;;begin ssadd ssl;;;;;;;;;[/color]
(while (< ct (sslength ss))
(setq en (ssname ss ct))
(if (= (cdr (assoc 0 (entget en))) "LINE") (ssadd en ssl))
(setq ct (+ ct 1)) [color="green"] ;;;end ssadd ssl;;;;;;;;;[/color]
)


(setq ctb 0)[color="green"];;;counter for blocks[/color]
(setq ctl 0)[color="green"];;;counter for lines[/color]

[color="red"](while (< ctb (sslength ssb))[/color] [color="green"];;;begin while blocks [/color]
[color="red"](setq ed (ssname ssb ctb)
     cd (cdr(assoc 10 (entget ed)))
     d1 '(0 0))[/color]
 [color="red"] (while (< ctl (sslength ssl))[/color] [color="#2e8b57"][color="green"];;; iterate ssl for the nearest line for ssname (ed);;;[/color][/color]
[color="red"](setq el (ssname ssl ctl)
      vla-el (vlax-ename->vla-object el)
      d (vlax-curve-getClosestPointToProjection vla-el cd '(0 0 0)))
(if (< (distance cd d) (distance cd d1)) (setq p vla-el d1 d))[/color][color="green"];;;store the nearest line and loop[/color]
                                                              [color="green"];;;store nearest distance for compare;;;[/color]
(setq ctl (+ ctl 1))
) [color="green"];;;end while looking for nearest line for block ed;;;[/color]

(setq ctb (+ ctb 1))
(_line cd (vlax-curve-getClosestPointToProjection p cd '(0 0 0))) [color="green"];;; draw a line from the block;;;;[/color]
                                                               [color="green"] ;;; to the nearest line;;;
);;;end while blocks[/color]

(princ)
)[color="green"];;;end defun[/color]
(vl-load-com)
(defun _line ( a b ) (entmakex (list (cons 0 "LINE") (cons 10 a) (cons 11 b))))

Vla-el is this a new VL function ?

Vla-el is this a new VL function ?

no, I'm just using vla preffix to know it's a vl object in a variable. One of my nasty habit.

Thank you Bigal, don't bother I've already finish the routine.

Vla-el is this a new VL function ?

I guess it is a variable name ...

(setq el (ssname ssl ctl)
      [b][color="blue"]vla-el[/color][/b] (vlax-ename->vla-object el)
)

This is how I might approach the task, hopefully you can learn from my code LISP2LEARN

([color=BLUE]defun[/color] c:blkline ( [color=BLUE]/[/color] d1 d2 el en in l1 l2 p2 p3 ss )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] ss ([color=BLUE]ssget[/color] '((0 . [color=MAROON]"INSERT,LINE"[/color]))))
       ([color=BLUE]progn[/color]
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] in ([color=BLUE]sslength[/color] ss))
               ([color=BLUE]setq[/color] en ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] in ([color=BLUE]1-[/color] in)))
                     el ([color=BLUE]entget[/color] en)
               )
               ([color=BLUE]if[/color] ([color=BLUE]eq[/color] [color=MAROON]"LINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 el)))
                   ([color=BLUE]setq[/color] l1 ([color=BLUE]cons[/color] en l1))
                   ([color=BLUE]setq[/color] l2 ([color=BLUE]cons[/color] ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 el)) en 0) l2))
               )
           )
           ([color=BLUE]foreach[/color] p1 l2
               ([color=BLUE]setq[/color] p2 ([color=BLUE]vlax-curve-getclosestpointto[/color] ([color=BLUE]car[/color] l1) p1)
                     d1 ([color=BLUE]distance[/color] p1 p2)
               )
               ([color=BLUE]foreach[/color] en ([color=BLUE]cdr[/color] l1)
                   ([color=BLUE]setq[/color] p3 ([color=BLUE]vlax-curve-getclosestpointto[/color] en p1)
                         d2 ([color=BLUE]distance[/color] p1 p3)
                   )
                   ([color=BLUE]if[/color] ([color=BLUE]<[/color] d2 d1) ([color=BLUE]setq[/color] d1 d2 p2 p3))
               )
               ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 p1) ([color=BLUE]cons[/color] 11 p2)))
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

This is how I might approach the task, hopefully you can learn from my code LISP2LEARN

 

([color=BLUE]defun[/color] c:blkline ( [color=BLUE]/[/color] d1 d2 el en in l1 l2 p2 p3 ss )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] ss ([color=BLUE]ssget[/color] '((0 . [color=MAROON]"INSERT,LINE"[/color]))))
       ([color=BLUE]progn[/color]
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] in ([color=BLUE]sslength[/color] ss))
               ([color=BLUE]setq[/color] en ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] in ([color=BLUE]1-[/color] in)))
                     el ([color=BLUE]entget[/color] en)
               )
               ([color=BLUE]if[/color] ([color=BLUE]eq[/color] [color=MAROON]"LINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 el)))
                   ([color=BLUE]setq[/color] l1 ([color=BLUE]cons[/color] en l1))
                   ([color=BLUE]setq[/color] l2 ([color=BLUE]cons[/color] ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 el)) en 0) l2))
               )
           )
           ([color=BLUE]foreach[/color] p1 l2
               ([color=BLUE]setq[/color] p2 ([color=BLUE]vlax-curve-getclosestpointto[/color] ([color=BLUE]car[/color] l1) p1)
                     d1 ([color=BLUE]distance[/color] p1 p2)
               )
               ([color=BLUE]foreach[/color] en ([color=BLUE]cdr[/color] l1)
                   ([color=BLUE]setq[/color] p3 ([color=BLUE]vlax-curve-getclosestpointto[/color] en p1)
                         d2 ([color=BLUE]distance[/color] p1 p3)
                   )
                   ([color=BLUE]if[/color] ([color=BLUE]<[/color] d2 d1) ([color=BLUE]setq[/color] d1 d2 p2 p3))
               )
               ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 p1) ([color=BLUE]cons[/color] 11 p2)))
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Very elegant Lee as always. Much appreciated. Thank you.

Last thing. How can I replace the text "Select objects:" from ssget when selecting. Just like below with entsel:

(entsel) -->> [color="red"]"Select object:"[/color]
(entsel "\nSelect a block:") -->> [color="red"]"Select a block:"[/color]

Very elegant Lee as always. Much appreciated. Thank you.

You're welcome.

Last thing. How can I replace the text "Select objects:" from ssget when selecting. Just like below with entsel:

 

(entsel) -->> [color=red]"Select object:"[/color]
(entsel "\nSelect a block:") -->> [color=red]"Select a block:"[/color]

The ssget function doesn't allow for a custom prompt message as permitted by other user input functions; however, you can construct an ssget wrapper to cheat a little:

;; _ssget  -  Lee Mac
;; ssget wrapper function to allow a custom prompt message
;; msg  = prompt
;; args = list of standard ssget parameters
;; Returns: Selection Set or nil

(defun _ssget ( msg args / sel )
   (princ msg)
   (setvar 'NOMUTT 1)
   (setq sel (vl-catch-all-apply 'ssget args))
   (setvar 'NOMUTT 0)
   (if (and sel (null (vl-catch-all-error-p sel)))
       sel
   )
)

e.g.:

(_ssget "\nSelect Blocks & Lines: " '(((0 . "INSERT,LINE"))))

Thanks Lee, works perfectly.

You're welcome LISP2LEARN

Just a obscure question "Driveway.lsp" in 1st post are you trying to drive a car along a profile I have this.

Just a obscure question "Driveway.lsp" in 1st post are you trying to drive a car along a profile I have this.

No. It's just a part of a sub function for my routine which I been working on for the past 2 months. Hopefully this will cut of my drafting time to 10 folds.