[编程交流] 为什么只能选择圆直径

(defun c:tt (/ ss dcl fn id klst)
 (defun _make (e / r pcen dis lst str xk mr cel p1 p2 p3 p4 cir ln1 ln2)
   (setq lst '((2.5 "M3" 0.06 1.5)
               (3.3 "M4" 0.08 1.5)
               (4.2 "M5" 0.1 2.5)
               (5.0 "M6" 0.12 3.0)
               (6.8 "M8" 0.16 4.0)
               (8.5 "M10" 0.2 5.0)
               (10.5 "M12" 0.24 6.0)
               (12.0 "M14" 0.28 7.0)
               (14.0 "M16" 0.32 8.0)
               (15.5 "M18" 0.36 9.0)
               (17.5 "M20" 0.4 10.0)
              )
   )
   (setq r    (vlax-get e 'radius)
         pcen (vlax-get e 'center)
   )
   (mapcar 'set '(str xk mr) (cdr (assoc r lst)))
   (setq cel (if (eq (setq lt (vlax-get e "linetype"))
                     "ByLayer"
                 )
               (vlax-get
                 (vla-item (fy:aclayers) (vlax-get e "layer"))
                 "linetype"
               )
               lt
             )
   )
   (setq dis (* r 1.1)
         p1  (polar pcen 0. dis)
         p2  (polar pcen _pi2 dis)
         p3  (polar pcen pi dis)
         p4  (polar pcen (- _pi2) dis)
   )
   (if        (member "isBlock" slst)
     (setq space (vla-add (fy:acblocks) (vlax-3d-point pcen) "*U"))
     (setq space (fy:acms))
   )
   (setq cir (vlax-invoke space 'addcircle pcen r)
         arc (vlax-invoke space 'addarc pcen mr 4.71239 3.14159)
         ln1 (vlax-invoke space 'addline p1 p3)
         ln2 (vlax-invoke space 'addline p2 p4)
   )
   (mapcar '(lambda (x)
              (vlax-put (car x) 'layer "screw")
              (vlax-put (car x) 'color (cadr x))
              (vlax-put (car x) "linetype" (caddr x))
              (vlax-put (car x) "linetypescale" xk)
            )
           (list (list cir 33 cel)
                 (list arc 3 cel)
                 (list ln1 1 "center")
                 (list ln2 1 "center")
           )
   )
   (if        (member "isText" slst)
     (progn
       (setq txt (vlax-invoke space 'AddText str pcen (* mr 0.4)))
       (vla-put-alignment txt acAlignmentTopCenter)
       (vla-put-textalignmentpoint
         txt
         (vlax-3d-point (polar pcen (- _pi2) (* mr 0.17)))
       )
     )
   )
   (if        (member "isBlock" slst)
     (vlax-invoke
       (fy:acspace)
       'insertblock
       pcen
       (vla-get-name space)
       1.
       1.
       1.
       0.
     )
   )
 )
 (if (not slst)
   (setq slst '("isErased" "isText" "isBlock"))
 )
 (setq        dcl  '("screw:dialog{"
              "label = "Parameter settings";"
              " :toggle{ key = "isErased"; label = "Delete original circle";}"
              " :toggle { key = "isText"; label = "Generate text";}"
              " :toggle { key = "isBlock"; label = "Generate block";}"
              " ok_cancel;"
              "}"
             )
       klst '("isErased" "isText" "isBlock")
       fn   (xd::dcl:make dcl)
       id   (xd::dcl:load fn "screw")
 )
 (xd::Dcl:toggleaction
   klst 
   'slst 
   nil
 ) 
 (fy:begin)
 (if (and (= (xd::dcl:start id fn)
             1
          )
          (setq ss (ssget '((0 . "circle")
                            (-4 . "<or")
                            (40 . 2.5)
                            (40 . 3.3)
                            (40 . 4.2)
                            (40 . 5.0)
                            (40 . 6.
                            (40 . 8.5)
                            (40 . 10.5)
                            (40 . 12.0)
                            (40 . 14.0)
                            (40 . 15.5)
                            (40 . 17.5)
                            (-4 . "or>")
                           )
                   )
          )
     )
   (progn
     (if (not (tblsearch "style" "txt"))
       (command ".style"    "txt"         "txt.shx,gbcbig.shx"
                0.0             1.0         0.0             "n"
                "n"             "n"
               )
     )
     (if (not (tblsearch "ltype" "hidden"))
       (vla-load (fy:acltypes) "hidden" "acadiso.lin")
     )
     (if (not (tblsearch "ltype" "center"))
       (vla-load (fy:acltypes) "center" "acadiso.lin")
     )
     (if (not (tblsearch "layer" "screw"))
       (vla-add (fy:aclayers) "screw")
     )
     (mapcar '(lambda (x) (_make x)) (fy:cset->objs))
     (if (member "isErased" slst)
       (command ".erase" ss "")
     )
   )
 )
 (princ)
)

(ssget
 (append '((0 . "circle") (-4 . "<or"))
         (mapcar '(lambda (v) (cons 40 (/ v 2.)))
                 '(2.5 3.3 4.2 5.0 6.8 8.5 10.5 12.0 14.0 15.5 17.5)
         )
         '((-4 . "or>"))
 )
)

[b][color=BLACK]([/color][/b]setq ss [b][color=FUCHSIA]([/color][/b]ssget [b][color=NAVY]([/color][/b]list [b][color=MAROON]([/color][/b]cons 0 [color=#2f4f4f]"CIRCLE"[/color][b][color=MAROON])[/color][/b]
                     [b][color=MAROON]([/color][/b]cons -4 [color=#2f4f4f]"<OR"[/color][b][color=MAROON])[/color][/b]
                        [b][color=MAROON]([/color][/b]cons 40 1.25[b][color=MAROON])[/color][/b]
                        [b][color=MAROON]([/color][/b]cons 40 1.65[b][color=MAROON])[/color][/b]
                        [b][color=MAROON]([/color][/b]cons 40 2.10[b][color=MAROON])[/color][/b]
                     [b][color=MAROON]([/color][/b]cons -4 [color=#2f4f4f]"OR>"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

(setq rad (vla-get-radius (vlax-ename->vla-object (car (entsel)))))

 (defun _make (e / r pcen dis lst str xk mr cel p1 p2 p3 p4 cir ln1 ln2)
   (setq lst '((1.25 "M3" 0.06 1.5)
               (1.65 "M4" 0.08 1.5)
               (2.10 "M5" 0.1 2.5)
               (2.50 "M6" 0.12 3.0)
               (3.40 "M8" 0.16 4.0)
               (4.25 "M10" 0.2 5.0)
               (5.25 "M12" 0.24 6.0)
               (6.00 "M14" 0.28 7.0)
               (7.00 "M16" 0.32 8.0)
               (7.75 "M18" 0.36 9.0)
               (8.75 "M20" 0.4 10.0)
              )
   )

 (defun _make (e / r pcen dis lst str xk mr cel p1 p2 p3 p4 cir ln1 ln2)
   (setq lst '((2.5 "M3" 0.06 1.5)
               (3.3 "M4" 0.08 1.5)
               (4.2 "M5" 0.1 2.5)
               (5.0 "M6" 0.12 3.0)
               (6.8 "M8" 0.16 4.0)
               (8.5 "M10" 0.2 5.0)
               (10.5 "M12" 0.24 6.0)
               (12.0 "M14" 0.28 7.0)
               (14.0 "M16" 0.32 8.0)
               (15.5 "M18" 0.36 9.0)
               (17.5 "M20" 0.4 10.0)
              )
   )

   (setq lst '((1.25 "M3" 0.06 1.5)
               (1.65 "M4" 0.08 1.5)
               (2.10 "M5" 0.1 2.5)
               (2.50 "M6" 0.12 3.0)
               (3.40 "M8" 0.16 4.0)
               (4.25 "M10" 0.2 5.0)
               (5.25 "M12" 0.24 6.0)
               (6.00 "M14" 0.28 7.0)
               (7.00 "M16" 0.32 8.0)
               (7.75 "M18" 0.36 9.0)
               (8.75 "M20" 0.4 10.0)
              )
   )