乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
楼主: JeepMaster

[编程交流] AMOVE from ASMI: selectable at

[复制链接]

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 15:03:57 | 显示全部楼层
 
Ok, I didn't make the code UCS compatible, but you could also achieve this using the TRANS function.
 
Lee
回复

使用道具 举报

11

主题

117

帖子

133

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
52
发表于 2022-7-6 15:12:18 | 显示全部楼层
LeeMac,
Thanks for taking the time to helping me out.  The latest version of this amove2 doesn't seem to work for dynamic blocks.  Your first try seems to work fine.  ASMI's code can do multiple selected  blocks, but yours can do selected attributes.  I really need something of both worlds.  Be able to select multiple blocks and then select certain multiple attributes to move.
 
ie: BLOCKA has ATT1,ATT2,ATT3,ATT4.  My drawing has 10 copies of BLOCKA, I want to select 5 of the BLOCKA and move their ATT1 and ATT2 to the left.
 
Your first code works fine, except I need it to be able to select more than one blocks to modify and then select more than one attributes within the block to move.  On top of all that, we use dynamic blocks exclusively at work here.  Sorry if this is too much to ask.  If it's too complicated, then don't worry about it.
I've tried your Attribute Suite, but none of the commands works on dynamic blocks.
回复

使用道具 举报

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 15:13:36 | 显示全部楼层
 
I would recommend you try....
 
 
ah... I see you have
 
I will see what I can do - having mostly worked on '04, my experience with Dynamic blocks is extremely limited...
回复

使用道具 举报

11

主题

117

帖子

133

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
52
发表于 2022-7-6 15:19:41 | 显示全部楼层
Just so if someone else is looking for the same thing as me.  I've found another version of attribute move from the theswam.org.  This one seems to do what I'm asking for.  Move selected multiple attributes on multiple dynamic blocks.  I still like the attribute suite from LeeMac better, but too bad it doesn't work on dynamic blocks.  Oh well, you can't always get what you want.
 
