Đến nội dung


Hình ảnh
- - - - -

Cần Lisp đánh số thứ tự theo dạng Block ATT


  • Please log in to reply
16 replies to this topic

#1 almodeus

almodeus

    biết vẽ arc

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

Đã gửi 13 February 2011 - 10:07 AM

hiện tại mình phải đánh kí hiệu cữa cho bản vẽ, nhưng nhiều quá nên mình nhờ bạn nào đó làm giúp lisp đánh số theo dạng block att được không:
Nghĩa là như sau: mình sẽ tạo ra một block chứa ATT, lấy block đó làm chuẩn....từ block đó mỗi lần mình click tại một vị trí thì ATT nó sẽ dung sai lên theo một giá trị nào đó...gần giống cái lisp đánh CODE cao độ vậy. Vì như vậy mình sẽ chủ động được trong việc tạo kiểu Block. (Như vậy thì chữ hay số sẽ nằm chung một block, chứ đánh theo Tcount hay lisp đánh số thì mất công block lại)Hình đã gửi
  • 1

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 13 February 2011 - 10:46 AM

Bạn đã search chưa ??
Bạn dùng thử lisp của bác ssg viết cách đây...3 năm

;; free lisp from cadviet.com

;;;**********************************************
;;;CHUONG TRINH DANH SO THU TU VA COPY TANG DAN
;;;1. Lenh OD: danh so thu tu, tuy chon so bat dau (begin) va so gia (increment) tuy y
;;;2. Lenh OC: copy tang dan tu mot so thu tu co san
;;;3. Lenh oCA: copy tang dan voi doi tuong Attribute Block
;;;Chuong trinh chap nhan cac dinh dang bang so, chu, so va chu ket hop:
;;;1, 2... A, B..., A1, A2..., AB-01, AB-02..., AB-01-C1, AB-01-C2...
;;;Cac chu gioi han trong khoang tu A den Z. Cac so khong han che
;;;Copyright by ssg - www.cadviet.com - December 2008
;;;**********************************************


