哪位大师能不能帮我修改下这个画百叶程序

xvjiex

如果后面又要修改80呢？

GDFGFGF

xvjiex 发表于 2020-12-10 14:19
如果后面又要修改80呢？

就像类似命令做个子选项，需要改时调出子选项，不需要就作为默认选项

xvjiex

这个可以，请稍等。

GDFGFGF

xvjiex 发表于 2020-12-10 14:27
这个可以，请稍等。

好的，大师辛苦了

xvjiex

已经简化，需要改时调出子选项，不需要就作为默认选项。

GDFGFGF

xvjiex 发表于 2020-12-10 12:23
帮你改了，请测试。

已经调整，再试试。

已经是我想要的了，感谢大神

GDFGFGF

xvjiex 发表于 2020-12-10 15:15
已经简化，需要改时调出子选项，不需要就作为默认选项。

看看还有谁需要的    (defun c:bC ( / th1 th2 i1 ss en pt1 pt2 pt3 dd nmb dst ang p1 p2 recSS)        (setvar "CMDECHO" 0)
        (command "_undo" "be")
        (defun en11pt (en n / ll rr box ptn a p1 p2 p3 p4 p5 p6 p7 p8 p9)
                (setq en (vlax-ename->vla-object en))
                (vla-GetBoundingBox en 'll 'rr)
                (setq a  (list (vlax-safearray->list ll) (vlax-safearray->list rr))
                        p1 (car a)
                        p9 (cadr a)
                        p5 (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p9)
                        p2 (list (car p5) (cadr p1)0.)
                        p3 (list (car p9) (cadr p1)0.)
                        p4 (list (car p1) (cadr p5)0.)
                        p6 (list (car p9) (cadr p5)0.)
                        p7 (list (car p1) (cadr p9)0.)
                        p8 (list (car p5) (cadr p9)0.)
                )
                (nth (1- n) (list p1 p2 p3 p4 p5 p6 p7 p8 p9))
        )
        (or kd (setq kd 100))
        (or jd (setq jd 200))
        (princ (strcat"\n请选择矩形。百叶框和条宽度<"(rtos kd 2 2)">；百叶分隔<"(rtos jd 2 2)">，更改请直接右键(不选择任何矩形)。"))
  (while (not(setq ss(ssget '((0 . "LWPOLYLINE")))))
                (setq th1 (getreal (strcat"\n请输入百叶框和条宽度<"(rtos kd 2 2)">：")))
                (if th1 (setq kd th1))
                (setq th2 (getreal (strcat"\n请输入百叶分隔近似值间距<"(rtos jd 2 3)">：")))
                (if th2 (setq jd th2))
                (princ (strcat"\n请选择矩形。百叶框和条宽度<"(rtos kd 2 2)">；百叶分隔<"(rtos jd 2 2)">，更改请直接右键(不选择任何矩形)。"))
        )   
        (setq i1 -1)
        (while (setq en (ssname ss (setq i1 (1+ i1))))
                (setq pt2 (en11pt en 1))
                (setq pt1 (en11pt en 7))
                (setq pt3 (en11pt en 3))
                (setq  dd (- (distance pt1 pt2) kd)
                        nmb (/ dd (+ kd jd))
                        nmb (atoi (rtos nmb 2 0))
                        dst (/ dd nmb)
                        ang (angle pt2 pt1)
                        nmb (1- nmb)
                )
                (setq p1 (list (+ kd (car pt2))(+ kd (cadr pt2)) ))
                (setq p2 (list (- (car pt3) kd)(+ dst (cadr pt3)) ))
                (command ".rectang"  "_non" p1 "_non" p2)
                (setq recSS (entlast))
                (command ".chprop" recSS "" "c" Bylayer )
                (command "_.COPY" recSS "" "M" "_non" p1)
                (repeat nmb
                        (command "_non" (setq p1 (polar p1 ang dst)))
                )
                (command "")
        )
       
        (command "_undo" "e")
        (setvar "CMDECHO" 1)
        (princ)
)

(princ "\n本程序采摘自www.lisp123.com更多内容敬请期待！")
(princ "\n本程序命令：BC")
(princ)

GDFGFGF

xvjiex 发表于 2020-12-10 11:07
帮你改了，请测试。

已经调整，再试试。

简化阵列
(defun c:rrR(/ *hang2 *jj2 *lie2 a1 ab1 b1 ss xlen ylen)
(setq ss (ssget))
(setq ab1 (box ss) a1 (car ab1) b1         (cadr ab1))
(setq xlen (abs (- (car b1) (car a1))))
(setq ylen (abs (- (cadr b1) (cadr a1))))
(if (not *hang)(setq *hang 1))
(setq *hang (if (setq *hang2 (getint (strcat "\n输入行数:<" (itoa *hang) ">:"))) *hang2  *hang))
       
(if (not *lie)(setq *lie 1))
(setq *lie (if (setq *lie2 (getint (strcat "\n输入列数:<" (itoa *lie) ">:"))) *lie2 *lie))
(if (not *jj)(setq *jj 100))       
(setq *jj (if (setq *jj2 (getdist (strcat "\n输入间距:<" (rtos *jj 2 2) ">:"))) *jj2 *jj))
(command "ARRAY" ss "" "r" *hang *lie (+ ylen *jj) (+ xlen *jj))
;(princ)       
)

GDFGFGF

xvjiex 发表于 2020-12-10 14:27
这个可以，请稍等。

大师，又出现问题了，麻烦再优化下

xvjiex

这个估计是坐标系统的问题，请在正常的坐标系统下画矩形。