Đế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

#2561 phongthien

phongthien

    biết vẽ line

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

Đã gửi 16 November 2010 - 10:31 AM

:iluvyousmiley:
Theo như yêu cầu của bạn ấy thì mình nghĩ là chương trình đúng rồi chứ (nếu mình ko hiểu sai ý của bạn ý :D

Trước khi chạy lệnh (bản vẽ ban đầu của bạn ý)
Các text thuộc 1 layer có nội dung liền nhau (tức là 1 đối tượng text)

Hình đã gửi

sau khi chạy lệnh thì tách ra 3 text ở 3 layer khác nhau, có màu khác theo như mẫu của bạn ý
Hình đã gửi

:D Về VBA thì cũng chẳng có tài liệu gì mấy, căn bản mình trước hay làm phần mềm bằng VB mà, nên VBA cũng nhanh quen và cũng có thư viện tích lũy được trong quá trình làm trước đây rồi!

cám ơn anh Phan Thanh Tú Nhiều nhe
đúng ý em rồi đó
nhưng có thể cải thiện thêm 1 chút nữa không anh
vì có nhiều text nằm đứng mà khi chạy lisp thì nó lại nằm ngang
phải dọn lại lần nữa
vì khối lượng bản đồ rất lớn nên mong anh giúp em thêm lần nữa cho nguyện vọng em được trọn vẹn nhe anh.
Cám ơn anh thật nhiều.hihihi
  • 0

#2562 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 16 November 2010 - 10:55 AM

Mình thử tạo block ATT cho một hình tròn mà không được.Mong các bác xem chỉnh sửa giùm.Thanks.
http://www.cadviet.c...les/3/ttttt.lsp

Chào bạn quan08,
Vì sao bạn phải dùng lisp để tạo block thuộc tính mà không dùng CAD??? Nó không những chả nhanh hơn mà có khi còn rối hơn đó....
Việc sử dụng các tham số trong lệnh command bạn nên tìm hiểu kỹ trước khi xài nó vào lisp bạn nhé, Chỉ cần dùng sai trật tự thì lisp sẽ không hiểu đâu bạn ạ. Hãy thận trọng khi xài cái thằng này trong lisp bạn ạ.
Chúc bạn vui.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2563 KS.PhanThanhTu

KS.PhanThanhTu

    biết vẽ point

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

Đã gửi 16 November 2010 - 11:14 AM

cám ơn anh Phan Thanh Tú Nhiều nhe
đúng ý em rồi đó
nhưng có thể cải thiện thêm 1 chút nữa không anh
vì có nhiều text nằm đứng mà khi chạy lisp thì nó lại nằm ngang
phải dọn lại lần nữa
vì khối lượng bản đồ rất lớn nên mong anh giúp em thêm lần nữa cho nguyện vọng em được trọn vẹn nhe anh.
Cám ơn anh thật nhiều.hihihi


Đây là bản xoay cả text đứng luôn cho bạn

http://www.mediafire...imgsa3rqd5s776f
  • 1
KS Phan Thanh Tú.Email: Vansulich@yahoo.com

#2564 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 16 November 2010 - 11:16 AM

Muc dich cua Em la E vẽ đường đồng mức bằng Pl nhưng bây giờ em muốn đường đồng mức mền mại hơn một chút thôi.

Chào bạn PhamVanThiet108,
Như vậy có nghĩa là bạn muốn tạo một spline dựa trên các đỉnh có sẵn của một polyline ư ??? Hay là cái Spline này được tạo theo cái tùy hứng của bạn ????
Muốn là Spline hay Spl..... gì gì nữa thì CAD cũng yêu cầu bạn phải cung cấp cho nó những tiêu chí nhất định để tạo hình. Vậy tiêu chí của bạn là chi, bạn nên nói rõ ra thì mọi người mới giúp bạn được, bằng không thì bạn phải tùy hứng mà làm theo cái bạn muốn thôi. Hề hề hề...
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2565 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 16 November 2010 - 11:21 AM

Cho em hỏi có lisp nào giúp dãn dòng text với pline ko ah?
Ví dụ em có các pline và các text nằm song song với pline
giờ em thực hiện lisp:
select object:(select cả text và pline)
yêu cầu nhập khoảng cách mới (khoảng cách giữa Text và pline)
kết thúc lệnh
Em đang phân vân ko biết lisp có hiểu text nào gắn với pline nào ko nữa?Có thể chọn text đang nằm gần pline đó nhất được ko mấy anh?
chi tiết xem file CAD em đính kèm dùm em nhé!
http://www.cadviet.c...es/3/test_7.dwg
Xin cảm ơn các anh rất nhiều!
  • 0

#2566 quan08

quan08

    biết vẽ pline

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

Đã gửi 16 November 2010 - 11:33 AM

Chào bạn quan08,
Vì sao bạn phải dùng lisp để tạo block thuộc tính mà không dùng CAD??? Nó không những chả nhanh hơn mà có khi còn rối hơn đó....
Việc sử dụng các tham số trong lệnh command bạn nên tìm hiểu kỹ trước khi xài nó vào lisp bạn nhé, Chỉ cần dùng sai trật tự thì lisp sẽ không hiểu đâu bạn ạ. Hãy thận trọng khi xài cái thằng này trong lisp bạn ạ.
Chúc bạn vui.

Mình đang tìm hiểu về lisp vẽ hình bằng lisp thì mình đã hiểu nhưng vẽ hình bằng lisp rồi viết thêm lệnh để tự động thành Block ATT thì mình chưa biết nên hỏi các bác chỉ giùm trong đoạn lisp dưới đây.Thanks.
http://www.cadviet.c...les/3/ttttt.lsp
  • 0

#2567 phongthien

phongthien

    biết vẽ line

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

Đã gửi 16 November 2010 - 11:53 AM

Đây là bản xoay cả text đứng luôn cho bạn

http://www.mediafire...imgsa3rqd5s776f

cám ơn anh phan thanh tú nhiều nhe.đúng ý em 100% rùi đó
anh nhận em làm đệ tử đi
sau này có diệp sẽ thọ giáo anh trong trang tú đại hiệp hé
thank verry verry......
  • 0

#2568 hatieu

hatieu

    biết vẽ pline

  • Advance Member
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 13 (tàm tạm)

Đã gửi 16 November 2010 - 01:20 PM

Update : Thống kê Block trong bản vẽ.
Fix : tên Block tiếng Việt .
Hình đã gửi

(defun c:BlkQty (/ blk_id blk_len blk_name blks ent h header_lsp height i j
len0 lst_blk msp pt row ss str tblobj width width1 width2 x y)
;; By : Gia Bach, gia_bach @ www.CadViet.com ;;
(defun TxtWidth (val h msp / txt minp maxp)
(setq txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h))
(vla-getBoundingBox txt 'minp 'maxp )
(vla-Erase txt)
(-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp))) )

(defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty)
(setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE") )
(foreach itm (vlax-for itm objTblStyDic
(setq tabLst (append tabLst (list itm))))
(if (not
(vl-catch-all-error-p
(setq name (vl-catch-all-apply 'vla-get-Name (list itm)))))
(setq nameLst (append nameLst (list name))) ) )
(if (not (vl-position tbl_name nameLst))
(vla-addobject objTblStyDic tbl_name "AcDbTableStyle"))
(setq objTblSty (vla-item objTblStyDic tbl_name)
TxtSty (variant-value (vla-getvariable *adoc "TextStyle")))
(mapcar '(lambda (x)(vla-settextstyle objTblSty x TxtSty))
(list acTitleRow acHeaderRow acDataRow) )
(vla-setvariable *adoc "CTableStyle" tbl_name) )

(defun GetObjectID (obj)
(if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
(vlax-invoke-method *util 'GetObjectIdString obj :vlax-false )
(vla-get-Objectid obj)))
;main
(if (setq ss (ssget (list (cons 0 "INSERT"))))
(progn
(vl-load-com)
(setq i -1 len0 8)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq blk_name (cdr (assoc 2 (entget ent))))
(if (> (setq blk_len (strlen blk_name)) len0)
(setq str blk_name len0 blk_len) )
(if (not (assoc blk_name lst_blk))
(setq lst_blk (cons (cons blk_name 1) lst_blk))
(setq lst_blk (subst (cons blk_name (1+ (cdr (assoc blk_name lst_blk))))
(assoc blk_name lst_blk) lst_blk))) )
(setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (car x) (car y)) ) ))
(or *h* (setq *h* (* (getvar "dimtxt")(getvar "dimscale"))))
(initget 6)
(setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))
(if h (setq *h* h) (setq h *h*) )
(or *adoc (setq *adoc (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq msp (vla-get-modelspace *adoc)
*util (vla-get-Utility *adoc)
blks (vla-get-blocks *adoc))
(setq width1 (* 2 (TxtWidth "STT" h msp))
width (* 2 (TxtWidth "So luong" h msp))
height (* 2 h))
(if str
(setq width2 (* 1.5 (TxtWidth (strcase str) h msp)))
(setq width2 width))
(if (> h 3)
(setq width (* (fix (/ width 10))10)
width1 (* (fix (/ width1 10))10)
width2 (* (fix (/ width2 10))10)
height (* (fix (/ height 5))5)))
(GetOrCreateTableStyle "CadViet")
(setq pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width))
(vla-put-regeneratetablesuppressed TblObj :vlax-true)
(vla-SetColumnWidth TblObj 0 width1)
(vla-SetColumnWidth TblObj 1 width2)
(vla-put-vertcellmargin TblObj (* 0.75 h))
(vla-put-horzcellmargin TblObj (* 0.75 h))
(mapcar '(lambda (x)(vla-setTextHeight TblObj x h))
(list acTitleRow acHeaderRow acDataRow) )
(mapcar '(lambda (x)(vla-setAlignment TblObj x 8))
(list acTitleRow acHeaderRow acDataRow))
(vla-MergeCells TblObj 0 0 0 4)
(vla-setText TblObj 0 0 "Bang thong ke")
(setq j -1 header_lsp (list "STT" "Ten" "Don vi" "So luong" "Ky hieu"))
(repeat (length header_lsp)
(vla-setText TblObj 1 (setq j (1+ j)) (nth j header_lsp)))
(setq row 2 i 1)
(foreach pt lst_blk
(setq blk_name (car pt) j -1)
(mapcar '(lambda (x)(vla-setText TblObj row (setq j (1+ j)) x))
(list i blk_name "cai" (cdr pt)))
(vla-SetBlockTableRecordId TblObj row 4 (GetObjectID (vla-item blks blk_name)) :vlax-true)
(vla-SetCellAlignment TblObj row 1 7)
(vla-SetCellAlignment TblObj row 3 9)
(setq row (1+ row) i (1+ i)) )
(vla-put-regeneratetablesuppressed TblObj :vlax-false)
(vlax-release-object TblObj) ) )
(princ))