;;;-------------------------------------------------
(defun etype (e) ;;;Entity Type
(cdr (assoc 0 (entget e)))
)
;;;-------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
(list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------
(defun incN (n dn / n2 i n1) ;;;Increase number n
(setq
n2 (itoa (+ dn (atoi n)))
i (- (strlen n) (strlen n2))
)
(if (> i 0) (setq n1 (substr n 1 i)) (setq n1 ""))
(strcat n1 n2)
)
;;;-------------------------------------------------
(defun incC (c / i c1 c2) ;;;Increase character c
(setq
i (strlen c)
c1 (substr c 1 (- i 1))
c2 (chr (1+ (ascii (substr c i 1))))
)
(if (or (= c2 "{") (= c2 "["))
(progn (command "erase" (entlast) "") (alert "Over character!") (exit))
(strcat c1 c2)
)
)
;;;============================
(defun C:OD( / cn dn c n p) ;;;Make OrDinal number with any format
(setq
cn (getstring "\nBegin at <1>: " T)
dn (getint "\nIncrement <1>: ")
)
(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))
(setq n (vl-string-subst "" c cn))
(if (/= n "") (setq mode 1) (setq mode 0))
(while (setq p (getpoint "\nBase point <exit>: "))
(wtxt cn p)
(if (= n "")
(setq cn (incC cn))
(setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))
)
)
(princ)
)
;;;============================
(defun C:OC( / e dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from template
(setq
e (car (entsel "\nSelect template text:"))
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" e "" p1 p2)
(if (= n "")
(setq cn (incC cn))
(setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))
)
(setq
dat (entget (entlast))
dat (subst (cons 1 cn) (assoc 1 dat) dat)
)
(entmod dat)
)
(princ)
)
;;;============================
(defun C:oCA( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(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)
)
;;;============================


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 almodeus

almodeus

    biết vẽ arc

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

Đã gửi 13 February 2011 - 11:20 AM

quá hay chỉ có điều làm sao mình định dạng được hight cho text vậy bạn
  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 13 February 2011 - 11:57 AM

quá hay chỉ có điều làm sao mình định dạng được hight cho text vậy bạn

Nếu bạn dùng thử thì sẽ thấy nó lấy theo đối tượng bạn copy, tức là Text ban đầu bạn định dạng ntn thì các text tiếp theo nó như thế vậy
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#5 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 13 February 2011 - 12:40 PM

hiện tại mình phải đánh kí hiệu cữa cho bản vẽ, nhưng nhiều quá nên mình nhờ bạn nào đó làm giúp lisp đánh số theo dạng block att được không:
Nghĩa là như sau: mình sẽ tạo ra một block chứa ATT, lấy block đó làm chuẩn....từ block đó mỗi lần mình click tại một vị trí thì ATT nó sẽ dung sai lên theo một giá trị nào đó...gần giống cái lisp đánh CODE cao độ vậy. Vì như vậy mình sẽ chủ động được trong việc tạo kiểu Block. (Như vậy thì chữ hay số sẽ nằm chung một block, chứ đánh theo Tcount hay lisp đánh số thì mất công block lại)Hình đã gửi

Cái này bạn chỉ cần tạo block att ban đầu xong dùng lisp copy tăng dưới đây

(defun C:CC( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(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 "\ngia tri tang hoac giam <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 : "))
(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)
)

BS: Chết cha! Đụng hàng rồi.... Xin lỗi nha.
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#6 almodeus

almodeus

    biết vẽ arc

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

Đã gửi 13 February 2011 - 01:37 PM

lisp của Kext bi lỗi ở cái lệnh OC rồi, nó không gia số mà thêm vào thành 1~, 1[], 1f tùm lùm hết...với số ban đầu của mình là 1 gia số là 1
  • 0

#7 almodeus

almodeus

    biết vẽ arc

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

Đã gửi 13 February 2011 - 01:39 PM

sax, giờ thì lại được, lúc thì lại bị cái lỗi như mình nói...ko biết sao nữa
  • 0

#8 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 13 February 2011 - 08:25 PM

Bạn chú ý đọc các dòng trong file lisp nhé. Lisp của bác ssg viết, mình dùng thử k thấy có vấn đề gì cả.
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#9 risusu

risusu

    biết vẽ circle

  • Members
  • PipPip
  • 34 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 09 October 2011 - 07:50 PM

Bác ssg mà thêm chức năng cộng thêm số thập phân nữa thì tuyệt nhỉ. VD: AD-15.00 cộng 1.20 thành AD-16.20
  • 0
^_^0905-0988.782004^_^

#10 phongtran86

phongtran86

    biết lệnh offset

  • Members
  • PipPipPip
  • 177 Bài viết
Điểm đánh giá: 22 (tàm tạm)

Đã gửi 16 May 2013 - 12:48 PM

lisp hay quá. Nhưng cái lệnh OC còn 1 nhược điểm là chỉ chọn text dc thôi. Mình muốn có thể vừa chọn cả các đối tượng khác+text nữa mà text vẫnnhảy, đối tượng kia đi nguyên. Trên diễn đàn có lisp đó rồi nhưng lại chỉ nhảy <100 số thôi từ 99 nhảy thành 0. Hì


  • 0

#11 cuthanhvuong

cuthanhvuong

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 16 May 2013 - 04:50 PM

lisp hay lắm cám ơn bạn nhiều 


  • 0

bố thường nói những điều con chưa hiểu 

mẹ thường hiểu những điều con chưa nói :) 


#12 cuthanhvuong

cuthanhvuong

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 16 May 2013 - 04:56 PM

Bạn đã search chưa ??
Bạn dùng thử lisp của bác ssg viết cách đây...3 năm
 

;; free lisp from cadviet.com

;;;**********************************************
;;;CHUONG TRINH DANH SO THU TU VA COPY TANG DAN
;;;1. Lenh OD: danh so thu tu, tuy chon so bat dau (begin) va so gia (increment) tuy y
;;;2. Lenh OC: copy tang dan tu mot so thu tu co san
;;;3. Lenh oCA: copy tang dan voi doi tuong Attribute Block
;;;Chuong trinh chap nhan cac dinh dang bang so, chu, so va chu ket hop:
;;;1, 2... A, B..., A1, A2..., AB-01, AB-02..., AB-01-C1, AB-01-C2...
;;;Cac chu gioi han trong khoang tu A den Z. Cac so khong han che
;;;Copyright by ssg - www.cadviet.com - December 2008
;;;**********************************************


