Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#2461 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 02 November 2010 - 10:42 AM

@Tue_NV: lisp trên chạy chưa đúng khi các text trong cùng 1 hàng (cột) khác nhau.
File vd minh họa:
http://www.mediafire...?t6baa4ex788567
  • 0

#2462 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 02 November 2010 - 12:18 PM

Mình gửi lại link file trên :)
http://www.mediafire...o16ukd7xm803l8x
  • 0

#2463 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 02 November 2010 - 02:29 PM

Mình gửi lại link file trên :)
http://www.mediafire...o16ukd7xm803l8x

Bạn thử lại nhé :


(defun c:cs(/ ss sx lis1 lis2 n i nn mm li li1)
;Copy right by Tue_NV
(vl-load-com)
(setq ss (ssget '((0 . "TEXT"))))
(setq sx (ssget '((0 . "TEXT"))))
(setq lis1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq lis2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex sx))))
(setq lis1 (vl-sort lis1 '(lambda (x y)
(if (equal (cadr (assoc 10 (entget x)))
               (cadr (assoc 10 (entget y)))
             (cdr (assoc 40 (entget x))) )
            (< (caddr (assoc 10 (entget x)))
               (caddr (assoc 10 (entget y)))
            )
(< (cadr (assoc 10 (entget x)))
               (cadr (assoc 10 (entget y)))
            )
             )
        ))
)
(setq lis2 (vl-sort lis2 '(lambda (x y)
(if (equal (cadr (assoc 10 (entget x)))
               (cadr (assoc 10 (entget y)))
             (cdr (assoc 40 (entget x))) )
            (< (caddr (assoc 10 (entget x)))
               (caddr (assoc 10 (entget y)))
            )
(< (cadr (assoc 10 (entget x)))
               (cadr (assoc 10 (entget y)))
            )
             )
        ))
)    
(setq n (sslength ss) i 0)

(if (= (length lis1) (length lis2))
(progn
   (while (< i (length lis1))

    (setq nn (entget (nth i lis1)))
    (setq mm (entget (nth i lis2)))

    (setq li (cdr (assoc 1 nn)))

    (setq li1 (cdr (assoc 1 mm)))


    (setq nn (subst (cons 1 li1) (assoc 1 nn) nn))
    (setq mm (subst (cons 1 li) (assoc 1 mm) mm))

    (entmod mm)
    (entmod nn)
    (setq i (+ i 1))

)
)
(alert "\n Hai chuoi khong bang nhau. Lisp khong thuc hien duoc")
)

(princ)

)

  • 1

#2464 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 02 November 2010 - 02:57 PM

Mình gửi lại link file trên :D
http://www.mediafire...o16ukd7xm803l8x

Chào bạn hdt4151,
Gửi bạn cái này coi thử có Ok không nhé.

