[编程交流] 帮我完成Lisp程序。。。恳求

(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)
)

(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))))

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

([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])

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

;; _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
   )
)