请教，如果让书柜成组？
;;;;;;;;;;;书柜
(vl-load-com)
(defun c:SG ( / _line)
(defun *error* (msg)
(setvar "cecolor""bylayer") ;_ 恢复颜色随层；
(setvar "clayer" mylayer) ;恢复原有图层
(princ "错误信息: ")
(princ msg) ;_ 打印错误信息
(princ)
)
(setvar "measurement" 0) ; 设置公制单位
(setvar "cmdecho" 0) ; 关闭命令响应
(setvar "hpassoc" 0) ;设置填充时不关联
(setvar "osmode" 959) ;设置捕捉
(setq mylayer (getvar "clayer")) ;保存当前层
(setq oldcolor (getvar "cecolor")) ;保存原有颜色
(defun _line (lst)
(if (= (tblsearch "layer" "0-PM-固定家具") nil)
(Command "-layer" "m" "0-PM-固定家具" "c" 251 "" "")
(Command "-layer" "t" "0-PM-固定家具" "")
)
(setvar "clayer" "0-PM-固定家具")
(mapcar '(lambda (a b)(entmakex (list '(0 . "LINE") (cons 10 a) (cons 11 b)))) lst (cdr lst))
)
(while (and (setq n (Cond ((getint(strcat "\n等分数["(itoa(setq n(Cond ( n )( 5 ))))"] ")))( n )))
(setq p1 (getpoint "\n第一角点 :"))
(setq p2 (getcorner p1 "\n另一角点 :"))
)
(setq dx (abs (- (car p2) (car p1)))
dy (abs (- (cadr p2) (cadr p1)))
)
(setq ptm (list (min (car p1) (car p2)) (min (cadr p1) (cadr p2)))
p2(list (max (car p1) (car p2)) (max (cadr p1) (cadr p2)))
p1ptm
)
(if (> dx dy)
(progn
(setq dd (/ dx n))
(repeat n
(setq p3 (polar p1 0 dd)
p4 (polar p1 (/ pi 2) dy)
p5 (polar p4 0 dd)
)
(_LINE (list p1 p3 p4 p5 p1 p4))
(setq p1 p3)
)
)
(progn
(setq dd (/ dy n))
(repeat n
(setq p3 (polar p1 (/ pi 2) dd)
p4 (polar p1 0 dx)
p5 (polar p3 0 dx)
)
(_LINE (list p1 p3 p4 p5 p1 p4))
(setq p1 p3)
)
)
)
(_LINE (list p3 p5))
)
(command "color" oldcolor) ;设置为原有颜色
;;(setvar "cecolor" "bylayer");设置颜色随层
;;(setvar "color" "251");设置颜色随层
(setvar "clayer" mylayer)
(princ)
)
(vl-load-com)
(defun c:SG (/ *error* _line addngroup bjty dd dx dy lm-make-ssadd lm-ss-enlst n p1 p2 p3 p4 p5 ptm sss)
(defun *error* (msg)
(princ "错误信息: ")
(princ msg) ;_ 打印错误信息
(princ)
)
(defun lm-ss-enlst (ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
)
)
(defun lm-make-ssadd (en / lst)
(if en
(progn
(while (setq en (entnext en))
(if (not (member (cdr (assoc 0 (entget en)))
'("ATTRIB" "VERTEX" "SEQEND")
)
)
(setq LST (cons en LST))
)
)
(lm-ss-enlst (reverse LST))
)
(ssget "X")
)
)
(defun AddnGroup (Objlst)
(vla-appenditems
(vla-add (vla-get-groups
(vla-get-activedocument (vlax-get-acad-object))
)
"*"
)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length objlst)))
)
objlst
)
)
)
)
(setvar "measurement" 0) ; 设置公制单位
(setvar "cmdecho" 0) ; 关闭命令响应
(setvar "hpassoc" 0) ;设置填充时不关联
(setvar "osmode" 959) ;设置捕捉
(setvar "pickstyle" 1)
(defun _line (lst)
(if (null(tblsearch "layer" "0-PM-固定家具"))
(Command "-layer" "m" "0-PM-固定家具" "c" 251 "" "")
)
(mapcar '(lambda (a b)(entmakex (list '(0 . "LINE") '(8 . "0-PM-固定家具") (cons 10 a) (cons 11 b)))) lst (cdr lst))
)
(while (and
(setq n (Cond ((getint(strcat "\n等分数["(itoa(setq n(Cond ( n )( 5 ))))"] ")))( n )))
(setq p1 (getpoint "\n第一角点 :"))
(setq p2 (getcorner p1 "\n另一角点 :"))
)
(setq
dx (abs (- (car p2) (car p1)))
dy (abs (- (cadr p2) (cadr p1)))
ptm (list (min (car p1) (car p2)) (min (cadr p1) (cadr p2)))
p2 (list (max (car p1) (car p2)) (max (cadr p1) (cadr p2)))
p1 ptm
bjty(entlast)
)
(if (> dx dy)
(progn
(setq dd (/ dx n))
(repeat n
(setq
p3 (polar p1 0 dd)
p4 (polar p1 (/ pi 2) dy)
p5 (polar p4 0 dd)
)
(_LINE (list p1 p3 p4 p5 p1 p4))
(setq p1 p3)
)
)
(progn
(setq dd (/ dy n))
(repeat n
(setq
p3 (polar p1 (/ pi 2) dd)
p4 (polar p1 0 dx)
p5 (polar p3 0 dx)
)
(_LINE (list p1 p3 p4 p5 p1 p4))
(setq p1 p3)
)
)
)
(_LINE (list p3 p5))
(setq sss(lm-ss-enlst(lm-make-ssadd bjty)))
(addngroup (mapcar 'vlax-ename->vla-object sss))
)
(princ)
) 谢谢！可以了！ 飞雪神光 发表于 2023-3-5 19:09
这个最好能设置柜子的深度 stonedesign 发表于 2024-4-29 18:58
这个最好能设置柜子的深度
他这是平面的 没这功能 飞雪神光 发表于 2024-4-29 21:07
他这是平面的 没这功能
我说的就是平面的也就是长和宽宽度小的这一面可以设置就好了
stonedesign 发表于 2024-4-30 15:40
我说的就是平面的也就是长和宽宽度小的这一面可以设置就好了
那你得找作者改啊
页:
[1]