(defun c:cntxt (/ a b el1 el2 ssl ss1 ss2 els1 els els2)
(setq a (car (entsel "\n Chon text thu nhat"))
b (car (entsel "\n Chon text thu hai"))
el1 (entget a )
el2 (entget b )
ssl (acet-ss-to-list (ssget "x" (list (cons 0 "text") )))
ss1 (list)
ss2 (list)
)
(foreach x ssl
(if (equal (cadr (assoc 10 (entget x))) (cadr (assoc 10 el1)) 0.001)
(setq ss1 (append ss1(list x)))
)
(if (equal (cadr (assoc 10 (entget x))) (cadr (assoc 10 el2)) 0.001)
(setq ss2 (append ss2 (list x)))
)
)
;;;;(setq ss1 (vl-sort ss1 '(lambda (x y) (< (caddr (assoc 10 (entget x))) (caddr (assoc 10 (entget y))))))
;;;;ss2 (vl-sort ss2 '(lambda (x y) (< (caddr (assoc 10 (entget x))) (caddr (assoc 10 (entget y))))))
;;;:)
(foreach c ss1
(setq els1 (entget c)
p (cdr (assoc 10 els1))
)
(foreach d ss2
(setq els2 (entget d))
(if ( equal (caddr (assoc 10 els2)) (caddr (assoc 10 els1)) 0.001)
(progn
(setq els1 (subst (cons 10 (cdr (assoc 10 els2))) (assoc 10 els1) els1)
els2 (subst (cons 10 p) (assoc 10 els2) els2)
)
(entmod els1)
(entmod els2)
)
)
)
)
)

Bạn có thể dựa vào đây để có lisp đổi text theo hàng.
Chú ý là lisp này không yêu cầu số text trong các cột phải bằng nhau, song chỉ có các text trong cột có text cùng tọa độ y ở cột còn lại mới được đổi chỗ mà thôi. Nếu text nào không có text tương ứng ở cột kia sẽ được giữ nguyên giá trị.
Hề hề hề....
Chúc bạn vui.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2465 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 02 November 2010 - 05:59 PM

Thanks 2 bạn Tue_NV và phamthanhbinh nhiều nhé, lisp chạy rất tốt :)
  • 0

#2466 bachngoctung

bachngoctung

    biết lệnh copy

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

Đã gửi 02 November 2010 - 09:06 PM

- Cám ơn Tu nhé mình đã thử lisp bạn mới chỉnh giúp mình , nhưng thấy chưa được thỏa mãn, chắc là do mình diễn tả chưa rõ . Mình up file ảnh lên cho bạn tiện xem:
Hình đã gửi
+ Một là kết quả sau khi sử dụng lisp thì mũi tên chưa có Tu à , đồng thời block sau khi chèn ra nó lại tự đảo ngược vị trí của diện tích và chiều dài
- Tu xem khắc phục giúp mình nhé. Mình cũng up luôn cả file cad lên http://www.cadviet.c...advietcom_4.dwg

-Bạn phamngoctukts xem giúp mình lisp của bài này nhé http://www.cadviet.c...&...st&p=115000
- Cám ơn nhiều :)
  • 0

#2467 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 03 November 2010 - 02:09 PM

-Bạn phamngoctukts xem giúp mình lisp của bài này nhé http://www.cadviet.c...&...st&p=115000
- Cám ơn nhiều :)

Chào bạn bachngoctung!
Mấy hôm vưa rồi bận quá mình sửa cho bạn đây.

;; free lisp from cadviet.com

(defun c:dtcd ()
(vl-load-com)
(setq dth (car (entsel "\nChon vung can tinh dien tich"))
ll (entsel "\nChon pline can tinh chieu dai")
pl (car ll)
ob1 (vlax-ename->vla-object dth)
ob2 (vlax-ename->vla-object pl)
dientich (vla-get-area ob1)
chieudai (vla-get-length ob2)
pblock (getpoint "\nChon diem chen block")
oldos (getvar "osmode")
)
(setvar "osmode" 0)
(if (= (cdr (assoc 0 (entget pl))) "LINE")
(setq ang (/ (* (vla-get-angle ob2) 180) pi))
(progn
(setq lis (acet-geom-vertex-list pl))
(setq ang (/ (* (angle (car (reverse lis)) (cadr (reverse lis))) 180) pi))
)
)
(if (> ang 90) (setq ang (+ ang 180)))
(vl-cmdf "insert" "BG" pblock "" "" ang (rtos dientich 2 2) (rtos chieudai 2 2))
(setq pp (polar pblock (/ (* ang pi) 180) 7.7636))
(vl-cmdf "move" (entlast) "" pblock pp)
(command "qleader" (car (cdr ll)) pblock \e)
(setvar "osmode" oldos)
)

  • 0
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!

#2468 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 03 November 2010 - 03:06 PM

Khi đã tạo được Table rồi thì xuất qua Excel chỉ là chuyện nhỏ.
Tue_NV mạn phép anh gia_bach bổ sung thêm vào tính năng thêm data vào bảng TABLE đã có :
Bạn thangbkpro test thử nhé :


