将图块处理进行到底，能原位把块内的实体重新生成画出来吗？

XDSoft

图块就是个容器，它和模型空间容器里面的实体不一样，我们不能直接选取做任意编辑。所以图块问题处理好了，对程序设计的水平提高是很快的。

今天的题目继续图块开刀。下面的图是在UCS坐标系下，图块可能都比例放大，也有X,Y不等比例的，现在要求把白色矩形框内的实体，文字，圆，多段线等原位的给“描出来”，要在UCS和WCS下都成功。不要改变实体性质，选一次块要批量生成里面所有的实体，不要交互点里面一个生成一个。一次生也就是模仿“炸开”命令做的事，程序不要使用 explode命令，是让你自己写个模拟的explode命令。

大家开始吧。

贴程序并能实现的，一律50D豆并威望+1。比较有技巧的，有新意的D豆80，威望+3

附件是测试图形

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:test2.rar 
下载次数:43  文件大小:8.99 KB 
下载权限: 不限 以上  [免费赚D豆]

liuyj

测试了老大的test2文件，第一种方法可以“炸开”图块，但“炸开”后的图块不在原位置了，而且两个块炸开后重叠在一起。第二种方法则根本没有反应。

zsw23

图在哪里呢？？

ll_j

不会Vlisp，不好说，反正这个题目在Alisp是很难的，要涉及坐标系转换和不等比例缩放，看贴图似乎还涉及实体坐标系的210组码，总的来说，是一个复杂的组合坐标转换，对有些实体而言是容易转换的，有些实体很难，有些实体几乎是无法转换的。
1.直线类，转换后还是直线，容易。
2.多义线，不涉及宽度和圆弧的容易转换，涉及宽度的转换后会失去宽度，涉及圆弧的转换后变为椭圆弧，算法将很复杂。
3.圆，转换后变为椭圆，容易。
4.椭圆，转换后还是椭圆，不过涉及转角和Ucs，转换很难。
5.样条曲线，即使不涉及转角，估计也没办法转换（超级强人除外）。
6.文字，相对容易。

总之，这个题目要考虑周全是很难的，现在精力有限，不敢去写这样的程序了，这里就是说说自己的理解，希望不要吓到大家，或许是我理解偏了，说得不对，大家也不要怪，权当抛砖吧。

Free-Lancer

对不等比块那是相当的麻烦!!

XDSoft

ll_j 发表于 2013-4-24 11:55

                               
登录/注册后可看大图

不会Vlisp，不好说，反正这个题目在Alisp是很难的，要涉及坐标系转换和不等比例缩放，看贴图似乎还涉及实体 ...

只要是ACAD的“炸开”命令能炸开的实体，都能转换。大家继续讨论，哪怕最后实现的非常困难，讨论的过程就是“受益”的。

fsxm

{:soso_e113:}矩阵 @高飞鸟 @highflybird 的强项

userzhl

等待highflybird和fsxm出招，学习下。

tjuzkj

[pcode=lisp,true]
;; Alan J. Thompson编的，好像对不等比例的块无效，只能选一个实体
(defun AT:NestedCopy (tocopy primary tmatrix space / dbase obj)
    ;; Copy nested item primary level in active drawing
    ;; tocopy - nested ENAME to copy ~ (car (nentselp))
    ;; primary - primary ENAME from which to copy nested entity ~ (last (last (nentselp)))
    ;; tmatrix - transformation matrix ~ (caddr (nentselp))
    ;; space   - active space collection for active drawing
    ;; Alan J. Thompson, 11.02.11
    (if (not (vl-catch-all-error-p
               (setq obj
                      (vl-catch-all-apply
                        '(lambda nil
                           (car (vlax-invoke
                                  (if (vl-catch-all-error-p
                                        (setq dbase
                                               (vl-catch-all-apply
                                                 'vla-get-xrefdatabase
                                                 (list
                                                   (vlax-ename->vla-object
                                                     (cdr
                                                       (assoc
                                                         330
                                                         (entget
                                                           (tblobjname
                                                             "BLOCK"
                                                             (if (vlax-property-available-p
                                                                   (setq primary (vlax-ename->vla-object primary))
                                                                   'effectivename
                                                                 )
                                                               (vla-get-effectivename primary)
                                                               (vla-get-name primary)
                                                             )
                                                           )
                                                         )
                                                       )
                                                     )
                                                   )
                                                 )
                                               )
                                        )
                                      )
                                    (cond (*AcadDoc*)
                                          ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                                    )
                                    dbase
                                  )
                                  'CopyObjects
                                  (list (vlax-ename->vla-object
                                          (if (eq (cdr (assoc 0 (entget tocopy))) "VERTEX")
                                            (cdr (assoc 330 (entget tocopy)))
                                            tocopy
                                          )
                                        )
                                  )
                                  space
                                )
                           )
                         )
                      )
               )
             )
        )
      (progn (vla-transformby obj (vlax-tmatrix tmatrix)) obj)
    )
  )
