Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu]Lisp chuyển tâm block ATT?


  • Please log in to reply
3 replies to this topic

#1 hugo75

hugo75

    biết vẽ polygon

  • Members
  • PipPip
  • 72 Bài viết
Điểm đánh giá: -4 (bình thường)

Đã gửi 01 July 2013 - 08:56 PM

Mình có 1 Block ATT có tâm là tâm đường tròn.Nhờ các bác viết giùm đoạn lisp dời tâm của block này xuống phía dưới giống như file đính kèm.Dời tâm 1 lúc nhiều block ATT luôn các bác ah.Thanks.

http://www.cadviet.c...07_drawing1.dwg


  • 0

#2 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 02 July 2013 - 07:23 AM

Lần sau bạn nên chịu khó search trướcs khi hỏi !

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...=0
 
;;---------------=={ Change Block Insertion }==---------------;;
;;                                                            ;;
;;  Modifies the Block Definition Base Point of a selected    ;;
;;  block to a user specified point.                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  With Thanks to Gilles Chanteau for his excellent advice.  ;;
;;------------------------------------------------------------;;
;;  Version:  1.3    -    23rd June 2011                      ;;
;;------------------------------------------------------------;;
 
;; -- Retains Insertion Point -- §æi ®iÓm chÌn, vÞ trÝ block thay ®æi theo.
(defun c:CBI  nil (ChangeBlockInsertion nil))
 
;; -- Retains Block Position -- §æi ®iÓm chÌn, gi÷ nguyªn vÞ trÝ block.
(defun c:CBIR nil (ChangeBlockInsertion   t))
 
;;------------------------------------------------------------;;
;;                     Local Functions                        ;;
;;------------------------------------------------------------;;
 