(defun c:tkt(/ ent h height i len0 lst msp pt row ss str str0 str_len tblobj width0 width1); thong ke text
;; By : Gia Bach, Copyrightゥ December 2010;;
;; Contact : gia_bach @ www.CadViet.com;;
(defun TxtWidth (val msp / txt minp maxp)
(vla-getBoundingBox (setq txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) 1)) 'minp 'maxp)
(vla-Erase txt)
(-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp))) )
;main
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0)
(progn
(vl-load-com)
(princ "\nChon cac Text de thong ke :")
(if (setq ss (ssget(list (cons 0 "TEXT"))))
(progn
(setq i -1 len0 8)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq str(cdr(assoc 1 (entget ent ))))
(if (> (setq str_len (strlen str)) len0)
(setq str0 str len0 str_len) )
(if (not (assoc str lst))
(setq lst (cons (cons str 1) lst))
(setq lst (subst (cons str (1+ (cdr (assoc str lst))))
(assoc str lst) lst))) )
(setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(or *h* (setq *h* 175))
(initget 6)
(setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))
(if h (setq *h* h) (setq h *h*) )
(setq width0 (* 3 h(TxtWidth "STT" msp))
height (* 2 h))
(if str0
(setq width1 (* 1.2 h(TxtWidth (strcase str0) msp)))
(setq width1 (* 2 h(TxtWidth "Gia tri" msp))))
(if (> h 3)
(setq width0 (* (fix (/ width0 10))10)
width1 (* (fix (/ width1 10))10)
height (* (fix (/ height 5))5)))
(initget "T TH")
(setq ans (getkword "Ban Tao bang moi hay THem du lieu vao bang da co :"))
(IF (= ans "T") (PROGN
(setq pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 3 height width1))
(vla-put-regeneratetablesuppressed TblObj :vlax-true)
(vla-put-vertcellmargin TblObj (* 0.25 h))
(vla-put-horzcellmargin TblObj (* 0.75 h))
(vla-SetColumnWidth TblObj 0 width0)
(vla-SetColumnWidth TblObj 2 (* 2 h(TxtWidth "So luong" msp)))
(mapcar '(lambda (x)(vla-setTextHeight TblObj x h))
(list acTitleRow acHeaderRow acDataRow) )
(mapcar '(lambda (x)(vla-setAlignment TblObj x 8))
(list acTitleRow acHeaderRow acDataRow))
(vl-catch-all-error-p (vl-catch-all-apply (function(lambda () (vla-MergeCells TblObj 0 0 0 2)) )))
(vla-setText TblObj 0 0 "Bang thong ke")
(vla-setText TblObj 1 0 "STT")
(vla-setText TblObj 1 1 "Gia tri")
(vla-setText TblObj 1 2 "So luong")
(setq i 1 row 2 )
)
(PROGN
(setq tblobj (vlax-ename->vla-object (car(entsel "\n Chon bang can them du lieu vao :"))))
(setq row (1+ (vla-get-rows Tblobj)) i (- row 2))
(vla-insertrows Tblobj (1- row) h (1+ (length lst)))
)
)
(foreach e lst
(vla-setText TblObj row 0 (itoa i))
(vla-setText TblObj row 1 (car e))
(vla-setText TblObj row 2 (cdr e))
(vla-SetCellAlignment TblObj row 1 7)
(vla-SetCellAlignment TblObj row 2 9)
(setq row (1+ row) i (1+ i)) )
(vla-put-regeneratetablesuppressed TblObj :vlax-false)
(vlax-release-object TblObj) )
(alert "Khong chon duoc Text.") )
(princ) )
(alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)") ) )

Chức năng DownLoad của Diễn đàn có thể bị lỗi. Bạn có thể chạy với file này :
http://www.cadviet.c...files/3/tkt.lsp

Cám ơn bác Tue và bác gia_bach.Bây giờ từ lisp này,mong các bác có thể giúp em :
- Vẫn lisp này nhưng bỏ cột STT đi.
- 1 lisp mới có chức năng tương tự nhưng chuyển theo dạng hàng ngang như sau(c:tktn)
Hình đã gửi

- Với các lisp này,liệu có thể thay việc tạo table bằng việc kẻ pl như phiên bản TKT đầu tiên bác gia_bach viết k (phiên bản thứ 2 do yêu cầu sắp xếp text,e thấy bác ấy đã chuyển sang tạo table) ? vì vấn đề thao tác sửa Title trong table với e còn rườm rà quá (rườm rà hơn sửa trực tiếp dtext :) )
  • 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


#2469 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 03 November 2010 - 04:29 PM

