如何实现选取边界自动偏移并插入块

q3_2006 · 发表于 2013-12-11 09:37

偏爱云~小吴发表于 2013-12-10 22:21

(defun new_ss (elast / ss1 ss2 ee2 i loop)
(setq ss2 (ssget "x"))
(setq i 0 loop t ss1 (ssadd))
(while loop
(setq ee2 (ssname ss2 i) i (1+ i))
(if (not (eq ee2 elast))
(if (/= (cdr (assoc 0 (entget ee2))) "VIEWPORT")
(setq ss1 (ssadd ee2 ss1))
)
(setq loop nil)
)
)
ss1
)
(defun xgzm (ss lst / ent i x)
(repeat (setq i (sslength ss))
(setq ent (entget (ssname ss (setq i (1- i)))))
(mapcar '(lambda(x) (setq ent (entmod (subst x (assoc (car x) ent) ent)))) lst)
)
)
(defun c:tt ( / bn box ea i of p0 p10 p11 sl ssk ssl ssn xb xd yb yd)
(command "undo" "be")
(setq box (acet-geom-ss-extents (ssget '((0 . "line"))) t)
xd (- (caadr box) (caar box))
yd (- (cadadr box) (cadar box))
p0 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (car box) (cadr box)))
of (getdist "\n偏移值<或图面量取>：")
bn (cdr (assoc 2 (entget (car (entsel "\n选取要插入的图块：")))))
xb (/ (- xd (* 2 of)) 100)
yb (/ (- yd (* 2 of)) 80)
ea (entlast)
)
(command "INSERT" bn p0 xb yb "0")
(command "explode" (entlast))
(setq ssn (new_ss ea)
ssk (ssget "p" '((0 . "INSERT")))
)
(command "select" ssn "r" ssk "")
(setq ssl (ssget "p"))
(xgzm ssk (list (cons 41 1) (cons 42 1) (cons 43 1)))
(setq i -1)
(while (setq sl (ssname ssl (setq i (1+ i))))
(setq p10 (cdr (assoc 10 (entget sl)))
p11 (cdr (assoc 11 (entget sl)))
)
(command "LENGTHEN" "de" of (list sl p10) (list sl p11) "")
)
(command "undo" "e")
)

(defun new_ss (elast / ss1 ss2 ee2 i loop) 
  (setq ss2 (ssget "x")) 
  (setq i 0 loop t ss1 (ssadd)) 
  (while loop 
    (setq ee2 (ssname ss2 i) i (1+ i)) 
    (if (not (eq ee2 elast)) 
      (if (/= (cdr (assoc 0 (entget ee2))) "VIEWPORT") 
        (setq ss1 (ssadd ee2 ss1)) 
      ) 
      (setq loop nil) 
    ) 
  ) 
  ss1 
) 
(defun xgzm (ss lst / ent i x) 
    (repeat (setq i (sslength ss)) 
            (setq ent (entget (ssname ss (setq i (1- i))))) 
            (mapcar '(lambda(x) (setq ent (entmod (subst x (assoc (car x) ent) ent)))) lst) 
        ) 
) 
(defun c:tt ( / bn box ea i of p0 p10 p11 sl ssk ssl ssn xb xd yb yd) 
  (command "undo" "be") 
    (setq box (acet-geom-ss-extents (ssget '((0 . "line"))) t) 
  xd (- (caadr box) (caar box)) 
  yd (- (cadadr box) (cadar box)) 
  p0 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (car box) (cadr box))) 
  of (getdist "\n偏移值<或图面量取>：") 
  bn (cdr (assoc 2 (entget (car (entsel "\n选取要插入的图块："))))) 
  xb (/ (- xd (* 2 of)) 100) 
  yb (/ (- yd (* 2 of)) 80) 
  ea (entlast) 
  ) 
  (command "INSERT" bn p0 xb yb "0") 
  (command "explode" (entlast)) 
  (setq ssn (new_ss ea) 
  ssk (ssget "p" '((0 . "INSERT"))) 
  ) 
  (command "select" ssn "r" ssk "") 
  (setq ssl (ssget "p")) 
  (xgzm ssk (list (cons 41 1) (cons 42 1) (cons 43 1))) 
  (setq  i -1) 
  (while (setq sl (ssname ssl (setq i (1+ i)))) 
    (setq p10 (cdr (assoc 10 (entget sl))) 
    p11 (cdr (assoc 11 (entget sl))) 
    ) 
    (command "LENGTHEN" "de" of (list sl p10) (list sl p11) "") 
  ) 
  (command "undo" "e") 
)

q3_2006 · 发表于 2013-12-11 09:47

本帖最后由 q3_2006 于 2013-12-11 09:50 编辑

块重新做了，主要是调整了插入点，下载我上传的图来测试。补充一句。。用了ET函数。。要装ET哟。。。

偏爱云~小吴 · 发表于 2013-12-11 20:09

q3_2006 发表于 2013-12-11 09:47
块重新做了，主要是调整了插入点，下载我上传的图来测试。补充一句。。用了ET函数。。要装ET哟。。。

感谢大神感谢大神

偏爱云~小吴 · 发表于 2013-12-12 09:53

q3_2006 发表于 2013-12-11 09:37

可否直接根据块名调取

偏爱云~小吴 · 发表于 2013-12-12 11:49

偏爱云~小吴发表于 2013-12-11 20:09
感谢大神感谢大神

大神用的ET是哪个版本啊

偏爱云~小吴 · 发表于 2013-12-12 12:26

q3_2006 发表于 2013-12-11 09:37

07版又当如何改

q3_2006 · 发表于 2013-12-12 13:41

http://u.xunzai.com/fileview_703861.html

q3_2006 · 发表于 2013-12-12 13:42

就是求选择集中心点...

偏爱云~小吴 · 发表于 2013-12-12 21:29

其实是CAD装的有问题，后来重装就好了，刚开始ET怎么搞都没有反应，多谢了。
如果把需要选择的块直接按块名调取该怎么改，因为就目前我的使用情况，只用那么一个块就可以解决问题，
bn (cdr (assoc 2 (entget (car (entsel "\n选取要插入的图块：")))))
直接插入块又该如何改
是bn (cdr (assoc 2 (entget “块名")))))么？

偏爱云~小吴 · 发表于 2013-12-12 21:36

偏爱云~小吴发表于 2013-12-12 12:26
07版又当如何改

其实是CAD的ET怎么也激活不了重装就好了。如果省掉选取块，直接将块名写进程序，通过块名调取又该如何改。改了半天没改成功，哎

账号		自动登录	找回密码
密码			注册

[讨论] 如何实现选取边界自动偏移并插入块

本帖子中包含更多资源