Mò mãi mà không ra. Bác Gia Bạnh giúp em tạo cái bảng này bằng lisp của bác được không?
Hình đã gửi
Còn đây là file cad của em.
File cad

Các chỗ khác vẫn bình thường duy chỉ có cột W và H là khác. Block của em có tên là W x H.
  • 0
Công ty cổ phần đầu tư và xây dựng AGA
Chuyên tư vấn, cung cấp, thi công hệ vách dựng nhôm kính khổ lớn, cửa nhôm kính,
kính cường lực, vách ngăn, lan can, cầu thang kinh, lam nhôm chăn nắng.
Hot: 0984.985.119

#2569 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 16 November 2010 - 02:11 PM

Mình đang tìm hiểu về lisp vẽ hình bằng lisp thì mình đã hiểu nhưng vẽ hình bằng lisp rồi viết thêm lệnh để tự động thành Block ATT thì mình chưa biết nên hỏi các bác chỉ giùm trong đoạn lisp dưới đây.Thanks.
http://www.cadviet.c...les/3/ttttt.lsp

Chào bạn quan08,
Mình chưa rõ ý bạn muốn hỏi gì vì thựa tế khi xem cái lisp của bạn mình thấy có nhiều chỗ chưa rõ ý đồ của bạn. Cái block ghi thep của bạn đã được tạo ra xong thật tình mình thấy nó chưa được hợp lý lắm.
Do vậy nếu bạn hỏi về cách tạo thì bạn đã làm được rồi, còn biết chỉ cái chi. Còn hỏi về cái block ấy thì đâu có biết bạn muốn nó ra sao mà góp ý.
Hề hề hề,
Hỏi về cấu trúc lisp thì có nhẽ phải hiểu ý định của bạn mới góp ý được. Tất cả ca1cl code bạn viết đều đúng nên lisp mới chạy được, có vài chỗ chưa hợp lý theo thiển ý của mình , song không rõ ý đồ của bạn nên cũng không thể góp ý chi bạn ạ. Chỉ có thể nói chung là bạn nên tham khảo thêm các code đã có trên diễn đàn để chỉnh code của bạn cho nó hợp lý và gọn gàng hơn mà thôi.
Cái chính là bạn đã viết được cái lisp theo đúng ý đồ của bạn là đáng mừng rồi.
Chúc mừng sự thành công của bạn...
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2570 quan08