;;;-------------------------------------------------
(defun etype (e) ;;;Entity Type
(cdr (assoc 0 (entget e)))
)
;;;-------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
    sty (getvar "textstyle")
    d (tblsearch "style" sty)
    h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
    (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------
(defun incN (n dn / n2 i n1) ;;;Increase number n
(setq
    n2 (itoa (+ dn (atoi n)))
    i (- (strlen n) (strlen n2))
)
(if (> i 0) (setq n1 (substr n 1 i)) (setq n1 ""))
(strcat n1 n2)
)
;;;-------------------------------------------------
(defun incC (c / i c1 c2) ;;;Increase character c
(setq
    i (strlen c)
    c1 (substr c 1 (- i 1))
    c2 (chr (1+ (ascii (substr c i 1))))
)
(if (or (= c2 "{") (= c2 "["))
    (progn (command "erase" (entlast) "") (alert "Over character!") (exit))
    (strcat c1 c2)
)
)
;;;============================
(defun C:OD( / cn dn c n p) ;;;Make OrDinal number with any format
(setq
    cn (getstring "\nBegin at <1>: " T)
    dn (getint "\nIncrement <1>: ")
)
(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))
(setq n (vl-string-subst "" c cn))
(if (/= n "") (setq mode 1) (setq mode 0))
(while (setq p (getpoint "\nBase point <exit>: "))
    (wtxt cn p)
    (if (= n "") 
        (setq cn (incC cn))
        (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
    )
)
(princ)
)
;;;============================
(defun C:OC( / e dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from template
(setq
    e (car (entsel "\nSelect template text:"))
    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" e "" p1 p2)
    (if (= n "") 
        (setq cn (incC cn))
        (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
    )
    (setq
        dat (entget (entlast))
        dat (subst (cons 1 cn) (assoc 1 dat) dat)
    )
    (entmod dat)    
)
(princ)
)
;;;============================
(defun C:oCA( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(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)
)
;;;============================

À MÌNH ĐÃ BIẾT CÁCH SỬ DỤNG LỆNH OC VÀ OD NHƯNG CÁI OCA THÌ LẠI KHÔNG BIẾT ỨNG DỤNG ĐỂ LÀM GÌ BẠN CÓ THỂ CHO MÌNH BIẾT ĐƯỢC KHÔNG? CÁM ƠN BẠN VÌ BÀI VIẾT


  • 0

bố thường nói những điều con chưa hiểu 

mẹ thường hiểu những điều con chưa nói :) 


#13 colombus

colombus

    biết vẽ ellipse

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

Đã gửi 05 July 2013 - 10:15 AM

cái lisp oc_oca này thì rất hay....

nhưng mà cái này chỉ áp dụng cho 1 text được chọn . không áp dụng chọn nhiều text cùng lúc.

 

chẳng hạn tôi có 1 dãy 8 text 1 2 3 4 5 6 7 8 copy với gia số là 8

thì sẽ được 9 10 11 12 13 15 16 __ 17 18 19 20 21 22 23 24 _ ...........

 

rất mong các bác bổ sung tính năng này. cảm ơn cadviet


  • 0

#14 duynhan1611

duynhan1611

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 22 July 2013 - 11:39 AM

hay quá. Thanks mấy bác


  • 0

#15 hsbc

hsbc

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 16 November 2013 - 04:30 PM

Bạn đã search chưa ??
Bạn dùng thử lisp của bác ssg viết cách đây...3 năm

Mình dùng lisp này vẫn tốt nhưng hôm nay dùng lệnh OC, muốn hệ số tăng là 3.5 lại không được. Lisp không cho dùng số thập phân, nhờ các bác chỉnh cho em với ạ,


  • 0

#16 lohado

lohado

    biết lệnh erase

  • Members
  • PipPipPip
  • 101 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 05 November 2015 - 11:40 AM

mọi người cho mình hỏi chút.giờ muốn đánh số block bên trong 1 block khác thì làm thế nào ạ.VD như file cad mình up lên,muốn đánh số thành 2F-01=>2F-02,2F-03,2F-04......http://www.cadviet.c...06_drawing3.dwg :mellow:


  • 0

    146106_untitled444_2.png


#17 nghau90

nghau90

    biết vẽ circle

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

Đã gửi 18 April 2016 - 02:30 PM

xin hỏi em dùng cho cad 2015 không được


  • 0