[教学]：API应用－Dinsert。

eachy · 发表于 2002-3-28 15:02:14

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

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

×

;|
命令: dinsert
功能: 动态插入图块，可以用图块的包围盒模拟。
|;
(defun c:dinsert (/ dwg s s1 p an r #blk ptl tfz key)
;;获取图块文件
(setq dwg (xdrx_getfiled "" "" "")
;pt '(0 0 0)
)
(if dwg
(progn
(xdrx_begin)
(xdrx_ucson)
;;默认值
(if (not #key)
(setq #key "2")
)
(initget 128 "1 2")
(if (not (setq key (getkword (strcat "\n[1 轮廓显示/2 实际显示]<"
#key
">: "
)
)
)
)
(setq key #key)
(setq #key key)
)
;;将图块引入图中
(command ".insert" (car dwg) '(0 0 0) 1 "" 0)
(entdel (entlast))
;|(setq e (xdrx_object_get "block" (getvar "insname")));;块实体名
(if (setq p (xdrx_dragssmove
;;动态移动
"\n请点取插入点: "
(if (= key "1")
s1
s
)
pt
)
)
(command ".move"
(if (= key "1")
s1
s
)
""
pt
p
)
)|;
;;动态插入，用insert ^_^，为了后面的效果还得删除
(princ "\n插入点: ")
(command ".insert" "" pause 1 "" 0)
(setq s (ssget "L"))
;;获得拾取的插入点
(setq p (car (xdrx_drawing->lastpts)))
(setq #blk (xdrx_entity_box s))
;;判断图块整体是否超出屏幕
(if (setq tfz (apply
'xdrx_isptoffscr
#blk
)
)
(progn
(xdrx_drawing_viewsave)
(if (setq #blk (xdrx_entity_box s))
(progn
(setq pt1 (cadr #blk)
pt2 (last #blk)
)
(xdrx_drawing_zoomw pt1 pt2 t)
)
)
)
)
;;绘制图块轮廓
(if (= key "1")
(progn
(entdel (entlast))
(command ".rectang" (car #blk) (nth 2 #blk))
(setq s1 (ssget "l"))
)
)
;动态缩放、旋转
(if (setq r (xdrx_dragsscale
"\n图块比例 <1>: "
(if (= key "1")
s1
s
)
p
;1
)
)
(progn
(if (= 'STR (type r))
(setq r (atof r))
)
(if (= r 0)
(setq r 1)
)
(command ".scale"
(if (= key "1")
s1
s
)
""
p
(abs r)
)
)
)
(if (setq an (xdrx_dragssrotate
"\n如需旋转角度, 请点取要旋转的角度 <不调整>: "
(if (= key "1")
s1
s
)
p
)
)
(command ".rotate"
(if (= key "1")
s1
s
)
""
p
an
)
)
(if (= key "1")
(progn
;(xdrx_entity_delete s1)
;(xdrx_entity_delete s)
(command ".erase" s1 s "")
(command ".insert"
""
p
(if (not r)
"1"
r
)
""
(if (not an)
"0"
an
)
)
)
)
(if tfz
(xdrx_drawing_viewres) ;恢复视窗
)
(xdrx_ucsoff)
(xdrx_end)
) ;progn
) ;if
(princ)
)

;| 
命令: dinsert 
功能: 动态插入图块，可以用图块的包围盒模拟。 
|; 
(defun c:dinsert (/ dwg s s1 p an r #blk ptl tfz key) 
  ;;获取图块文件 
  (setq        dwg (xdrx_getfiled "" "" "") 
        ;pt  '(0 0 0) 
  ) 
  (if dwg 
    (progn 
      (xdrx_begin) 
      (xdrx_ucson) 
      ;;默认值 
      (if (not #key) 
        (setq #key "2") 
      ) 
      (initget 128 "1 2") 
      (if (not (setq key (getkword (strcat "\n[1 轮廓显示/2 实际显示]<" 
                                           #key 
                                           ">: " 
                                   ) 
                         ) 
               ) 
          ) 
        (setq key #key) 
        (setq #key key) 
      ) 
      ;;将图块引入图中 
      (command ".insert" (car dwg) '(0 0 0) 1 "" 0) 
      (entdel (entlast)) 
      ;|(setq e (xdrx_object_get "block" (getvar "insname")));;块实体名 
      (if (setq        p (xdrx_dragssmove 
                    ;;动态移动 
                    "\n请点取插入点: " 
                    (if        (= key "1") 
                      s1 
                      s 
                    ) 
                    pt 
                  ) 
          ) 
        (command ".move" 
                 (if (= key "1") 
                   s1 
                   s 
                 ) 
                 "" 
                 pt 
                 p 
        ) 
      )|; 
      ;;动态插入，用insert ^_^，为了后面的效果还得删除 
      (princ "\n插入点: ") 
      (command ".insert" "" pause 1 "" 0) 
      (setq s (ssget "L")) 
      ;;获得拾取的插入点 
      (setq p (car (xdrx_drawing->lastpts))) 
      (setq #blk (xdrx_entity_box s)) 
      ;;判断图块整体是否超出屏幕 
      (if (setq        tfz (apply 
                      'xdrx_isptoffscr 
                      #blk 
                    ) 
          ) 
        (progn 
          (xdrx_drawing_viewsave) 
          (if (setq #blk (xdrx_entity_box s)) 
            (progn 
              (setq pt1        (cadr #blk) 
                    pt2        (last #blk) 
              ) 
              (xdrx_drawing_zoomw pt1 pt2 t) 
            ) 
          ) 
        ) 
      ) 
      ;;绘制图块轮廓 
      (if (= key "1") 
        (progn 
          (entdel (entlast)) 
          (command ".rectang" (car #blk) (nth 2 #blk)) 
          (setq s1 (ssget "l")) 
        ) 
      ) 
      ;动态缩放、旋转 
      (if (setq        r (xdrx_dragsscale        
                    "\n图块比例 <1>: " 
                    (if        (= key "1") 
                      s1 
                      s 
                    ) 
                    p 
                                        ;1 
                  ) 
          ) 
        (progn 
          (if (= 'STR (type r)) 
            (setq r (atof r)) 
          ) 
          (if (= r 0) 
            (setq r 1) 
          ) 
          (command ".scale" 
                   (if (= key "1") 
                     s1 
                     s 
                   ) 
                   "" 
                   p 
                   (abs r) 
          ) 
        ) 
      ) 
      (if (setq        an (xdrx_dragssrotate 
                     "\n如需旋转角度, 请点取要旋转的角度 <不调整>: " 
                     (if (= key "1") 
                       s1 
                       s 
                     ) 
                     p 
                   ) 
          ) 
        (command ".rotate" 
                 (if (= key "1") 
                   s1 
                   s 
                 ) 
                 "" 
                 p 
                 an 
        ) 
      ) 
      (if (= key "1") 
        (progn 
                                        ;(xdrx_entity_delete s1) 
                                        ;(xdrx_entity_delete s) 
          (command ".erase" s1 s "") 
          (command ".insert" 
                   "" 
                   p 
                   (if (not r) 
                     "1" 
                     r 
                   ) 
                   "" 
                   (if (not an) 
                     "0" 
                     an 
                   ) 
          ) 
        ) 
      ) 
      (if tfz 
        (xdrx_drawing_viewres)                ;恢复视窗 
      ) 
      (xdrx_ucsoff) 
      (xdrx_end) 
    )                                        ;progn 
  )                                        ;if 
  (princ) 
)

eachy · 发表于 2002-3-28 15:06:18

以下内容为编程之前与XD的对话。

....
XDSoft 说：
用API的拖动
eachy 说：
先要获取dwg路径和文件名
XDSoft 说：
用xdrx_getfiled
XDSoft 说：
让它选择文件
XDSoft 说：
然后移动，缩放，旋转
XDSoft 说：
考虑到程序快，用xdrx_entity_box得到包围盒
XDSoft 说：
拖动这个矩形框也可以
XDSoft 说：
分别写个吧，一个是矩形框，一个是实际
...
eachy 说：
想到了天正的“实插图框”、“虚插图框”
...
eachy 说：
dragssxx一定要选择集，实体不行？
...
XDSoft 说：
(ssget "l")
...
eachy 说：
还得判断当前屏幕框是否比插入的块框小
XDSoft 说：
xdrx_drawing_screenbox
...
XDSoft 说：
xdrx_isptoffscr
XDSoft 说：
或者判断屏幕的框在块的框内部
...
XDSoft 说：
直接用xdrx_drawing_zoomw
XDSoft 说：
用10倍的块高度ZOOM窗口
XDSoft 说：
几倍自己实验下
XDSoft 说：
把块基点做屏幕中心
XDSoft 说：
ZOOM之前用xdrx_drawing_viewsave
eachy 说：
我是这样，先将块用1:1插到（0 0 0)点，然后用拖动
XDSoft 说：
之后，用xdrx_drawing_viewres恢复屏幕
XDSoft 说：
最好让它自己点插入点
XDSoft 说：
然后把这个插入点做屏幕中心
XDSoft 说：
找个适当的比例，比如屏幕高度的几倍
eachy 说：
直接给插入点看不到块
...
XDSoft 说：
可以先用程序把block插入进来
XDSoft 说：
不执行完就ctrl+c
eachy 说：
这和天正的插图框一样，推动的时候已经看到块了
XDSoft 说：
插入点先按0，0插入，提示完后直接CTRL+C
XDSoft 说：
然后程序在让它自己选插入点
eachy 说：
这有个问题，有的块的basepoint可能和图形相距很远
XDSoft 说：
这就要求他做块的时候注意了
eachy 说：
如果块是别人做的呢？
...
eachy 说：
或者是别人的图
XDSoft 说：
那用API XDRX_OBJECT_GET
XDSoft 说：
得到块的实体的框
eachy 说：
程序还是用块的中心
XDSoft 说：
找最下点重新定义块
XDSoft 说：
这样也不好，因为既然想用块
XDSoft 说：
一定是配合插入点的
XDSoft 说：
比如家具什么的
XDSoft 说：
给乱改了，就不好了
XDSoft 说：
AUTOCAD插入也是这样的
XDSoft 说：
离开很远，也看不到
...
eachy 说：
我的意思是判断一下，如果插入点离图远就用块中心，否则用插入点
XDSoft 说：
让他自己用关键字选择吧
XDSoft 说：
别自动判断
eachy 说：
中心时用entity_box
...
XDSoft 说：
可能不同的时候用不同的程序
...
XDSoft 说：
屏幕缩放的考虑下
...
XDSoft 说：
或者插入后
XDSoft 说：
找到块的框的左下点
XDSoft 说：
从左下点移动到屏幕内，适当缩放
XDSoft 说：
然后开始拖动
XDSoft 说：
默认是1：1那么大
XDSoft 说：
先移动，然后缩放，然后旋转
XDSoft 说：
要同时允许输入数字
eachy 说：
和insert的顺序一样
...
XDSoft 说：
线框拖动和实际显示做一起吧
XDSoft 说：
用个关键字，让用户输入
XDSoft 说：
程序记住上次的输入，放到默认的回车里面
XDSoft 说：
真是越来越大了
...

复制代码

eachy · 发表于 2002-3-28 15:11:30

程序用到的dragsscale对实际显示没有问题，但对轮廓显示时拖动的框非常小？请XD解释了.

xdrx_dragsscale
功能：用鼠标动态(拖动)缩放选择集，不实际缩放，只是模拟AUTOCAD scale命令的情形。
调用格式：(xdrx_dragsscale <提示串> <选择集> <基点> [当前图形的出图比例])
参数说明：[当前图形的出图比例]：可以缺省，默认值是1000 (即出图比例是1:100)
若按1:1出图，请直到此值为1
因为，AUTOCAD 只是在1:1情况下，命令scale才能用显示出鼠标动态
拖动的效果。而我们常用的绘图习惯是1:100,所以默认值设置成1000.
返回值：返回缩放后的比例系数。当不拖动，可以直接输入缩放的比例，此时，返回值是
比例值的字符串。
直接回车，返回NIL。
示例：请按1：100绘图
(setq ss (ssget))
(setq pt (getpoint "\n基点"))
(if (setq r (sort1 "\n再输入切割图的放大比例 <1>: " ss p1))
(progn
(if (='STR (type r))
(setq r (atof r))
)
(if (= r 0)
(setq r 1)
)
(command ".scale" ss "" p1 (abs r))
)
)

21cn · 发表于 2002-3-28 15:15:55

使用中出现图形重新生成时，拖动效果不执行！

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

[教学]：API应用－Dinsert。

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

相关帖子