quan08

    biết vẽ pline

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

Đã gửi 16 November 2010 - 02:56 PM

Chào bạn quan08,
Mình chưa rõ ý bạn muốn hỏi gì vì thựa tế khi xem cái lisp của bạn mình thấy có nhiều chỗ chưa rõ ý đồ của bạn. Cái block ghi thep của bạn đã được tạo ra xong thật tình mình thấy nó chưa được hợp lý lắm.
Do vậy nếu bạn hỏi về cách tạo thì bạn đã làm được rồi, còn biết chỉ cái chi. Còn hỏi về cái block ấy thì đâu có biết bạn muốn nó ra sao mà góp ý.
Hề hề hề,
Hỏi về cấu trúc lisp thì có nhẽ phải hiểu ý định của bạn mới góp ý được. Tất cả ca1cl code bạn viết đều đúng nên lisp mới chạy được, có vài chỗ chưa hợp lý theo thiển ý của mình , song không rõ ý đồ của bạn nên cũng không thể góp ý chi bạn ạ. Chỉ có thể nói chung là bạn nên tham khảo thêm các code đã có trên diễn đàn để chỉnh code của bạn cho nó hợp lý và gọn gàng hơn mà thôi.
Cái chính là bạn đã viết được cái lisp theo đúng ý đồ của bạn là đáng mừng rồi.
Chúc mừng sự thành công của bạn...

Code này chỉ vẽ được hình tròn và số bên trong nhưng đoạn code tạo cho nó thành block ATT vẫn chưa đúng.Mong bác chỉ chỗ sai và sửa lại giùm.Thanks.
  • 0

#2571 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 16 November 2010 - 03:58 PM

Cho em hỏi có lisp nào giúp dãn dòng text với pline ko ah?
Ví dụ em có các pline và các text nằm song song với pline
giờ em thực hiện lisp:
select object:(select cả text và pline)
yêu cầu nhập khoảng cách mới (khoảng cách giữa Text và pline)
kết thúc lệnh
Em đang phân vân ko biết lisp có hiểu text nào gắn với pline nào ko nữa?Có thể chọn text đang nằm gần pline đó nhất được ko mấy anh?
chi tiết xem file CAD em đính kèm dùm em nhé!
http://www.cadviet.c...es/3/test_7.dwg
Xin cảm ơn các anh rất nhiều!

Mấy anh giúp em với!
  • 0

#2572 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 16 November 2010 - 05:53 PM

Mấy anh giúp em với!

Chào bạn Truongthanh,
Bạn dùng thử lisp này coi sao. Do mình mới viết vội nên chưa hoàn chỉnh lắm, bạn dùng thử và cho ý kiến để mình hoàn chỉnh lại.

