[LISP程序]：批量修改圆环(Donut)宽度,内外直径的小工具:

lsjjm

批量修改圆环(Donut)宽度,内外直径的小工具:
(defun c:test ( / ed0 id0 ed id w w0 old ec)
  (vl-load-com)
  (princ "\nSelect DONUTs:")
  (setq ents (ssget) n 0)
  (setq ds (getstring "[Diameter/Wall] <D>:"))
  (if (or (null ds)(= ds ""))(setq ds "D"))
  (initget 6)
  (cond
    ((= (strcase ds) "W")
     (setq w (getreal "\nInput Wall:"))
     (while (< n (sslength ents))
       (setq ent (vlax-ename->vla-object (ssname ents n)))
       (vlax-put-property ent 'constantwidth w)
       (setq n (1+ n))))
    ((= (strcase ds) "D")
      (setq ed (getreal "\nInput External Diameter:"))
      (setq id (getreal "\nInput Internal Diameter:"))
      (while (< n (sslength ents))
        (setq ent (vlax-ename->vla-object (ssname ents n)))
        (setq  w0 (vlax-get-property ent 'constantwidth))
        (setq old (vlax-safearray->list
                         (vlax-variant-value
                      (vlax-get-property ent 'coordinates))))
        (setq id0 (- (caddr old)(car old) w0))
        (setq ed0 (+ id0 w0 w0))
        (setq w (/ (- ed id) 2.0))
        (setq ec (+ (car old)(/ (+ ed0 id0) 4.0)))
        (setq old (subst (- ec (/ (+ ed id) 4.0))(car old) old))
        (setq old (subst (+ ec (/ (+ ed id) 4.0))(caddr old) old))
        (vlax-put-property ent 'coordinates
          (vlax-make-variant
            (vlax-safearray-fill
              (vlax-variant-value (vlax-get-property ent 'coordinates))
              old)))
        (vlax-put-property ent 'constantwidth (/ (- ed id) 2.0))
        (setq n (1+ n))))
  );c
  (princ)
);defun

dqq888

多谢高手，但这个程序怎么装上去用呢？我还未接触过呢

lsjjm

你可以在用户工具菜单文件中加上：
ID_dw   [Donutwidth]^C^C(load (findfile "your.lsp"));test
其中your.lsp是该程序所在lisp文件。

dqq888

看来我还是很菜，“用户工具菜单文件”在哪里呢？请别笑，我没找到。

hanks

很好用哟，谢了呀