Command is "MoveAttText".
  1. ;   Lisp to move attributes ;   ;   Thanks to T.Willey & VovKa - Dec 2007;   [url]http://www.theswamp.org/index.php?topic=19881.15[/url](defun SelAtts (Message bAllowText / Sel EntData Pt1 Pt3 gr p1 p2 p3 p4 po   ss SelMode SelObjList flag); updated by gile @theSwamp.org to show the selection correctly.; updated by T.Willey to allow the option to select text objects, not mtext; updated by T.Willey, added new sub to see if the selection box and the bounding box of the objects;    selected cross, so that a true crossing is simulated  (defun DoBoxesCross (PtList1 PtList2 / Intersect cnt cnt2)       (setq cnt 0)     (while        (and           (not Intersect)           (< cnt 4)        )        (setq cnt2 0)        (repeat 4           (if              (inters                 (nth cnt PtList1)                 (nth                    (if (equal cnt 3)                       0                       (1+ cnt)                    )                    PtList1                 )                 (nth cnt2 PtList2)                 (nth                    (if (equal cnt2 3)                       0                       (1+ cnt2)                    )                    PtList2                 )                 T              )              (setq Intersect T)           )           (setq cnt2 (1+ cnt2))        )        (setq cnt (1+ cnt))     )     Intersect  );----------------------------------------------------------------------------------------------------  (defun GetAttSelection (ss SelMode / ObjList PtList TestList ll ur tempPtList SelObjList)       (foreach lst (ssnamex ss)        (cond           ((equal (car lst) 3)              (setq ObjList (cons (vlax-ename->vla-object (cadr lst)) ObjList))           )           ((equal (car lst) -1)              (foreach sub-lst (cdr lst)                 (setq PtList (cons (cadr sub-lst) PtList))              )           )        )     )     (foreach obj ObjList        (cond           ((= (vla-get-ObjectName obj) "AcDbBlockReference")              (foreach att (vlax-invoke obj 'GetAttributes)                 (if                    (and                       (/= (vla-get-TextString att) "")                       (= (vla-get-Invisible att) :vlax-false)                    )                    (progn                       (setq TestList nil)                       (vla-GetBoundingBox att 'll 'ur)                       (setq tempPtList                          (list                             (setq ll (safearray-value ll))                             (setq ur (safearray-value ur))                             (list (car ur) (cadr ll) (caddr ll))                             (list (car ll) (cadr ur) (caddr ll))                          )                       )                       (foreach pt tempPtList                          (if                             (and                                (< (caar PtList) (car pt) (caadr PtList))                                (< (cadar PtList) (cadr pt) (cadr (caddr PtList)))                             )                             (setq TestList (cons T TestList))                          )                       )                       (if (= SelMode "Windowing")                          (if (equal (length TestList) 4)                             (setq SelObjList (cons att SelObjList))                          )                          (if                             (or                                TestList                                (DoBoxesCross PtList tempPtList)                             )                             (setq SelObjList (cons att SelObjList))                          )                       )                    )                 )              )           )           (              (or                 (= (vla-get-ObjectName obj) "AcDbText")                 (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")              )              (if                  (or                    (/= (vla-get-TextString obj) "")                    (and                       (vlax-property-available-p obj 'TagString)                       (/= (vla-get-TagString obj) "")                    )                 )                 (progn                    (setq TestList nil)                    (vla-GetBoundingBox obj 'll 'ur)                    (setq tempPtList                       (list                          (setq ll (safearray-value ll))                          (setq ur (safearray-value ur))                          (list (car ur) (cadr ll) (caddr ll))                          (list (car ll) (cadr ur) (caddr ll))                       )                    )                    (foreach pt tempPtList                       (if                          (and                             (< (caar PtList) (car pt) (caadr PtList))                             (< (cadar PtList) (cadr pt) (cadr (caddr PtList)))                          )                          (setq TestList (cons T TestList))                       )                    )                    (if (= SelMode "Windowing")                       (if (equal (length TestList) 4)                          (setq SelObjList (cons obj SelObjList))                       )                       (if                          (or                             TestList                             (DoBoxesCross PtList tempPtList)                          )                          (setq SelObjList (cons obj SelObjList))                       )                    )                 )              )           )        )     )     SelObjList  );----------------------------------------------------------------------------------------------------   (defun gr-sel   (/ loop gr pt)        (setq loop T)     (while (and (setq gr (grread T 12 2)) (/= (car gr) 3) loop)        (cond           ((= (car gr) 5)              (setq pt (cadr gr))           )           (              (or                  (member gr '((2 13) (2 32)))                 (or (= (car gr) 11) (= (car gr) 25))              )              (setq loop nil                 pt   nil              )           )        )     )     (if   pt        (cond           ((car (nentselp pt)))           (pt)        )     )  );---------------------------------------------------------------------------------------------------------  (setvar "ErrNo" 0)  (while     (and        (princ (strcat "\n" Message))        (setq sel (gr-sel))     )     (if   (listp sel)        (progn           (setq p1  (list (car sel) (cadr sel))              pt1 (trans p1 1 2)           )           (princ "\nSpecify the opposite corner: ")           (while (and (setq gr (grread T 12 1)) (/= (car gr) 3))              (if (= 5 (car gr))                 (progn                    (redraw)                    (setq pt3   (trans (cadr gr) 1 2)                       p2   (trans (list (car pt3) (cadr pt1)) 2 1)                       p3   (list (caadr gr) (cadadr gr))                       p4   (trans (list (car pt1) (cadr pt3)) 2 1)                    )                    (if (< (car pt1) (car (trans p2 1 2)))                       (progn                          (setq SelMode "Windowing")                          (grvecs (list 255 p1 p2 255 p2 p3 255 p3 p4 255 p4 p1))                       )                       (progn                          (setq SelMode "Crossing")                          (grvecs                             (list -255 p1 p2 -255 p2 p3 -255 p3 p4 -255 p4 p1)                          )                       )                    )                 )              )           )           (redraw)           (if              (if bAllowText                 (setq ss (ssget "_C" p1 p3 '((0 . "INSERT,TEXT,ATTDEF"))))                 (setq ss (ssget "_C" p1 p3 '((0 . "INSERT"))))              )              (setq SelObjList (append SelObjList (GetAttSelection ss SelMode)))           )        )        (progn           (setq EntData (entget Sel))           (if              (or                 (= (cdr (assoc 0 EntData)) "ATTRIB")                 (and                    bAllowText                    (vl-position (cdr (assoc 0 EntData)) '("TEXT" "ATTDEF"))                 )              )              (progn                 (setq SelObjList                    (cons (vlax-ename->vla-object Sel) SelObjList)                 )                 (redraw Sel 3)              )           )        )     )     (foreach att SelObjList        (redraw (vlax-vla-object->ename att) 3)     )  )  (foreach att SelObjList     (redraw (vlax-vla-object->ename att) 4)  )  SelObjList);----------------------------------------------------------------------------------------------------(defun GetBBPoints (VlaxObj / tmpLL tmpUR LowLeft LowRight UpRight LowRight); Get bounding box points for a valid vlax-object; Returns a list of point lists.  (vla-GetBoundingBox VlaxObj 'tmpLL 'tmpUR)  (setq LowLeft (safearray-value tmpLL))  (setq UpRight (safearray-value tmpUR))  (setq LowRight (list (car UpRight) (cadr LowLeft) (caddr UpRight)))  (setq UpLeft (list (car LowLeft) (cadr UpRight) (caddr LowLeft)))  (list LowLeft LowRight UpRight UpLeft));---------------------------------------------------------------------------------------------------------(defun c:MoveAttText (/ ActDoc Plss CurSpace ObjList tempPtList PtList tempPline BasePt NewPt *error* LL UR)  (defun *error* (msg)       (command)     (if (> (sslength Plss) 0)        (command "_.erase" Plss "")     )     (vla-EndUndoMark ActDoc)  )  (defun GetCurrentSpace (Doc / BlkCol SpaceList CurSpace ActSpace temp1)  ; Returns the "block object" for the active space  ; Thanks to Jeff Mishler     (if (= (getvar "cvport") 1)        (vla-get-PaperSpace Doc)        (vla-get-ModelSpace Doc)     )  )    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))  (vla-EndUndoMark ActDoc)  (vla-StartUndoMark ActDoc)  (setq Plss (ssadd))  (setq CurSpace (GetCurrentSpace ActDoc))  (if (setq ObjList (SelAtts "Select attributes and/or text to move: " T))     (foreach obj ObjList        (setq tempPtList (GetBBPoints obj))        (setq BasePt (car tempPtList))        (setq PtList nil)        (foreach pt tempPtList           (setq PtList (cons (car pt) PtList))           (setq PtList (cons (cadr pt) PtList))        )        (setq tempPline           (vlax-invoke              CurSpace              'AddLightWeightPolyline              (reverse PtList)           )        )        (vla-put-Closed tempPline :vlax-true)        (ssadd (vlax-vla-object->ename tempPline) Plss)     )  )(setq BasePt (apply     (function       (lambda (p1 p2)         (mapcar (function (lambda (e1 e2) (/ (+ e1 e2) 2.))) p1 p2)       )     )     ((lambda (Coords)        (apply     (function       (lambda (mn mx) (mapcar (function (lambda (n x) (list n x))) mn mx))     )     (mapcar   (function (lambda (c) (list (apply 'min c) (apply 'max c))))        (list (mapcar 'car Coords) (mapcar 'cadr Coords))     )        )      )       (apply         'append         (mapcar      (function (lambda (Obj)             (vla-GetBoundingBox Obj 'LL 'UR)             (list (vlax-safearray->list LL) (vlax-safearray->list UR))           )      )      ObjList         )       )     )   ))  (if (> (sslength Plss) 0)     (progn        (setvar 'cmdecho 1)        (command "_.move"           Plss           ""           BasePt           pause        )        (setq NewPt (getvar 'lastpoint))        (setvar 'cmdecho 0)        (command "_.erase" Plss "")        (foreach obj ObjList          (vlax-invoke obj 'Move (append BasePt (cddr NewPt)) NewPt)        )     )  )  (vla-EndUndoMark ActDoc)  (princ))
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-5 03:21 , Processed in 1.291258 second(s), 58 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表