请求帮助,把画柜子的等分加强下
(defun C:df( / )(setq cm (getvar "cmdecho")
os (getvar "osmode"))
(setvar "CMDECHO" 0)
(command "color" "bylayer")
(command "_undo" "be")
(if (setq pta (getpoint "\n层板位置<空格>两点定位"))
(progn
(COMMAND "-BOUNDARY" pta "")
(setq ent (entlast))
(setq ss (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
(if (= (length ss) 4)
(progn
(vl-load-com)
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
(setq p1 (vlax-safearray->list maxpoint)
p3 (vlax-safearray->list minpoint))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(COMMAND "_.erase"ENT "")
)
(progn
(COMMAND "_.erase"ENT "")
(setq p1 (getpoint"\n洞口不是矩形,手动选择矩形的第一点"))
(setq p3 (getcorner p1 "\n第二点"))
(setvar "osmode" 0)
(command "rectang" p1 p3)
(setq ent (entlast))
(vl-load-com)
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
(setq p1 (vlax-safearray->list maxpoint)
p3 (vlax-safearray->list minpoint))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)));外框线点定位
(COMMAND "_.erase"ENT ""))
)
)
(progn
(setq p1 (getpoint"\n第一点"))
(setq p3 (getcorner p1 "\n第二点"))
(setvar "osmode" 0)
(command "rectang" p1 p3)
(setq ent (entlast))
(vl-load-com)
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
(setq p1 (vlax-safearray->list maxpoint)
p3 (vlax-safearray->list minpoint))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)));外框线点定位
(COMMAND "_.erase"ENT "")
)
)
(setq nl (getdist"\n层板厚度"))
(setq n (getint"\n层板数量"))
(setq gl (distance p1 p4))
(setq kl (distance p1 p2))
(setq l (/ (- gl (* nl n)) (1+ n)))
(repeat n
(setq ptn (polar p1 (angle p2 p3) l))
(setq ptny (polar ptn (angle p4 p3) kl))
(entmake (list '(0 . "LINE") (cons 10 ptn) (cons 11 ptny)))
(setq ptn1 (polar ptn (angle p2 p3) nl))
(setq ptn1y (polar ptn1 (angle p4 p3) kl))
(entmake (list '(0 . "LINE") (cons 10 ptn1) (cons 11 ptn1y)))
(setq p1 ptn1)
)
(setvar "CMDECHO" cm)
(setvar "osmode" os)
)
有大师能把这个改改吗,想要竖的效果也有他只有横的
竖向等分板,按上楼的方向,加了默认值,方便一点,不用每处都要自已输入
(defun C:ddf( / )
(setq cm (getvar "cmdecho")
os (getvar "osmode"))
(setvar "CMDECHO" 0)
(command "color" "bylayer")
(command "_undo" "be")
(if (setq pta (getpoint "\n层板位置<空格>两点定位"))
(progn
(COMMAND "-BOUNDARY" pta "")
(setq ent (entlast))
(setq ss (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
(if (= (length ss) 4)
(progn
(vl-load-com)
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
(setq p1 (vlax-safearray->list maxpoint)
p3 (vlax-safearray->list minpoint))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(COMMAND "_.erase"ENT "")
)
(progn
(COMMAND "_.erase"ENT "")
(setq p1 (getpoint"\n洞口不是矩形,手动选择矩形的第一点"))
(setq p3 (getcorner p1 "\n第二点"))
(setvar "osmode" 0)
(command "rectang" p1 p3)
(setq ent (entlast))
(vl-load-com)
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
(setq p1 (vlax-safearray->list maxpoint)
p3 (vlax-safearray->list minpoint))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)));外框线点定位
(COMMAND "_.erase"ENT ""))
)
)
(progn
(setq p1 (getpoint"\n第一点"))
(setq p3 (getcorner p1 "\n第二点"))
(setvar "osmode" 0)
(command "rectang" p1 p3)
(setq ent (entlast))
(vl-load-com)
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
(setq p1 (vlax-safearray->list maxpoint)
p3 (vlax-safearray->list minpoint))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)));外框线点定位
(COMMAND "_.erase"ENT "")
)
)
(setq nl (getdist"\n层板厚度<20>"))
(if (= nl nil) (setq nl 20))
(setq n (getint"\n层板数量<5>"))
(if (= n nil) (setq n 5))
(setq gl (distance p1 p4))
(setq kl (distance p1 p2))
(setq l (/ (- gl (* nl n)) (1+ n)))
(repeat n
(setq l (/ (- kl (* nl n)) (1+ n)))
(setq ptn (polar p1 (angle p4 p3) l))
(setq ptny (polar ptn (angle p2 p3) gl))
(entmake (list '(0 . "LINE") (cons 10 ptn) (cons 11 ptny)))
(setq ptn1 (polar ptn (angle p4 p3) nl))
(setq ptn1y (polar ptn1 (angle p2 p3) gl))
(entmake (list '(0 . "LINE") (cons 10 ptn1) (cons 11 ptn1y)))
(setq p1 ptn1)
)
(setvar "CMDECHO" cm)
(setvar "osmode" os)
)
水平方向的等分板有一个更简单的,基本上差不多,别的网友写的,
;;;;;;等分板
(defun c:DFF()
(setvar "CMDECHO" 0)
(setq os (getvar "OSMODE"))
(setq p1 (getpoint "\n左上角点:")
p3 (getcorner p1 "\n右下角点:"))
(setq p1x (car p1)
p1y (cadr p1)
p3x (car p3)
p3y (cadr p3)
p2(list p3x p1y)
p4(list p1x p3y))
(setq ch (getdist "\n请输入中间层板厚度<20>: "))
(if (= ch nil) (setq ch 20))
(setq df (getdist "\n请输入风格数<5>: "))
(setq df (if (= df nil) 5 (fix df)))
(setq A (distance p1 p4))
(setq x (/ (- A (* (1- df) ch)) df))
(command "line" (polar p4 (* pi 0.5) x) (polar p3 (* pi 0.5) x) "")
(setq s01 (entlast))
(command "_offset" ch (list s01 (polar p4 (* pi 0.5) x)) (polar (polar p4 (* pi 0.5) x) (* pi 0.5) 500) "" )
(setq ss (ssget "w" (polar p1 (* pi 1.5) 10) (polar p3 (* pi 0.5) 10) ))
(command "_array" ss "" "R" (1- df) "1" (+ x ch) "")
(setvar "CMDECHO" 1)
(princ)
) 把这部份改成下面的,就变成竖向的了
(repeat n
(setq l (/ (- kl (* nl n)) (1+ n)))
(setq ptn (polar p1 (angle p4 p3) l))
(setq ptny (polar ptn (angle p2 p3) gl))
(entmake (list '(0 . "LINE") (cons 10 ptn) (cons 11 ptny)))
(setq ptn1 (polar ptn (angle p4 p3) nl))
(setq ptn1y (polar ptn1 (angle p2 p3) gl))
(entmake (list '(0 . "LINE") (cons 10 ptn1) (cons 11 ptn1y)))
(setq p1 ptn1)
) 直接做个动态块多省事啊,还方便修改 k1nger 发表于 2021-8-16 10:09
直接做个动态块多省事啊,还方便修改
动态块有但是感觉还是这个方法好用点 这个我都弄出来用了好几年了! 写复杂了,用command调用阵列 写不完的日记 发表于 2021-8-17 08:52
写复杂了,用command调用阵列
别人那里拿的,不知道你是作者呵呵 谢谢大家,我这边自己也弄好了。