[/pcode]

yx5277

要在原位画出，呵呵，这个功能偶喜欢:P

liuyj

[pcode=lisp,true]
;;;一种方法是将块中的实体复制出来，然后删掉图块。
(defun c:exblk (/ doc mspace blks blname blkref blkdef objlst)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
mspace (vla-get-modelspace doc)
blks (vla-get-blocks doc)
)
(setq blkname (vla-get-name
(setq blkref (vlax-ename->vla-object
(car (entsel "\n选择要拆开的图块"))
)
)
)
)
(setq blkdef (vla-item blks blkname))
(vlax-for obj blkdef (setq objlst (cons obj objlst)))
(setq objs (vlax-safearray-fill
(vlax-make-safearray
vlax-vbObject
(cons 0 (1- (vla-get-count blkdef)))
)
objlst
)
)
(vla-copyobjects doc objs mspace)
(vla-erase blkref)
(mapcar 'vlax-release-object (list doc mspace blks blkdef))
(princ)
)[/pcode]

liuyj

代码怎么格式化啊？

liuyj

[pcode=lisp,true]
;;;这种是用了entmake方法的，忘了谁写的了。至今没看懂。
(defun c:exblk (/ a ent elst el nm pt xsc ysc zsc ang xi yi xd yd i ii eli)
  (setq a (car (entsel "\n选择要拆开的图块")))
  (setq        ent  (entget a)
        elst '(100 66 0 2 10 41 42 43 50 210 330 8 -3)
        el   (vl-remove-if-not '(lambda (x) (member (car x) elst)) ent)
        el   (mapcar '(lambda (x)
                        (if (equal x '(100 . "AcDbInsertBlock"))
                          '(100 . "AcDbBlockReference")
                          x
                        )
                      )
                     el
             )
  )
  (mapcar '(lambda (x y) (set x (cdr (assoc y ent))))
          '(nm pt xsc ysc zsc ang xi yi xd yd)
          '(2 10 41 42 43 50 70 71 44 45)
  )
  ;;返回实例:("*U1" (0.0 0.0 0.0) 1.0 1.0 1.0 0.0 2 2 0.0 0.0)
  (vl-cmdf ".ucs" "_ob" a)
  (cond        ((and (equal xd 0. 1e-4) (equal yd 0. 1e-4)) (entmake el))
        ((not (= 0 xi yi))
         (setq i  0
               ii 0
         )
         (repeat yi
           (repeat xi
             (entmake
               (subst (cons 10 (trans (list (* i xd) (* ii yd) 0.) 1 0))
                      (assoc 10 el)
                      el
               )
             )
             (setq i (1+ i))
           )
           (setq i  0
                 ii (1+ ii)
           )
         )
        )
        (T nil)
  )
  (entdel a)
  (vl-cmdf ".ucs" "p")
  (princ)
)[/pcode]

XDSoft

liuyj 发表于 2013-4-24 18:46

                               
登录/注册后可看大图

;;;这种是用了entmake方法的，忘了谁写的了。至今没看懂。
(defun c:exblk (/ a ent elst el nm pt xsc  ...

做个测试动画贴上来吧。

XDSoft

liuyj 发表于 2013-4-24 18:42

                               
登录/注册后可看大图

代码怎么格式化啊？

不知道你用啥编辑器，用LISPLINK的话，