求助各位大大帮忙修改个源码

wuwubaibai

此编码于社区或是某个论坛找到~但已忘了是哪位大大的分享目前程式的长度是为ob孔的圆心~想改成长度为ob孔的最外围~麻烦各位大大帮忙~感谢~~源码如下:
(defun c:obb ()
  (princ)
  (princ "启动命令为obb")
  (setq w (getdist "\n長:[5]"))
  (setq d (getdist "\n寬:[5]"))
(if
  (= w nil)
   (setq w 5)
)
(if
  (= d nil)
   (setq d 5)
)
  (SETQ ro (getreal "\n旋转角度:[0]"))
  (initget "Y y N n")
  (setq del(GETKWORD"\n是否删除圆Y/NY)"))
  (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" 7 "")
  (setvar "osmode" 4543)
  (prin1)
)

start4444

(defun c:obb (/ d del en n pt1 ro ss w)
  (princ)
  (princ "启动命令为obb")
  (setq w (getdist "\n长:[10]"))
  (setq d (getdist "\n宽:[5]"))
        (if
                (= w nil)
                (setq w 10)
        )
        (if
                (= d nil)
                (setq d 5)
        )
        (if (<= w d) (progn(alert "长度不足！") (exit)))
  (SETQ ro (getreal "\n旋转角度:[0]"))
  (initget "Y y N n")
  (setq del(GETKWORD"\n是否删除圆Y/NY)"))
  (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 d)))
  (setq pt3 (polar pt2 (/ pi 2) d))
  (setq pt4 (polar pt3 pi (- w d)))
  (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" 7 "")
  (setvar "osmode" 4543)
  (prin1)
)

wuwubaibai

start4444 发表于 2022-12-8 20:45
(defun c:obb (/ d del en n pt1 ro ss w)
  (princ)
  (princ "启动命令为obb")

非常感谢大大的修改~~您还帮写了侦错优化~再次感谢

zmzk

修改的太漂亮了！

xyp1964

1. (defun c:tt ()
   
2.   (princ "启动命令为tt")
   
3.   (defun sub-ob        (w d pt1 ro / pt2 pt3 pt4 aa pt)
   
4.     (setq pt2 (polar pt1 0 w)
   
5.           pt3 (polar pt2 (/ pi 2) d)
   
6.           pt4 (polar pt3 pi w)
   
7.     )
   
8.     (command "pline" pt1 pt2 "a" pt3 "l" pt4 "a" pt1 "")
   
9.     (setq aa (entlast)
   
10.           pt (inters pt1 pt3 pt2 pt4)
    
11.     )
    
12.     (command "move" aa "" pt pt1 "")
    
13.     (if        (/= ro 0)
    
14.       (command "rotate" aa "" pt1 ro)
    
15.     )
    
16.     (command "chprop" aa "" "c" 7 "")
    
17.   )
    
18.   (setvar "osmode" 0)
    
19.   (setq w0 (getdist "\n腰孔长:[10]"))
    
20.   (setq d (getdist "\n宽:[5]"))
    
21.   (or w0 (setq w0 10))
    
22.   (or d (setq d 5))
    
23.   (setq w (- w0 d))
    
24.   (setq ro (getreal "\n旋转角度:[0]"))
    
25.   (initget "Y N")
    
26.   (setq del (getkword "[删除圆(Y)/(N)]"))
    
27.   (if del
    
28.     (setq del (strcase del))
    
29.   )
    
30.   (if (setq ss (ssget '((0 . "CIRCLE"))))
    
31.     (progn
    
32.       (setq n 0)
    
33.       (repeat (sslength ss)
    
34.         (setq pt1 (cdr (assoc 10 (entget (ssname ss n))))
    
35.               n          (1+ n)
    
36.         )
    
37.         (sub-ob w d pt1 ro)
    
38.       )
    
39.       (cond ((or (= del nil) (= del "Y")) (command "erase" ss ""))
    
40.             (t (command "chprop" ss "" "c" 1 ""))
    
41.       )
    
42.     )
    
43.   )
    
44.   (princ)
    
45. )
    

(defun c:tt ()<br />   (princ "启动命令为tt")<br />   (defun sub-ob        (w d pt1 ro / pt2 pt3 pt4 aa pt)<br />     (setq pt2 (polar pt1 0 w)<br />           pt3 (polar pt2 (/ pi 2) d)<br />           pt4 (polar pt3 pi w)<br />     )<br />     (command "pline" pt1 pt2 "a" pt3 "l" pt4 "a" pt1 "")<br />     (setq aa (entlast)<br />           pt (inters pt1 pt3 pt2 pt4)<br />     )<br />     (command "move" aa "" pt pt1 "")<br />     (if        (/= ro 0)<br />       (command "rotate" aa "" pt1 ro)<br />     )<br />     (command "chprop" aa "" "c" 7 "")<br />   )<br />   (setvar "osmode" 0)<br />   (setq w0 (getdist "\n腰孔长:[10]"))<br />   (setq d (getdist "\n宽:[5]"))<br />   (or w0 (setq w0 10))<br />   (or d (setq d 5))<br />   (setq w (- w0 d))<br />   (setq ro (getreal "\n旋转角度:[0]"))<br />   (initget "Y N")<br />   (setq del (getkword "[删除圆(Y)/(N)]"))<br />   (if del<br />     (setq del (strcase del))<br />   )<br />   (if (setq ss (ssget '((0 . "CIRCLE"))))<br />     (progn<br />       (setq n 0)<br />       (repeat (sslength ss)<br />         (setq pt1 (cdr (assoc 10 (entget (ssname ss n))))<br />               n          (1+ n)<br />         )<br />         (sub-ob w d pt1 ro)<br />       )<br />       (cond ((or (= del nil) (= del "Y")) (command "erase" ss ""))<br />             (t (command "chprop" ss "" "c" 1 ""))<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />

yanshengjiang

xyp1964 发表于 2022-12-9 10:17

整洁、漂亮的源代码

(or w0 (setq w0 10))
  (or d (setq d 5))这个写法很简洁但还不习惯用

wuwubaibai

xyp1964 发表于 2022-12-9 10:17

谢谢版主的出手~可否请教版主~
当我使用您的程序的时候~跟S大帮我修改的代码~
两个不能共存是嘛!?
先使用前一个代码在执行您的代码是可以的~反之则不行,
这是为什么呢?谢谢