Cám ơn bác Tue và bác gia_bach.Bây giờ từ lisp này,mong các bác có thể giúp em :
- Vẫn lisp này nhưng bỏ cột STT đi.
- 1 lisp mới có chức năng tương tự nhưng chuyển theo dạng hàng ngang như sau(c:tktn)
Hình đã gửi

- Với các lisp này,liệu có thể thay việc tạo table bằng việc kẻ pl như phiên bản TKT đầu tiên bác gia_bach viết k (phiên bản thứ 2 do yêu cầu sắp xếp text,e thấy bác ấy đã chuyển sang tạo table) ? vì vấn đề thao tác sửa Title trong table với e còn rườm rà quá (rườm rà hơn sửa trực tiếp dtext :) )

Liệu có thể thay việc tạo table bằng việc kẻ pl
-> Tại sao không tận dụng các tính năng mới của CAD?

Bạn thử lisp mới có chức năng tương tự nhưng chuyển theo dạng hàng ngang
(defun c:tkt(/ ent h height i len0 lst msp pt ss str str0 str_len tblobj width0 width1); thong ke text
;; By : Gia Bach, Copyrightゥ December 2010 ;;
;; Contact : gia_bach @ www.CadViet.com ;;
(defun TxtWidth (val msp / txt minp maxp)
(vla-getBoundingBox (setq txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) 1)) 'minp 'maxp)
(vla-Erase txt)
(-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp))) )
(defun NormalizeNumberInString (str / ch i pat ret count buf);(NormalizeNumberInString "08-01-2009")
(setq i 0
pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
ret ""
count 4 )
(while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
(if (vl-position ch pat)
(progn
(setq buf ch)
(while (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
(setq buf (strcat buf ch)))
(while (< (strlen buf) count) (setq buf (strcat "0" buf)))
(setq ret (strcat ret buf))) )
(setq ret (strcat ret ch)) )
ret)
;main
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0)
(progn
(vl-load-com)
(princ "\nChon cac Text de thong ke :")
(if (setq ss (ssget(list (cons 0 "TEXT"))))
(progn
(setq i -1 len0 4)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq str(cdr(assoc 1 (entget ent ))))
(if (> (setq str_len (strlen str)) len0)
(setq str0 str len0 str_len) )
(if (not (assoc str lst))
(setq lst (cons (cons str 1) lst))
(setq lst (subst (cons str (1+ (cdr (assoc str lst))))
(assoc str lst) lst))) )
(setq lst (vl-sort lst '(lambda (x y) (< (NormalizeNumberInString(car x))
(NormalizeNumberInString(car y))) ) )
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(or *h* (setq *h* 175))
(initget 6)
(setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))
(if h (setq *h* h) (setq h *h*) )
(setq width0 (* 3 h(TxtWidth "CK" msp))
height (* 2 h))
(if str0
(setq width1 (* 1.2 h(TxtWidth (strcase str0) msp)))
(setq width1 (* 2 h(TxtWidth "Text" msp))))
(if (> h 3)
(setq width0 (* (fix (/ width0 10))10)
width1 (* (fix (/ width1 10))10)
height (* (fix (/ height 5))5)))
(setq pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable msp (vlax-3d-point pt) 3(+ (length lst) 1) height width1))
(vla-put-regeneratetablesuppressed TblObj :vlax-true)
(vla-put-TitleSuppressed TblObj :vlax-true)
(vla-DeleteRows TblObj 0 1)
(vla-put-vertcellmargin TblObj (* 0.25 h))
(vla-put-horzcellmargin TblObj (* 0.75 h))
(vla-SetColumnWidth TblObj 0 width0)
(vla-setTextHeight TblObj acDataRow h)
(vla-setAlignment TblObj acDataRow 8)
(vla-setText TblObj 0 0 "CK")
(vla-setText TblObj 1 0 "SL")
(setq i 1)
(foreach e lst
(vla-setText TblObj 0 i (car e))
(vla-setText TblObj 1 i (cdr e))
(setq i (1+ i)) )
(vla-put-regeneratetablesuppressed TblObj :vlax-false)
(vlax-release-object TblObj) )
(alert "Khong chon duoc Text.") )
(princ) )
(alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)") ) )

  • 2

#2470 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 03 November 2010 - 04:53 PM

