Lwcdgl 发表于 2022-5-12 16:02:40

如何修改才可以让这个程式运行得更快?

(defun c:obb ( / del en n pt1 ro ss)
(if(= w nil)(setq w 5))
(if(= d nil)(setq d 5))
(setq w1 w
        d1 d)
(setq w (getdist (strcat"\n长:"(rtos w)">>>>>")))
(setq d (getdist (strcat"\n宽:"(rtos d)">>>>>")))
(if
(= w nil)
   (setq w w1)
)
(if
(= d nil)
   (setq d d1)
)
(SETQ ro (getreal "\n旋转角度:"))
(initget "Y y N n")
(setq del(GETKWORD"\n是否删除圆Y/N:(Y)"))
(COND ((= del "y")(setq del(strcase del)))
        ((= del "n")(setq del(strcase del)))
        )

(setq n 0)
(setq ss (ssget '((0 . "CIRCLE"))))
(command "chprop"ss "" "c" 1 "")
(repeat (sslength ss)
    (setq en (ssname ss n))
    (setq en(entget en))
    (setq pt1 (cdr(assoc 10 en)))
    (sub-ob)
    (setq n(1+ n))
)
(cond ((= del nil) (command "erase"ss""))
        ((= del "Y") (command "erase"ss""))
        )
)


;;;======================================================
(defun sub-ob ()
(setvar "osmode" 4543)
(setvar "osmode" 0)
(setq pt2 (polar pt1 0 w))
(setq pt3 (polar pt2 (/ pi 2) d))
(setq pt4 (polar pt3 pi w))
(command "pline" pt1 pt2 "a" pt3 "l" pt4 "a" pt1 "")
(setq aa (entlast))
(setq pt (INTERs pt1 pt3 pt2 pt4))
(command "move" aa "" pt pt1 "")
(if (> ro 0)
    (COMMAND "ROTATE" AA "" PT1 ro)
)
(command "chprop"aa "" "c" 2 "")
(setvar "osmode" 4543)
(prin1)
)

llsheng_73 发表于 2022-5-12 17:10:00

本帖最后由 llsheng_73 于 2022-5-12 17:18 编辑

用command它快不起来，另外很多步骤实际上都能计算出来

(defun c:bb (/ del n ro ss w1 d1 r ang)
(setq w1(if(numberp w)w 5)
      d1(if(numberp d)d 5))
(or(setq w(getdist (strcat"\n长:"(rtos(if(numberp w)w 5))">>>>>")))
   (setq w w1))
(or(setq d(getdist (strcat"\n宽:"(rtos(if(numberp d)d 5))">>>>>")))
   (setq d d1))
(setq ro(getreal "\n旋转角度:")
      ro(if ro(/(* ro pi)180)0))
(initget "Y y N n")
(setq del(="N"(GETKWORD"\n是否删除圆Y/N)"))
      r(*(sqrt(+(* w w)(* d d)))0.5)
      ang(angle'(0 0)(list w d))
      n 0
      ss(ssget '((0 . "CIRCLE"))))
(repeat(sslength ss)
    (sub-ob(ssname ss n)r ang ro del)
    (setq n(1+ n)))
(setvar "osmode" 4543)
)
(defun sub-ob(e r ang ro f / pt)
(setq pt(cdr(assoc 10(entget e))))
(entmake(apply'append(cons(mapcar'cons'(0 100 100 62 90 70)(append'("LWPOLYLINE""AcDbEntity""AcDbPolyline"2 4 1)))
               (mapcar'(lambda(x y)(list(cons 10(polar pt x r))(cons 42 y)))
                        (list(+ pi ang ro)(+ pi pi(- ang)ro)(+ ang ro)(+ pi(- ang)ro))
                        '(0 1 0 1)))))
(if f(entmod(append(entget e)'((62 . 1))))
    (entdel e))
)

Lwcdgl 发表于 2022-5-13 12:41:32

llsheng_73 发表于 2022-5-12 17:10
用command它快不起来，另外很多步骤实际上都能计算出来

经过大师修改后程式增长了不少性能果然不同凡响，就是我看不明白了
页: [1]
查看完整版本: 如何修改才可以让这个程式运行得更快?