(defun ChangeBlockInsertion
 
  ( retainposition / *error* _StartUndo _EndUndo acblk acdoc blk bn cmd lst mat p1 p2 pt vec )
 
  (defun *error* ( msg )
    (if acdoc (_EndUndo acdoc))
    (if cmd   (setvar 'CMDECHO cmd))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ)
  )
 
  (defun _StartUndo ( doc ) (_EndUndo doc)
    (vla-StartUndoMark doc)
  )
 
  (defun _EndUndo ( doc )
    (if (= 8 (logand 8 (getvar 'UNDOCTL)))
      (vla-EndUndoMark doc)
    )
  )
 
  (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
        acblk (vla-get-blocks acdoc)
        cmd   (getvar 'CMDECHO)
  )
  (setvar 'CMDECHO 0)
 
  (if
    (and
      (setq blk
        (car
          (LM:Selectif "\nSelect Block: "
           '(lambda ( x ) (eq "INSERT" (cdr (assoc 0 (entget (car x)))))) entsel nil
          )
        )
      )
      (setq pt (getpoint "\nSpecify New Base Point: "))
    )
    (progn
      (_StartUndo acdoc)
 
      (setq lst (entget blk) mat (LM:Ref->Def blk))
      (setq vec
        (mxv (car mat)
          (mapcar '- (trans pt 1 0) (trans (cdr (assoc 10 lst)) blk 0))
        )
      )
      (setq p1 (vlax-3D-point vec)
            p2 (vlax-3D-point '(0. 0. 0.))
      )
      (vlax-for obj (vla-item acblk (setq bn (cdr (assoc 2 lst)))) (vla-Move obj p1 p2))
 
      (if retainposition
        (vlax-for block acblk
          (if (eq :vlax-false (vla-get-isXref block))
            (vlax-for obj block
              (if
                (and
                  (eq "AcDbBlockReference" (vla-get-objectname obj))
                  (eq bn (vla-get-name obj))
                )
                (vla-move obj p2 (vlax-3D-point (mxv (car (LM:Def->Ref (vlax-vla-object->ename obj))) vec)))
              )
            )
          )
        )
      )
      (if (= 1 (cdr (assoc 66 lst)))
        (vl-cmdf "_.attsync" "_N" (cdr (assoc 2 lst)))
      )
      (vla-regen acdoc acAllViewports)
      (_EndUndo acdoc)
    )
  )
  (setvar 'CMDECHO cmd)
  (princ)
)
 
;;---------------=={ Block Ref -> Block Def }==---------------;;
;;                                                            ;;
;;  Returns the Transformation Matrix and Translation Vector  ;;
;;  for transforming Block Reference Geometry to the Block    ;;
;;  Definiton.                                                ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  e - Block Reference Entity                                ;;
;;------------------------------------------------------------;;
;;  Returns:  List of 3x3 Transformation Matrix, Vector       ;;
;;------------------------------------------------------------;;
 
(defun LM:Ref->Def ( e / _dxf a l n )
 
  (defun _dxf ( x l ) (cdr (assoc x l)))
 
  (setq l (entget e) a (- (_dxf 50 l)) n (_dxf 210 l))
  (
    (lambda ( m )
      (list m
        (mapcar '- (_dxf 10 (tblsearch "BLOCK" (_dxf 2 l)))
          (mxv m
            (trans (_dxf 10 l) n 0)
          )
        )
      )
    )
    (mxm
      (list
        (list (/ 1. (_dxf 41 l)) 0. 0.)
        (list 0. (/ 1. (_dxf 42 l)) 0.)
        (list 0. 0. (/ 1. (_dxf 43 l)))
      )
      (mxm
        (list
          (list (cos a) (sin (- a)) 0.)
          (list (sin a) (cos a)     0.)
          (list    0.        0.     1.)
        )
        (mapcar '(lambda ( e ) (trans e n 0 t))
         '(
            (1. 0. 0.)
            (0. 1. 0.)
            (0. 0. 1.)
          )
        )
      )
    )
  )
)
 
;;---------------=={ Block Def -> Block Ref }==---------------;;
;;                                                            ;;
;;  Returns the Transformation Matrix and Translation Vector  ;;
;;  for transforming Block Definition Geometry to a Block     ;;
;;  Reference.                                                ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  e - Block Reference Entity                                ;;
;;------------------------------------------------------------;;
;;  Returns:  List of 3x3 Transformation Matrix, Vector       ;;
;;------------------------------------------------------------;;
 
(defun LM:Def->Ref ( e / _dxf a l n )
 
  (defun _dxf ( x l ) (cdr (assoc x l)))
 
  (setq l (entget e) a (_dxf 50 l) n (_dxf 210 l))
  (
    (lambda ( m )
      (list m
        (mapcar '- (trans (_dxf 10 l) n 0)
          (mxv m
            (_dxf 10 (tblsearch "BLOCK" (_dxf 2 l)))
          )
        )
      )
    )
    (mxm
      (mapcar '(lambda ( e ) (trans e 0 n t))
       '(
          (1. 0. 0.)
          (0. 1. 0.)
          (0. 0. 1.)
        )
      )
      (mxm
        (list
          (list (cos a) (sin (- a)) 0.)
          (list (sin a) (cos a)     0.)
          (list    0.        0.     1.)
        )
        (list
          (list (_dxf 41 l) 0. 0.)
          (list 0. (_dxf 42 l) 0.)
          (list 0. 0. (_dxf 43 l))
        )
      )
    )
  )
)
 
;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Provides continuous selection prompts until either a      ;;
;;  predicate function is validated or a keyword is supplied. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg  - prompt string                                      ;;
;;  pred - optional predicate function [selection list arg]   ;;
;;  func - selection function to invoke                       ;;
;;  keyw - optional initget argument list                     ;;
;;------------------------------------------------------------;;
;;  Returns:  Entity selection list, keyword, or nil          ;;
;;------------------------------------------------------------;;
 
(defun LM:SelectIf ( msg pred func keyw / sel ) (setq pred (eval pred))  
  (while
    (progn (setvar 'ERRNO 0) (if keyw (apply 'initget keyw)) (setq sel (func msg))
      (cond
        ( (= 7 (getvar 'ERRNO))
          (princ "\nMissed, Try again.")
        )
        ( (eq 'STR (type sel))
          nil
        )
        ( (vl-consp sel)
          (if (and pred (not (pred sel)))
            (princ "\nInvalid Object Selected.")
          )
        )
      )
    )
  )
  sel
)
 
;; Matrix x Vector  ~  Vladimir Nesterovsky
(defun mxv ( mat vec )
  (mapcar '(lambda ( row ) (apply '+ (mapcar '* row vec))) mat)
)
 
;; Matrix x Matrix  ~  Vladimir Nesterovsky
(defun mxm ( m q )
  (mapcar (function (lambda ( r ) (mxv (trp q) r))) m)
)
 
;; Matrix Transpose  ~  Doug Wilson
(defun trp ( m )
  (apply 'mapcar (cons 'list m))
)
 
(vl-load-com) (princ)
 
;;------------------------------------------------------------;;
;;                         End of File                        ;;
;;------------------------------------------------------------;;
 


  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#3 hugo75

hugo75

    biết vẽ polygon

  • Members
  • PipPip
  • 72 Bài viết
Điểm đánh giá: -4 (bình thường)

Đã gửi 09 July 2013 - 08:50 AM

Lisp này sử dụng như thế nào vậy bạn?Và gốc của topic này ở đâu vậy bạn?Thanks.


  • 0

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 09 July 2013 - 09:08 AM

Lisp này là hàng ngoại, tôi post lên cho mọi người dùng, ở topic nào thì giờ không nhớ rõ.

Nó có chức năng thay đổi điểm insert của các block, nhưng có 2 cách:

1). Thay đổi vị trí các block nhưng không thay đổi điểm chuẩn của từng block.

2). Thay đổi điểm chuẩn của block.

Lệnh là CBI hoặc CBIR


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.