Diễn đàn đang lỗi nên e chưa lấy code về nghiền được,e cứ thanks bác trước rồi tí vướng ở đâu e xin phép hỏi lại sau.Còn vấn đề table và dtext thì sự thể là e dùng TCVN3,trước khi chạy lisp thì e phải tạo table style trước nên đâm ra cứ thế nào ý.hay các bác chỉ cho e xin các sysvar hoặc hàm thiết lập table style với :"> E tìm chưa thấy ạ.
Rồi mỗi khi muốn sửa 1 chữ trong đấy,thì kích đúp nó hiện bảng edit text rườm rà quá ^^.Hơn nữa,như trong hình em post ý ạ,các đường cell có layer,độ dày nét in,màu mè khác text bên trong.Nếu tạo table rồi thì tấ cả giống nhau hết,e không biết cách khắc phục đâm ra mới mong nó quay về cổ điển.

PS : ý,sau khi post xong thì e cũng down về được xong,code chạy rất mượt bạc ạ ^^
Nh­ưng e có 1 số thắc mắc sau :
- Text được tạo trước khi kẻ table hay sao ạ ? Mà mình quy định text height ở trong tabstyle rồi mà nó vẫn có thể kẻ bảng theo giá trị nhập vào ^^.Hay là khi tạo table thì nó thay đổi giá trị textheight trong tablestyle ?
- Các text không nằm giữa cell mặc dù mình đã thiết lập Midle Center.
Hình đã gửi
- Nếu text tầm 2 từ (dầm móng),thì cell bị đẩy xuống,nhận thấy rõ là text không nằm đúng giữa cell.Có cách nào khắc phục được không ạ?hay Cad thiết đặt thế?
Hình đã gửi
- Nếu text dài hẳn ra (dầm móng băng) thì nó lại không bị đẩy xuống nữa,mà nằm thẳng hàng.Em mong muốn lúc nào nó cũng như thế này được không ạ?
Hình đã gửi
Đây cũng là 1 số lý do nữa mà e "chưa" ưa table :)
  • 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


#2471 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 04 November 2010 - 09:27 AM

Diễn đàn đang lỗi nên e chưa lấy code về nghiền được,e cứ thanks bác trước rồi tí vướng ở đâu e xin phép hỏi lại sau.Còn vấn đề table và dtext thì sự thể là e dùng TCVN3,trước khi chạy lisp thì e phải tạo table style trước nên đâm ra cứ thế nào ý.hay các bác chỉ cho e xin các sysvar hoặc hàm thiết lập table style với :"> E tìm chưa thấy ạ.
Rồi mỗi khi muốn sửa 1 chữ trong đấy,thì kích đúp nó hiện bảng edit text rườm rà quá ^^.Hơn nữa,như trong hình em post ý ạ,các đường cell có layer,độ dày nét in,màu mè khác text bên trong.Nếu tạo table rồi thì tấ cả giống nhau hết,e không biết cách khắc phục đâm ra mới mong nó quay về cổ điển.

PS : ý,sau khi post xong thì e cũng down về được xong,code chạy rất mượt bạc ạ ^^
Nh­ưng e có 1 số thắc mắc sau :
- Text được tạo trước khi kẻ table hay sao ạ ? Mà mình quy định text height ở trong tabstyle rồi mà nó vẫn có thể kẻ bảng theo giá trị nhập vào ^^.Hay là khi tạo table thì nó thay đổi giá trị textheight trong tablestyle ?
- Các text không nằm giữa cell mặc dù mình đã thiết lập Midle Center.
Hình đã gửi
- Nếu text tầm 2 từ (dầm móng),thì cell bị đẩy xuống,nhận thấy rõ là text không nằm đúng giữa cell.Có cách nào khắc phục được không ạ?hay Cad thiết đặt thế?
Hình đã gửi
- Nếu text dài hẳn ra (dầm móng băng) thì nó lại không bị đẩy xuống nữa,mà nằm thẳng hàng.Em mong muốn lúc nào nó cũng như thế này được không ạ?
Hình đã gửi
Đây cũng là 1 số lý do nữa mà e "chưa" ưa table :)

Chào ketxu
Một cách tổng quát, mức độ hổ trợ tiếng Việt của LISP chưa đầy đủ, ví thế (như bạn đã gặp) đôi khi các cell bị đẩy xuống thành 2 dòng. <_<

