Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Minh Nghĩa

LISP RẢI BLOCKATT KẾT HỢP ĐÁNH SỐ THỨ TỰ

Các bài được khuyến nghị

Nhờ các Pro giúp em, em muốn lisp vừa rải đối tượng vừa đánh số thứ tự cho BlockAtt, hoặc text

Mong các bác kết hợp giúp em 2 lệnh này thành 1 lệnh

1. lệnh rải đối tượng

(Defun c:RDT (/ ss)
(command "undo" "be")
(chonnhomdoituong)
(choncuver)
(raisoluong)
(command "undo" "end")
  (princ)
)
;;;;;;;;;;;;;;;;;
(Defun chonnhomdoituong ()
  (princ "\nChon doi tuong rai:")
  (setq ss (ssget))

 (cond 
      ((= ss nil) (princ "\nChua chon duoc doi tuong nao:") (chonnhomdoituong))
      ((/= ss nil) 
 (setq dsl (sslength ss))
            (cond 
            ((= dsl 1) 
(setq doituong (ssname SS 0))
(setq doituong (entget doituong))
(setq KIEUDOITUONG (cdr (assoc 0 doituong)))
                   (cond 
                   ((= KIEUDOITUONG "INSERT") (setq dc (cdr (assoc 10 doituong))))
                   ((/= KIEUDOITUONG "INSERT") (setq dc (getpoint "\nChon diem goc: ")))
                   );ketthuccondxemblock
                 );kethucdsl1
            ((/= dsl 1) (setq dc (getpoint "\nChon diem goc: ")))
            );ketthuccondnho

);ketthucsetqdsl
 );ketthuccondtong  
  (princ)
)
;;;;;;;;;;;;;;;;;
(Defun choncuver ()

(setq ddd (entsel "\nChon duong dan:"))
(while
(or
(null ddd)
(or (= "TEXT" (cdr (assoc 0 (entget (car ddd))))) (= "MTEXT" (cdr (assoc 0 (entget (car ddd))))) (= "HATCH" (cdr (assoc 0 (entget (car ddd))))) (= "INSERT" (cdr (assoc 0 (entget (car ddd))))) (= "REGION" (cdr (assoc 0 (entget (car ddd))))) (= "DIMENSION" (cdr (assoc 0 (entget (car ddd)))))
)
)
(setq ddd (entsel "\nDoi tuong khong the lam duong dan! Chon lai"))
)

(setq chondd (car ddd))
(setq luubatdiem (getvar "osmode"))
  (setvar "osmode" 0)
(setq chieudaicuver (vlax-curve-getDistAtParam chondd (vlax-curve-getEndParam chondd)))
(setq diemdau (vlax-curve-getPointAtDist chondd 0))
(setq diemcuoi (vlax-curve-getPointAtDist chondd chieudaicuver))
(setvar "osmode"luubatdiem)
  (princ)
)

(Defun raisoluong ()
(setq slc (getreal "\nChia duong dan thanh may lan:"))
(setq chieudaidoan (/ chieudaicuver slc))
(setq sl (fix (+ 1 slc)))
(thuchienrai)
  (princ)
)

(Defun thuchienrai (/ quaykhong)

  (setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/<Co>")))
(Cond
((= quaykhong "K") (setq copygiua copykoquay))
((/= quaykhong "K")(setq copygiua copyquay))

(setq index -1)

  (repeat sl
(setq index (1+ index))
(setq d2 (* chieudaidoan index))
(setq luubatdiem (getvar "osmode"))
  (setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiua)
  )
  (princ)
)

(defun copycuoiquay()
(setq luubatdiem (getvar "osmode"))
  (setvar "osmode" 0)
(setq d5 (- chieudaicuver 0.001))
(setq p5 (vlax-curve-getPointAtDist chondd d5))
 (setq L 0)
 (setq M (sslength ss))
 (while (< L M)
   (setq DT (ssname ss L))
   (command ".copy" DT "" dc p5)
   (command ".rotate" "last" "" diemcuoi p5)
   (command ".rotate" "last" "" diemcuoi 180)
   (setq L (1+ L))
)
(setvar "osmode"luubatdiem)
(princ)
)

(defun COPYQUAY(/ p3)
(setq luubatdiem (getvar "osmode"))
  (setvar "osmode" 0)
(setq d3 (+ (* chieudaidoan index) 0.001))
(setq p3 (vlax-curve-getPointAtDist chondd d3))
(setvar "osmode"luubatdiem)
(Cond
((= p3 nil) (copycuoiquay))
((/= p3 nil) 
 (setq L 0)
 (setq M (sslength ss))
(setq luubatdiem (getvar "osmode"))
  (setvar "osmode" 0)
 (while (< L M)
   (setq DT (ssname ss L))
   (command ".copy" DT "" dc p2)
   (command ".rotate" "last" "" p2 p3)
   (setq L (1+ L))
)
(setvar "osmode"luubatdiem)
)


(princ)
)

(defun COPYKOQUAY()
(setq luubatdiem (getvar "osmode"))
  (setvar "osmode" 0)
(command ".copy" ss "" dc p2 "")
(setvar "osmode"luubatdiem)
(princ)
)
 

2. lệnh đánh số thứ tự

(defun C:STT( / e e0 dn p1 cn c n p2 dat)
(setq
    e0 (car (entsel "\nSelect attribute block:"))
    e (entnext e0)
)
(if (/= (etype e) "ATTRIB") (progn (alert "Object is not a Attribute Block!") (exit)))
(setq
    dn (getint "\nIncrement <1>: ")
    p1 (getpoint "\nBase point:")
    cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
    c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
    n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
    (command "copy" e0 "" p1 p2)
    (if (= n "") 
        (setq cn (incC cn))
        (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
    )
    (setq
        dat (entget (entnext (entlast)))
        dat (subst (cons 1 cn) (assoc 1 dat) dat)
    )
    (entmod dat)
    (command "regen")
)
(princ)
)

 

Thank you

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×