(defun c:gtxt ()
(vl-load-com)
(setq sst (acet-ss-to-list (ssget (list (cons 0 "text"))))
ssl (acet-ss-to-list (ssget (list (cons 0 "lwpolyline"))))
h (getdist "\n Nhap khoang cach: ")
)
(foreach x sst
(setq els (entget x)
pt (cdr (assoc 11 els))
g (cdr (assoc 50 els))
plst (list)

)
(foreach y ssl
(setq obj (vlax-ename->vla-object y)
p0 (vlax-curve-getclosestpointto obj pt)
dis (distance pt p0)
plst (append plst (list (list p0 dis y)))

)
)
(setq plst (vl-sort plst '(lambda (a b ) (< (cadr a ) (cadr b ))))
p1 ( polar (caar plst) (+ g (/ pi 2)) h)
els (subst (cons 11 p1) (assoc 11 els) els)
)
(entmod els)
)
)

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.

#2573 truongthanh

truongthanh

    biết lệnh text

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

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

Chào bạn Truongthanh,
Bạn dùng thử lisp này coi sao. Do mình mới viết vội nên chưa hoàn chỉnh lắm, bạn dùng thử và cho ý kiến để mình hoàn chỉnh lại.


(defun c:gtxt ()
(vl-load-com)
(setq sst (acet-ss-to-list (ssget (list (cons 0 "text"))))
ssl (acet-ss-to-list (ssget (list (cons 0 "lwpolyline"))))
h (getdist "\n Nhap khoang cach: ")
)
(foreach x sst
(setq els (entget x)
pt (cdr (assoc 11 els))
g (cdr (assoc 50 els))
plst (list)

)
(foreach y ssl
(setq obj (vlax-ename->vla-object y)
p0 (vlax-curve-getclosestpointto obj pt)
dis (distance pt p0)
plst (append plst (list (list p0 dis y)))

)
)
(setq plst (vl-sort plst '(lambda (a b ) (< (cadr a ) (cadr b ))))
p1 ( polar (caar plst) (+ g (/ pi 2)) h)
els (subst (cons 11 p1) (assoc 11 els) els)
)
(entmod els)
)
)

Chúc bạn vui.

Dạ chào anh Bình!Trước tiên em xin cảm ơn anh đã quan tâm đến yêu cầu của em!
Em đã test thử rồi! Lisp đã đúng ý em! Chỉ có vấn đề nhỏ bé tẹo là sau khi thực hiện xong trong dòng command hiện 1 đống text lên ko biết đó là gì vậy anh!
Xin chân thành cảm ơn anh!
  • 0

#2574 quan08

quan08

    biết vẽ pline

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

Đã gửi 16 November 2010 - 06:37 PM

Chào bạn quan08,
Mình chưa rõ ý bạn muốn hỏi gì vì thựa tế khi xem cái lisp của bạn mình thấy có nhiều chỗ chưa rõ ý đồ của bạn. Cái block ghi thep của bạn đã được tạo ra xong thật tình mình thấy nó chưa được hợp lý lắm.
Do vậy nếu bạn hỏi về cách tạo thì bạn đã làm được rồi, còn biết chỉ cái chi. Còn hỏi về cái block ấy thì đâu có biết bạn muốn nó ra sao mà góp ý.
Hề hề hề,
Hỏi về cấu trúc lisp thì có nhẽ phải hiểu ý định của bạn mới góp ý được. Tất cả ca1cl code bạn viết đều đúng nên lisp mới chạy được, có vài chỗ chưa hợp lý theo thiển ý của mình , song không rõ ý đồ của bạn nên cũng không thể góp ý chi bạn ạ. Chỉ có thể nói chung là bạn nên tham khảo thêm các code đã có trên diễn đàn để chỉnh code của bạn cho nó hợp lý và gọn gàng hơn mà thôi.
Cái chính là bạn đã viết được cái lisp theo đúng ý đồ của bạn là đáng mừng rồi.
Chúc mừng sự thành công của bạn...

Lisp vẽ hình tròn và chèn text vào hình tròn e đã hiểu,nhưng ý e là viết thêm dòng code nào để khi chèn text vào hình tròn
thì hình tròn này và text sẽ là block ATT.Mong bác chỉ giúp.Thanks

(defun C:TTT ()
(setq bk (getvar "USERR3"))
(if (= bk 0)
(progn
(setq cont "1")
(setvar "USERR3" 1)
)
(setq cont (rtos bk))
)
(setq pt1 (getpoint "\n Nhap diem dat:"))
(command "layer" "m" "S01. BOUNDARY LINE" "c" "7" """")
(command "osnap" "")
(COMMAND "COLOR" "7" "")
(command "circle" pt1 500 "")
(setq pt2 (polar pt1 0 500))
(setq pt3 (polar pt1 (/ pi 1) 500))
(setq pt4 (polar pt1 0 750))
(setq pt5 (polar pt1 (/ pi 1) 750))
(setq pt6 (polar pt1 (- 0 (/ pi 2)) 500))
(setq pt7 (polar pt1 (- 0 (/ pi 2)) 750))
(setq pt8 (polar pt1 (/ pi 2) 500))
(setq pt9 (polar pt1 (/ pi 2) 750))
(setq pt10 (polar pt1 0 500))
(setq pt11 (polar pt1 (/ pi 4) 750))
(COMMAND "COLOR" "7" "")
(command "line" pt2 pt4 "")
(command "line" pt6 pt7 "")
(command "line" pt3 pt5 "")
(command "line" pt8 pt9 "")
(setq dk (strcat "\n Size:<"cont">"))
(setq bk (getreal dk))
(if (= bk nil)
(progn
(setq bk (getvar "USERR3"))
)
(setvar "USERR3" bk)
)
(command "scale" pt4 pt5 pt7 pt9 pt11"" pt1 bk"")
(command "layer" "m" "S08. TEXT" "c" "3" """")
(COMMAND "COLOR" "3" "")
(COMMAND "STYLE" "XKC" "VHELVCN.TTF" "" "" "" "" "")
(command "text" "j" "mc" pt1 (* 400 bk) pt10 "A" "")
(COMMAND "COLOR" "BYLAYER" "")
(command "osnap" "End,Mid,Cen,Quad,Int,Perp,Tan,Near,App,Int,Ext,Par" )
(command "move")
)
(princ)

  • 0

#2575 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 16 November 2010 - 08:21 PM

Lisp vẽ hình tròn và chèn text vào hình tròn e đã hiểu,nhưng ý e là viết thêm dòng code nào để khi chèn text vào hình tròn
thì hình tròn này và text sẽ là block ATT.Mong bác chỉ giúp.Thanks


(defun C:TTT ()
(setq bk (getvar "USERR3"))
(if (= bk 0)
(progn
(setq cont "1")
(setvar "USERR3" 1)
)
(setq cont (rtos bk))
)
(setq pt1 (getpoint "\n Nhap diem dat:"))
(command "layer" "m" "S01. BOUNDARY LINE" "c" "7" """")
(command "osnap" "")
(COMMAND "COLOR" "7" "")
(command "circle" pt1 500 "")
(setq pt2 (polar pt1 0 500))
(setq pt3 (polar pt1 (/ pi 1) 500))
(setq pt4 (polar pt1 0 750))
(setq pt5 (polar pt1 (/ pi 1) 750))
(setq pt6 (polar pt1 (- 0 (/ pi 2)) 500))
(setq pt7 (polar pt1 (- 0 (/ pi 2)) 750))
(setq pt8 (polar pt1 (/ pi 2) 500))
(setq pt9 (polar pt1 (/ pi 2) 750))
(setq pt10 (polar pt1 0 500))
(setq pt11 (polar pt1 (/ pi 4) 750))
(COMMAND "COLOR" "7" "")
(command "line" pt2 pt4 "")
(command "line" pt6 pt7 "")
(command "line" pt3 pt5 "")
(command "line" pt8 pt9 "")
(setq dk (strcat "\n Size:<"cont">"))
(setq bk (getreal dk))
(if (= bk nil)
(progn
(setq bk (getvar "USERR3"))
)
(setvar "USERR3" bk)
)
(command "scale" pt4 pt5 pt7 pt9 pt11"" pt1 bk"")
(command "layer" "m" "S08. TEXT" "c" "3" """")
(COMMAND "COLOR" "3" "")
(COMMAND "STYLE" "XKC" "VHELVCN.TTF" "" "" "" "" "")
(command "text" "j" "mc" pt1 (* 400 bk) pt10 "A" "")
(COMMAND "COLOR" "BYLAYER" "")
(command "osnap" "End,Mid,Cen,Quad,Int,Perp,Tan,Near,App,Int,Ext,Par" )
(command "move")
)
(princ)

Bạn thay dòng (command "text" "j" "mc" pt1 (* 400 bk) pt10 "A" "") bằng (command "attdef" "" "A" "A" "A" "j" "mc" pt1 (* 400 bk) "")
Mình sửa cho bạn như thế này bạn xem được chưa

;; free lisp from cadviet.com

(defun C:TTT ( / vt pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11)
(setq vt (ssadd))
(setq bk (getvar "USERR3"))
(if (= bk 0)
(progn
(setq cont "1")
(setvar "USERR3" 1)
)
(setq cont (rtos bk))
)
(setq pt1 (getpoint "\n Nhap diem dat:"))
(command "layer" "m" "S01. BOUNDARY LINE" "c" "7" """")
(command "osnap" "")
(COMMAND "COLOR" "7" "")
(command "circle" pt1 500)
(setq vt (ssadd (entlast) vt))
(setq pt2 (polar pt1 0 500))
(setq pt3 (polar pt1 (/ pi 1) 500))
(setq pt4 (polar pt1 0 750))
(setq pt5 (polar pt1 (/ pi 1) 750))
(setq pt6 (polar pt1 (- 0 (/ pi 2)) 500))
(setq pt7 (polar pt1 (- 0 (/ pi 2)) 750))
(setq pt8 (polar pt1 (/ pi 2) 500))
(setq pt9 (polar pt1 (/ pi 2) 750))
(setq pt10 (polar pt1 0 500))
(setq pt11 (polar pt1 (/ pi 4) 750))
(COMMAND "COLOR" "7" "")
(command "line" pt2 pt4 "")
(setq vt (ssadd (entlast) vt))
(command "line" pt6 pt7 "")
(setq vt (ssadd (entlast) vt))
(command "line" pt3 pt5 "")
(setq vt (ssadd (entlast) vt))
(command "line" pt8 pt9 "")
(setq vt (ssadd (entlast) vt))
(setq dk (strcat "\n Size:<"cont">"))
(setq bk (getreal dk))
(if (= bk nil)
(progn
(setq bk (getvar "USERR3"))
)
(setvar "USERR3" bk)
)
(command "layer" "m" "S08. TEXT" "c" "3" """")
(COMMAND "COLOR" "3" "")
(COMMAND "STYLE" "XKC" "VHELVCN.TTF" "" "" "" "" "")
(command "attdef" "" "A" "A" "A" "j" "mc" pt1 (* 400 bk) "")
(setq vt (ssadd (entlast) vt))
(if (= (tblsearch "block" "ghichu") nil)
(command "block" "ghichu" pt1 vt "")
)
(if (/= (tblsearch "block" "ghichu") nil)
(command "block" "ghichu" "y" pt1 vt "")
)
(command "insert" "ghichu" pt1 bk bk "0" "A")
(COMMAND "COLOR" "BYLAYER" "")
(command "osnap" "End,Mid,Cen,Quad,Int,Perp,Tan,Near,App,Int,Ext,Par" )
(command "move" (entlast) "" pt1)
)
(princ)

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

#2576 quan08

quan08

    biết vẽ pline

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

Đã gửi 16 November 2010 - 09:31 PM

Bạn thay dòng (command "text" "j" "mc" pt1 (* 400 bk) pt10 "A" "") bằng (command "attdef" "" "A" "A" "A" "j" "mc" pt1 (* 400 bk) "")
Mình sửa cho bạn như thế này bạn xem được chưa


;; free lisp from cadviet.com

(defun C:TTT ( / vt pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11)
(setq vt (ssadd))
(setq bk (getvar "USERR3"))
(if (= bk 0)
(progn
(setq cont "1")
(setvar "USERR3" 1)
)
(setq cont (rtos bk))
)
(setq pt1 (getpoint "\n Nhap diem dat:"))
(command "layer" "m" "S01. BOUNDARY LINE" "c" "7" """")
(command "osnap" "")
(COMMAND "COLOR" "7" "")
(command "circle" pt1 500)
(setq vt (ssadd (entlast) vt))
(setq pt2 (polar pt1 0 500))
(setq pt3 (polar pt1 (/ pi 1) 500))
(setq pt4 (polar pt1 0 750))
(setq pt5 (polar pt1 (/ pi 1) 750))
(setq pt6 (polar pt1 (- 0 (/ pi 2)) 500))
(setq pt7 (polar pt1 (- 0 (/ pi 2)) 750))
(setq pt8 (polar pt1 (/ pi 2) 500))
(setq pt9 (polar pt1 (/ pi 2) 750))
(setq pt10 (polar pt1 0 500))
(setq pt11 (polar pt1 (/ pi 4) 750))
(COMMAND "COLOR" "7" "")
(command "line" pt2 pt4 "")
(setq vt (ssadd (entlast) vt))
(command "line" pt6 pt7 "")
(setq vt (ssadd (entlast) vt))
(command "line" pt3 pt5 "")
(setq vt (ssadd (entlast) vt))
(command "line" pt8 pt9 "")
(setq vt (ssadd (entlast) vt))
(setq dk (strcat "\n Size:<"cont">"))
(setq bk (getreal dk))
(if (= bk nil)
(progn
(setq bk (getvar "USERR3"))
)
(setvar "USERR3" bk)
)
(command "layer" "m" "S08. TEXT" "c" "3" """")
(COMMAND "COLOR" "3" "")
(COMMAND "STYLE" "XKC" "VHELVCN.TTF" "" "" "" "" "")
(command "attdef" "" "A" "A" "A" "j" "mc" pt1 (* 400 bk) "")
(setq vt (ssadd (entlast) vt))
(if (= (tblsearch "block" "ghichu") nil)
(command "block" "ghichu" pt1 vt "")
)
(if (/= (tblsearch "block" "ghichu") nil)
(command "block" "ghichu" "y" pt1 vt "")
)
(command "insert" "ghichu" pt1 bk bk "0" "A")
(COMMAND "COLOR" "BYLAYER" "")
(command "osnap" "End,Mid,Cen,Quad,Int,Perp,Tan,Near,App,Int,Ext,Par" )
(command "move" (entlast) "" pt1)
)
(princ)

Mới mở cad lên thí sử dụng lần đầu không thấy đối tượng sau khi move,làm lần 2 mới được.Mong bác xem lại giùm.Thanks
  • 0

#2577 atl

atl

    biết zoom

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

Đã gửi 16 November 2010 - 10:30 PM

ai biết cách hay có lisp nào vẽ được đường chân công trình nhanh không,(chân của mái đào hoặc mái đắp).đầu bài cho( tim công trình,cao trình và chiều rộng đỉnh,hệ số mài đào hoặc đắp cả thượng và hạ,cao trình và chiều rộng cơ hạ,thượng (nếu có), và một bình đồ,thank
  • 0

#2578 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 16 November 2010 - 11:19 PM

ai biết cách hay có lisp nào vẽ được đường chân công trình nhanh không,(chân của mái đào hoặc mái đắp).đầu bài cho( tim công trình,cao trình và chiều rộng đỉnh,hệ số mài đào hoặc đắp cả thượng và hạ,cao trình và chiều rộng cơ hạ,thượng (nếu có), và một bình đồ,thank

Bạn gửi File cad cái bạn muốn lên thì mọi người dễ giúp bạn hơn!!
  • 0

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


#2579 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 16 November 2010 - 11:30 PM

Dạ chào anh Bình!Trước tiên em xin cảm ơn anh đã quan tâm đến yêu cầu của em!
Em đã test thử rồi! Lisp đã đúng ý em! Chỉ có vấn đề nhỏ bé tẹo là sau khi thực hiện xong trong dòng command hiện 1 đống text lên ko biết đó là gì vậy anh!
Xin chân thành cảm ơn anh!

Chào bạn Truongthanh,
Rất vui vì nó đáp ứng được yêu cầu của bạn. Tuy nhiên như mình đã nói là nó chưa hoàn thiện lắm. Mình sẽ bổ sung thêm.

Sở dĩ trong dòng command có một đống text là do trong lisp trên mình không dùng lệnh thoát êm (princ) ở cuối lisp. vì thế sau khi chạy lisp xong trên dòng command sẽ trả về giá trị của biến cuối cùng khi chạy lisp tức là biến els cuối cùng. Để khỏi phải nhìn mấy cái text khó chịu này, bạn chỉ cần thêm vào trước cái ngoặc kết thúc của lisp dòng code sau: (prínc) là lisp sẽ thoát êm và không trả về giá trị này nữa.

Thực tế cái lisp này chưa hoàn chỉnh lắm vì phải chọn đối tượng tới hai lần, mặt khác nó mới chỉ thích hợp với cái bản vẽ bạn post mà thôi vì trong bản vẽ này bạn sử dụng việc căn chỉnh text với mã dxf 73 là 2 và mã dxf 72 là 1 (Middle Center). Với các trường hợp khác có thể sẽ không còn được như ý nửa bạn ạ.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2580 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 16 November 2010 - 11:39 PM

Code này chỉ vẽ được hình tròn và số bên trong nhưng đoạn code tạo cho nó thành block ATT vẫn chưa đúng.Mong bác chỉ chỗ sai và sửa lại giùm.Thanks.

Chào bạn quan08,
Nó đã tạo thành block thuộc tính rồi mà, cái block đó gồm một vòng tròn và một thuộc tính là cái chữ A của bạn đó. Block có tên là ghi thep. Bạn cứ dùng lệnh insert cái block ghi thep này sẽ thấy rõ mà....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.