về các thắc mắc khác, bạn xem code từ đọan :
(setq pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable msp (vlax-3d-point pt) 3(+ (length lst) 1) height width1))

... đến
(vlax-release-object TblObj)

các hàm cần quan tâm :
- vla-addtable: tạo đối tượng bảng
- vla-put-vertcellmargin hay vla-put-horzcellmargin : căn lề cho các Cell
- vla-setTextHeight: thiết lập chiều cao Text
- vla-setAlignment: thiết lập căn lề cho Text trong Cell
- vla-setText: gán giá trị cho 1 Cell

Để các text nằm giữa cell (phuơng đứng) thay đổi các tham số trong hàm vla-put-vertcellmargin.

Bạn tham khảo Video hướng dẫn thao tác với đối tượng bảng
  • 2

#2472 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 04 November 2010 - 10:14 AM

Cám ơn bác đã chỉ dẫn,em sẽ lần mò tiếp ạ ^^
  • 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


#2473 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 04 November 2010 - 11:02 AM

Bạn thử lại nhé :



(defun c:cs(/ ss sx lis1 lis2 n i nn mm li li1)
;Copy right by Tue_NV
(vl-load-com)
(setq ss (ssget '((0 . "TEXT"))))
(setq sx (ssget '((0 . "TEXT"))))
(setq lis1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq lis2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex sx))))
(setq lis1 (vl-sort lis1 '(lambda (x y)
(if (equal (cadr (assoc 10 (entget x)))
               (cadr (assoc 10 (entget y)))
             (cdr (assoc 40 (entget x))) )
            (< (caddr (assoc 10 (entget x)))
               (caddr (assoc 10 (entget y)))
            )
(< (cadr (assoc 10 (entget x)))
               (cadr (assoc 10 (entget y)))
            )
             )
        ))
)
(setq lis2 (vl-sort lis2 '(lambda (x y)
(if (equal (cadr (assoc 10 (entget x)))
               (cadr (assoc 10 (entget y)))
             (cdr (assoc 40 (entget x))) )
            (< (caddr (assoc 10 (entget x)))
               (caddr (assoc 10 (entget y)))
            )
(< (cadr (assoc 10 (entget x)))
               (cadr (assoc 10 (entget y)))
            )
             )
        ))
)    
(setq n (sslength ss) i 0)

(if (= (length lis1) (length lis2))
(progn
   (while (< i (length lis1))

    (setq nn (entget (nth i lis1)))
    (setq mm (entget (nth i lis2)))

    (setq li (cdr (assoc 1 nn)))

    (setq li1 (cdr (assoc 1 mm)))
    (setq nn (subst (cons 1 li1) (assoc 1 nn) nn))
    (setq mm (subst (cons 1 li) (assoc 1 mm) mm))

    (entmod mm)
    (entmod nn)
    (setq i (+ i 1))

)
)
(alert "\n Hai chuoi khong bang nhau. Lisp khong thuc hien duoc")
)

(princ)

)

Lisp này của bác hay thật! Nhưng giờ em muốn không đổi chỗ 2 chuỗi mà copy nguyên giá trị của chuỗi 1 thay vào chuỗi 2thì làm như nào ạ? Em tìm mãi nhưng không biết thay ở chỗ nào. Cám ơn bác !
Thân !
  • 0

#2474 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 04 November 2010 - 11:20 AM

Lisp này của bác hay thật! Nhưng giờ em muốn không đổi chỗ 2 chuỗi mà copy nguyên giá trị của chuỗi 1 thay vào chuỗi 2thì làm như nào ạ? Em tìm mãi nhưng không biết thay ở chỗ nào. Cám ơn bác !
Thân !

NgocSon bỏ 2 dong này đi là được
(setq nn (subst (cons 1 li1) (assoc 1 nn) nn))

(entmod nn)
hoặc là thêm dấu ; trước 2 dòng đó

;(setq nn (subst (cons 1 li1) (assoc 1 nn) nn))
;(entmod nn)

-> Sau dấu ; thì những đoạn Lisp sau nó (trên dòng đó) hoàn toàn không có nghĩa
  • 1

#2475 vailin

vailin

    biết zoom

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

