[编程交流] 从选定对象中画一个圆

 
(defun c:cxircle(/ PT1 PT2 s)
(setq s (ssget '((0 . "LINE"))))
PT1 (cdr (assoc 10 s))
PT2 (cdr (assoc 11 s))
   (command "LINE" PT1 PT2 "")            
   (command "CIRCLE" "2P" PT1 PT2)     
 )

(defun C:CADTUTOR ( / ss n ensel enlist )
(setq ss (ssget ":L" (list (cons 0 "Line"))))
(if ss
        (progn
                (setq n 0)
                (repeat (sslength ss)
                        (setq ensel (ssname ss n))
                        (setq enlist (entget ensel))
                        (command "CIRCLE" "2P" (cdr (assoc 10 enlist)) (cdr (assoc 11 enlist)))
                        (setq n (+ n 1))
                )
        )
        (progn
                (princ "No line(s) selected.")
        )
)
(princ)
)

(defun c:cxircle(/ PT1 PT2 s)
(setq s (ssget '((0 . "LINE"))))
PT1 (cdr (assoc 10 s))
PT2 (cdr (assoc 11 s))
   (command "LINE" PT1 PT2 "")            
   (command "CIRCLE" "2P" PT1 PT2)     
 )

[b][color=BLACK]([/color][/b]defun c:wlin2cir [b][color=FUCHSIA]([/color][/b]/ ss i en ed p10 p11 mp lt tk cl[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]princ [color=#2f4f4f]"\nSelect Lines To Convert To Circles..."[/color][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]cons 0 [color=#2f4f4f]"LINE"[/color][b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]list 210 0 0 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]setq i 0[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 i[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]
                    p10 [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 10 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                    p11 [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 11 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                     mp [b][color=GREEN]([/color][/b]mapcar '[b][color=BLUE]([/color][/b]lambda [b][color=RED]([/color][/b]a b[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]* [b][color=PURPLE]([/color][/b]+ a b[b][color=PURPLE])[/color][/b] 0.5[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] p10 p11[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
               [b][color=MAROON]([/color][/b]or [b][color=GREEN]([/color][/b]setq lt [b][color=BLUE]([/color][/b]assoc 6 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]setq lt [b][color=BLUE]([/color][/b]cons 6 [color=#2f4f4f]"BYLAYER"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
               [b][color=MAROON]([/color][/b]or [b][color=GREEN]([/color][/b]setq tk [b][color=BLUE]([/color][/b]assoc 39 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]setq tk [b][color=BLUE]([/color][/b]cons 39 0[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
               [b][color=MAROON]([/color][/b]or [b][color=GREEN]([/color][/b]setq cl [b][color=BLUE]([/color][/b]assoc 62 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]setq cl [b][color=BLUE]([/color][/b]cons 62 256[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
               [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]equal [b][color=BLUE]([/color][/b]caddr p10[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]caddr p11[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]entmake [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cons 0 [color=#2f4f4f]"CIRCLE"[/color][b][color=RED])[/color][/b]
                                  [b][color=RED]([/color][/b]assoc 8 ed[b][color=RED])[/color][/b]
                                  [b][color=RED]([/color][/b]cons 10 mp[b][color=RED])[/color][/b]
                                  [b][color=RED]([/color][/b]cons 40 [b][color=PURPLE]([/color][/b]distance p10 mp[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
                                  lt tk cl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]alert [color=#2f4f4f]"LINEs Found That Are Not Coplaner..."[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
               [b][color=MAROON]([/color][/b]setq i [b][color=GREEN]([/color][/b]1+ i[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]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

(defun c:l2c (/ sel int ent str end)
 (if (setq int -1 sel (ssget '((0 . "LINE"))))
   (while (setq ent (ssname sel (setq int (1+ int))))
     (setq str (cdr (assoc 10 (entget ent)))
           end (cdr (assoc 11 (entget ent)))
     )
     (entmake
       (list '(0 . "CIRCLE")
             (cons 10 (mapcar '(lambda (q p) (* (+ q p) 0.5)) str end))
             (cons 40 (/ (distance str end) 2.))
       )
     )
   )
 )
 (princ)
)