编程申请：以组合图元中心旋转并缩放

半听可乐

设备专业套建筑专业底图时，有些建筑图上的文字等图元角度跟本专业图面布置不符（各专业出图比例、图面角度、字体大小设置不同导致），一个个调整十分麻烦，有没有什么办法将那些零散的组合图元以其中心（或者自己指定）同时旋转并缩放？一次框选，处处旋转并缩放，各组合图元之间相对位置不改变！感觉要实现这功能很不简单，余钱有限，悉数奉上，权当给各位高手出挑战题（主要是现在需要当紧）

相关链接
xiaxiang（沙发回复） http://bbs.mjtd.com/thread-90258-1-1.html
chpmould 写的“快速相同实体组合选择 ”
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=91651&page=1#pid502513

Andyhon

(setq pts (acet-geom-textbox (entget ee) 0.0)
==>
(setq pts (Corners: ee)

;;; ==========================================================================
(defun Corners: (Entity^ / Ang~ Corners@ Dist~ EntList@ Ins Pt Pt1 Pt2 Pt3 Pt4)
    (setq EntList@ (entget Entity^)
          Corners@ (textbox EntList@)
          Ang~ (cdr (assoc 50 EntList@))
          Ins (cdr (assoc 10 EntList@))
          Pt (mapcar '+ (car Corners@) Ins)
          Pt1 (polar Ins (+ Ang~ (angle Ins Pt)) (distance Ins Pt))
          Pt (mapcar '+ (cadr Corners@) Ins)
          Pt3 (polar Ins (+ Ang~ (angle Ins Pt)) (distance Ins Pt))
          Dist~ (* (distance (car Corners@) (cadr Corners@)) (cos (- (angle Pt1 Pt3) Ang~)))
          Pt2 (polar Pt1 Ang~ Dist~)
          Pt4 (polar Pt3 Ang~ (- Dist~))
    );setq
    (list Pt1 Pt2 Pt3 Pt4)
  );defun Corners:
  
  
节录自 Text-Box.Lsp
;|
    Program Name: Text-Box.lsp [Text-Box R2]
    Created By:   Terry Miller (Email: terrycadd@yahoo.com)
                  (URL: http://web2.airmail.net/terrycad)
    Date Created: 9-19-97
|;

sunny20102

图中的图元为块,那么就很好编了
(以块的插入点原位旋转和缩放即可)

wuqiu1986

貌似yjr111的http://bbs.mjtd.com/thread-91905-1-1.html这篇帖子和你要求的基本能符合，楼主看看

Gu_xl

单个组合中心缩放旋转很容易，若要是批量执行，恐怕比较难，难点在程序如何在你选择的一堆图元里自动实现分组，如果没有一些特定条件来限制，恐怕很难实现！

Andyhon

(defun c:test ()
   (setvar 'CmdEcho 0)
   (command "Layer" "on" "*" "")
   
   ;; (setq ss (ssget "X" '((0 . "TEXT"))))
   (setq ss (ssget '((0 . "TEXT")))
         nn (sslength ss)
         vv -47.36056824356047
        fac (/ 1.25 3)
   )
   (While (setq ee (ssname ss (setq nn (1- nn))))
     (setq pts (acet-geom-textbox (entget ee) 0.0)        ; ET function
            pt (car pts)
            p5 (mapcar (function (lambda (a b) (/ (+ a b) 2))) pt (cadr pts))
           ee1 (ssget "f" (list pt (polar pt 0.5 4000)))
     )
     (command "Rotate" ee ee1 "" p5 vv)
     (command "Scale" "P" "" p5 fac)
   )
   (setvar 'CmdEcho 1)
)

半听可乐

Andyhon 发表于 2013-1-6 16:28
(defun c:test ()
   (setvar 'CmdEcho 0)
   (command "Layer" "on" "*" "")

长老，程序运行没反应？

Andyhon

Ok here

半听可乐

Andyhon 发表于 2013-1-6 17:59
Ok here

谢谢长老，目前问题是解决了，但我希望标本兼治，难道是CAD版本原因？

kwok

半听可乐 发表于 2013-1-6 19:48
谢谢长老，目前问题是解决了，但我希望标本兼治，难道是CAD版本原因？

cad要装有ET,试试