[试用]：test.................

fsxm · 发表于 2006-10-14 20:03:11

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

SNSJ:

(defun c:test ()
(setq blkname (getstring "\n请输入块名:"))
(if (not (tblsearch "block" blkname))
(alert "你小子想玩我吧？没有这个块啦！")
(progn
(setq p (getpoint "\n拾取一个框："))
(setq px (car p)
py (cadr p)
)
(entmake
(list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
(cons 2 blkname)
'(10 0.0 0.0 0.0)
'(41 . 1.0)
'(42 . 1.0)
'(43 . 1.0)
)
)
(setq blk (entlast))
(vla-GetBoundingBox
(vlax-ename->vla-object blk)
'boxmin
'boxmax
)
(setq boxmin (vlax-safearray->list boxmin)
boxmax (vlax-safearray->list boxmax)
box (mapcar '- boxmax boxmin)
)
(setq exitwhile t)
(while exitwhile
(setq gr (grread t)
gr1 (car gr)
gr2 (cadr gr)
)
(cond ((= gr1 5)
(redraw)
(setq p2 (list px (cadr gr2))
p3 (list (car gr2) py)
scx (/ (- (car gr2) px) (car box))
scy (/ (- (cadr gr2) py) (cadr box))
insp (mapcar '- p (mapcar '* boxmin (list scx scy 0)))
)
(grvecs (list 2 p p2 2 p p3 2 gr2 p2 2 gr2 p3))
(entmod (list (cons -1 blk)
(cons 10 insp)
(cons 41 scx)
(cons 42 scy)
)
)
)
(t (setq exitwhile nil))
)
)
)
)
(redraw)
(princ)
)

(defun c:test () 
  (setq blkname (getstring "\n请输入块名:")) 
  (if (not (tblsearch "block" blkname)) 
    (alert "你小子想玩我吧？没有这个块啦！") 
    (progn 
      (setq p (getpoint "\n拾取一个框：")) 
      (setq px (car p) 
            py (cadr p) 
      ) 
      (entmake 
        (list 
          '(0 . "INSERT") 
          '(100 . "AcDbEntity") 
          '(100 . "AcDbBlockReference") 
          (cons 2 blkname) 
          '(10 0.0 0.0 0.0) 
          '(41 . 1.0) 
          '(42 . 1.0) 
          '(43 . 1.0) 
        ) 
      ) 
      (setq blk (entlast)) 
      (vla-GetBoundingBox 
        (vlax-ename->vla-object blk) 
        'boxmin 
        'boxmax 
      ) 
      (setq boxmin (vlax-safearray->list boxmin) 
            boxmax (vlax-safearray->list boxmax) 
            box           (mapcar '- boxmax boxmin) 
      ) 
      (setq exitwhile t) 
      (while exitwhile 
        (setq gr  (grread t) 
              gr1 (car gr) 
              gr2 (cadr gr) 
        ) 
        (cond ((= gr1 5) 
               (redraw) 
               (setq p2          (list px (cadr gr2)) 
                     p3          (list (car gr2) py) 
                     scx  (/ (- (car gr2) px) (car box)) 
                     scy  (/ (- (cadr gr2) py) (cadr box)) 
                     insp (mapcar '- p (mapcar '* boxmin (list scx scy 0))) 
               ) 
               (grvecs (list 2 p p2 2 p p3 2 gr2 p2 2 gr2 p3)) 
               (entmod (list (cons -1 blk) 
                             (cons 10 insp) 
                             (cons 41 scx) 
                             (cons 42 scy) 
                       ) 
               ) 
              ) 
              (t (setq exitwhile nil)) 
        ) 
      ) 
    ) 
  ) 
  (redraw) 
  (princ) 
)

qjcpj · 发表于 2006-10-14 20:19:22

请介绍一下程序功能！

fsxm · 发表于 2006-10-14 20:54:05

谢谢eachy.上面entmod一节变更为:

(if (not (zerop (* scx scy)))
(entmod (list (cons -1 blk)
(cons 10 insp)
(cons 41 scx)
(cons 42 scy)
)
)
)

复制代码

Dallas_whu · 发表于 2006-10-14 21:55:51

图块动态变换程序！

tc405003 · 发表于 2006-10-14 23:34:21

这个程序很强啊,有空得想想如何利用好

雨箭风刀 · 发表于 2006-10-16 00:22:10

帮做个演示

snsj · 发表于 2006-10-16 00:36:29

不错不错,虽然还不是很完善,对不同角度进行填充,原理已经很明确,最初担心的三级跳和闪动现象不是很明显,等我回去好好看看

它山之石 · 发表于 2006-10-16 12:21:07

插进来再SCALE？
效果看起来有点象

SCALE的动态效果很棒的哦
不知CAD自己是否就是这样实现的

雨箭风刀 · 发表于 2006-10-16 12:27:54

插入.....，移动.....，设.....比例
用entmod不断更新

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

[试用]：test.................

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子