Đã gửi 04 November 2010 - 04:18 PM

Các bạn giúp mình 1 lisp mà khi đánh lênh break ở 2 đầu của 1 đoạn thẳng thì đoạn ở giữa tự chuyển thành nét đứt. Mong các bạn giúp 1 tay. Chân thành cảm ơn !
  • 0

#2476 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 04 November 2010 - 04:22 PM

Các bạn giúp mình 1 lisp mà khi đánh lênh break ở 2 đầu của 1 đoạn thẳng thì đoạn ở giữa tự chuyển thành nét đứt. Mong các bạn giúp 1 tay. Chân thành cảm ơn !

Không hiểu ý của bạn. Bạn nên up file mẫu lên đây. chỉ rõ phần trước và sau khi thực hiện lisp.
  • 0
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!

#2477 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 04 November 2010 - 04:41 PM

Theo e đoán thì ý bạn ấy là có 1 đoạn line dài,giờ kích chọn 2 điểm trên line đó thì đoạn line ở giữa (ạo bới 2 điểm kích) sẽ biến thành nét đứt bá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


#2478 vothanhdn

vothanhdn

    biết vẽ ellipse

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

Đã gửi 04 November 2010 - 05:17 PM

Chào mọi người trên diễn đàn!
Hôm nay e có 1 yêu cầu nhờ mấy cao thủ trên diễn đàn giúp

Tình hình là e nhờ mọi người viết giúp e 1 lisp với yêu cầu như sau:
- Tự động chọn nhiều đối tượng (ssget 1 vùng đối tượng)
- Xét từng đối tượng được chọn, tạo point tại các giao cắt của object. Ví dụ như hình vuông thì có 4 điểm giao cắt, tạo 4 point tại 4 điểm đó, tam giác thì có 3 điểm)
- Lấy cao độ cácpoint vừa mới tạo ra tại các điêm giao cắt đó

Mong mọi người trên diễn đàn viết giúp e
Thanks & regard!!!
  • 0

Ứng dụng hỗ trợ thiết kế mạng lưới thoát nước VTD

  - Tính toán mạng lưới thoát nước

  - Vẽ trắc dọc, bình đồ thoát nước

......

Truy cập http://www.vtdvn.com

------------------------------------------------------------------------------------------

"Không có gì chắc chắn, chỉ có 1 điều chắc chắn là không có gì chắc chắn"...!!!


#2479 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 04 November 2010 - 05:42 PM

Chào mọi người trên diễn đàn!
Hôm nay e có 1 yêu cầu nhờ mấy cao thủ trên diễn đàn giúp

Tình hình là e nhờ mọi người viết giúp e 1 lisp với yêu cầu như sau:
- Tự động chọn nhiều đối tượng (ssget 1 vùng đối tượng)
- Xét từng đối tượng được chọn, tạo point tại các giao cắt của object. Ví dụ như hình vuông thì có 4 điểm giao cắt, tạo 4 point tại 4 điểm đó, tam giác thì có 3 điểm)
- Lấy cao độ cácpoint vừa mới tạo ra tại các điêm giao cắt đó

Mong mọi người trên diễn đàn viết giúp e
Thanks & regard!!!

Bạn Up file cad lên đây thì mọi người dễ giúp bạn hơn đấy.
  • 0

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#2480 ketui

ketui

    biết vẽ arc

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

Đã gửi 04 November 2010 - 07:37 PM

Chào mọi người trên diễn đàn!
Hôm nay e có 1 yêu cầu nhờ mấy cao thủ trên diễn đàn giúp

Tình hình là e nhờ mọi người viết giúp e 1 lisp với yêu cầu như sau:
- Tự động chọn nhiều đối tượng (ssget 1 vùng đối tượng)
- Xét từng đối tượng được chọn, tạo point tại các giao cắt của object. Ví dụ như hình vuông thì có 4 điểm giao cắt, tạo 4 point tại 4 điểm đó, tam giác thì có 3 điểm)
- Lấy cao độ cácpoint vừa mới tạo ra tại các điêm giao cắt đó

Mong mọi người trên diễn đàn viết giúp e
Thanks & regard!!!

Lấy cao độ rồi làm cái gì với nó? Hay lấy chơi cho vui??
  • 0