Đến nội dung


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

Viết Lisp theo yêu cầu


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

#2601 tomboy

tomboy

    biết vẽ polygon

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

Đã gửi 19 August 2009 - 08:15 AM

Chào các bác! Em là thành viên mới nhập cuộc, em không biết nhiều về lisp nhưng công việc của em lại cần đến nó rất nhiều. Em đang làm san nền, làm thủ công thì nâu quá. Tìm trên diễn đàn thì có nhiều lisp của nhiều tác giả, em không biết cái nào Pro nhất. Bác nào có lisp san nền Pro nhất cho em xin nhé, em đang rất cần. Mong các Bác giúp em. Thank!

kiukiu ơi, bạn hãy mô tả công việc bạn đang làm, và sản phẩm cuối cùng là gì, và gửi kèm 1 bản vẽ đại diện của bạn nhé để mình cùng tham khảo nếu có thể
  • 0

#2602 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 19 August 2009 - 08:28 AM

Tue_NV xem lại giúp mình với mình test trên cad 2007 nó bị như thế này: http://www.cadviet.c...iles/2/tnct.dwg
Cảm ơn Tue_NV nhiều!

Tue_NV đã chỉnh lại 1 tí trong code. Cong hoan test lại xem :
http://www.cadviet.c...les/2/vbun8.lsp
  • 1

#2603 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 19 August 2009 - 10:48 AM

Đối với những góc vạt mà giữa ARC và PLINE mình chỉ cần trường hợp là tâm vạt góc và tâm này nằm trên phương của đường thẳng!bạn giúp mình tí nhé!thanks TUE rất nhiều!mình ghép cái trường hợp này vào cung 1 LISP với trường hợp cũ luôn được ko TUE?

Bạn sử dụng Code này -> Tue_NV đã viết thêm, bổ sung vào code cũ :
Khi chạy Lisp thì Có 2 trường hợp cho bạn lựa chọn :
<1> : Cac duong deu la LINE hoac PLINE/
<2> : PLINE co 1 phan doan la arc :
Bạn chọn <1> hoặc <2> nhé :

(defun c:gktvg(/ oldos ans po ss prad prac p11 p1 p2 p22 inte ss1 po poo)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 2999)
(initget "1 2")
(setq ans (getkword
"\n <1> : Cac duong deu la LINE hoac PLINE/ <2> : PLINE co 1 phan doan la arc : <1/2> : "))

(if (= ans "1")
(progn
(setq po (getpoint "\n Pick chon mot diem tren canh vat goc :"))

(setq ss (car(nentselp po)))
(if (and (= (cdr(assoc 0 (entget ss))) "LWPOLYLINE") (>= (cdr(assoc 90 (entget ss))) 4))
(progn
(setq prad (fix (vlax-curve-getParamAtPoint ss po)))

(setq p11 (vlax-curve-getPointAtParam ss (- prad 1)))
(setq p1 (vlax-curve-getPointAtParam ss prad))
(setq p2 (vlax-curve-getPointAtParam ss (+ prad 1)))
(setq p22 (vlax-curve-getPointAtParam ss (+ prad 2)))
(setq inte (inters p11 p1 p2 p22 nil))
(setvar "osmode" 0)
(command "dimaligned" p1 inte pause)
(command "dimaligned" p2 inte pause)
);progn
);if

(if (= (cdr(assoc 0 (entget ss))) "LINE")
(progn
(prompt "\n Chon 3 duong vat goc : duong thu nhat, duong thu hai va duong vat goc:")
(setq ss1 (ssget))

(command "pedit" "m" ss1 "" "y" "j" "10" "")
(setq ss (ssname (ssget "L") 0))

(setq prad (fix (vlax-curve-getParamAtPoint ss po)))

(setq p11 (vlax-curve-getPointAtParam ss (- prad 1)))
(setq p1 (vlax-curve-getPointAtParam ss prad))
(setq p2 (vlax-curve-getPointAtParam ss (+ prad 1)))
(setq p22 (vlax-curve-getPointAtParam ss (+ prad 2)))
(setq inte (inters p11 p1 p2 p22 nil))
(setvar "osmode" 0)
(command "dimaligned" p1 inte pause)
(command "dimaligned" p2 inte pause)

(command "explode" ss "")

);progn
);if
(setvar "osmode" oldos)
);progn
);if

(if (= ans "2")
(progn
(setvar "osmode" 2)
(setq po (getpoint "\n Pick chon trung diem canh vat goc :"))
(setvar "osmode" 2999)
(setq p1 (getpoint "\n Pick chon mot diem tren duong thang :"))
(setq ss (car(nentselp po)))
(setq prac (fix (vlax-curve-getParamAtPoint ss p1)))
(setq p11 (vlax-curve-getPointAtParam ss prac))

(setq prad (fix (vlax-curve-getParamAtPoint ss po)))
(setq p2 (vlax-curve-getPointAtParam ss prad))
(setq p22 (vlax-curve-getPointAtParam ss (+ prad 1)))

(setq ang (+ (angle '(0 0 0)
(vlax-curve-getFirstDeriv ss (vlax-curve-getParamAtPoint ss po))) (/ pi 2)))

(setq poo (polar po ang 100))

(setq inte (inters p11 p1 po poo nil))
(setvar "osmode" 0)
(command "dimaligned" p2 inte pause)
(command "dimaligned" p22 inte pause)
))

(princ)
)


Cảm ơn bạn rất nhiều,bạn thật là tốt bụng.

Chào bạn 't031285
Bạn không cần khen đâu, chỉ cần bạn đóng góp thật nhiều cho diễn đàn CADVIET thì quý lắm rồi.
Và theo Tue_NV thì bạn không nên post bài kiểu như vầy. Muốn cảm ơn ai thì bạn chỉ cần tick Thanks ở dưới là được rồi.
THANKS
  • 2

#2604 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 20 August 2009 - 08:40 AM

Cảm ơn Thiệp đã giúp đỡ!
Cái này chạy tốt lắm nhưng có một số điểm chưa được hoàn thiện lắm Thiêp cố gắn chỉnh lại cho mình tí để lisp hoàn thiện hơn.
Thứ nhất: Mình muốn các thông số như mái dốc vét, chiều sâu vét mình chỉ nhập vào đối với mặt cắt đầu tiên thôi, còn các mặt cắt sau thì lisp tự hiểu như mặt cắt đầu. Sau khi thực hiện xong mặt cắt thứ nhất thì lisp tự động thực hiện lệng cho mặt cắt tiếp theo cho đến khi bấm Esc thì kết thúc lệnh. Có nghĩa là đối với các mặt cắt sau mình chỉ cần kích 3 lần: chọn polyline, chọn điểm giới hạn bên trái, bên phải thì được. Vì mình có rất nhiều mặt cắt nên cần làm cho thật nhanh nên hy vong Thiêp sữa lại để lisp thực hiên cho nhanh.
Thứ hai: đường vét là đường offet đường tự nhiên xuống chứ không phải coppy xuống như lisp của Thiêp.
Cảm ơn thiêp đã giúp đỡ! Mong hồi âm của Thiệp!

Chào Hoan và Tue_NV,
Xem ra cái vét bùn của Hoan có nhiều điều cần phải phân tích đó Tue ạ:
Lúc đầu, Thiep nghĩ, những yêu cầu trên của Hoan, mình sửa lại lisp 1 tý là xong. Sau đó mình phân tích lại có nhiều trường hợp xảy ra:
- 1. Sẽ xảy ra như bản vẽ của Hoan: 2 taluy cắt đáy offset tại 2 điểm (cái này mình đã chỉnh sửa lisp theo ý của Hoan)
- 2. Hai taluy cắt nhau trước, mà chưa gặp đáy offset.
- 3. Hai taluy cắt đường địa hình trước khi cắt đáy offset,
- 4. Hai taluy cắt đường địa hình trước và cắt nhau trước, mà chưa gặp đáy offset.
- 5. Hai taluy cắt nhau tại 1 điểm nằm cao hơn đường địa hình, hoặc nằm trên đường địa hình (lúc này sẽ không cần nạo vét)....
Mình đang chia nhiều cond cho lisp và sẽ sớm hoàn thiện Lisp.
  • 1

#2605 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 20 August 2009 - 09:25 AM

Bạn sử dụng Code này -> Tue_NV đã viết thêm, bổ sung vào code cũ :

thanks TUE rất nhiều nhé!mình làm được rồi!
  • 0

#2606 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 20 August 2009 - 11:45 AM

Mình đang cần 1lisp thực hiện công việc như sau:
Xuất các text trong bảng tổng hợp từ Cad sang Excel theo thứ tự từng hàng và từng cột (như hình minh hoạ)
Cụ thể: khi đánh lệnh lisp hỏi: chọn các hàng và cột muốn xuất sang Excel (select objects) - OK
Nhờ các bạn viết giúp mình. Mình cảm ơn tất cả.
File minh hoạ: http://www.cadviet.c...sang_excell.dwg
  • 0

#2607 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 20 August 2009 - 11:56 AM

Mình đang cần 1lisp thực hiện công việc như sau:
Xuất các text trong bảng tổng hợp từ Cad sang Excel theo thứ tự từng hàng và từng cột (như hình minh hoạ)
Cụ thể: khi đánh lệnh lisp hỏi: chọn các hàng và cột muốn xuất sang Excel (select objects) - OK
Nhờ các bạn viết giúp mình. Mình cảm ơn tất cả.
File minh hoạ: http://www.cadviet.c...sang_excell.dwg

Mời bạn sang đây : AutoCAD voi Exxcel
  • 0

#2608 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 20 August 2009 - 12:02 PM

Mời bạn sang đây : AutoCAD voi Exxcel

Cảm ơn Tue_NV đã quan tâm, nhưng trước khi post bài mình đã tìm rồi nhưng không có cái nào đúng như ý mình cả. Nếu được nhờ Tue_NV giúp mình với. Cảm ơn bạn, mình đang rất cần
  • 0

#2609 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 20 August 2009 - 12:58 PM

Cảm ơn Tue_NV đã quan tâm, nhưng trước khi post bài mình đã tìm rồi nhưng không có cái nào đúng như ý mình cả. Nếu được nhờ Tue_NV giúp mình với. Cảm ơn bạn, mình đang rất cần

Vậy bạn đã thử cái này chưa?
Xin lisp xuất bảng tổng hợp khối lượng sang excel
- Bai viet so 3

Xin nhắc với HoangSon và mọi người một ý nhỏ là : nên post bài vào đúng Topic của nó. Bài viết của Bạn phải được post vào đúng Topic AutoCAd với Excel chứ không phải post vào topic này.
  • 1

#2610 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 20 August 2009 - 01:24 PM

Tue_NV đã chỉnh lại 1 tí trong code. Cong hoan test lại xem :
http://www.cadviet.c...les/2/vbun8.lsp

Cảm ơn Tue_NV đã nhiệt tình giúp đỡ. Mình đã test thử rồi, nếu mình chỉ để layer đường tự nhiên không thì OK nhưng nếu có đường khác nữa (như file của mình kèm theo:http://www.cadviet.com/upfiles/2/tnct_1.dwg ) thì nó lại không được. Trong file mình có thể hiện cái mình cần. Tue_NV và Thiệp coi thử có thể làm như thế nào để mình đựoc kết quả nhanh nhất là được chứ không nhất thiết là làm như nhưng bước mình yêu cầu. Mình nghĩ nếu chọn cùng một lúc nhiều mặt cắt cùng thực hiện một lần không biết có ngoài khả năng của lisp không. Cảm ơn mọi người quan tâm! Do mạng bị lỗi nên gởi hai lần mà không biết xoá. Nhờ admin xoá dùm bài này với. Thank!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2611 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 20 August 2009 - 01:46 PM

Mình đang tìm cái lisp cộng, trừ, nhân, chia giữa các phần tử tương ứng của 2 hàng text.
Mình nhớ Bác Hoành đã post nó trong topic này nhưng tìm hoài không ra.
Bạn nào nhớ nó ở khoảng trang bao nhiêu thì nhắc mình với. Chức năng tìm kiếm của diễn đàn với 4 từ khóa trên cũng chịu thua rồi :bigsmile:
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#2612 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 20 August 2009 - 03:30 PM

Cảm ơn Tue_NV đã nhiệt tình giúp đỡ. Mình đã test thử rồi, nếu mình chỉ để layer đường tự nhiên không thì OK nhưng nếu có đường khác nữa (như file của mình kèm theo:http://www.cadviet.com/upfiles/2/tnct_1.dwg ) thì nó lại không được. Trong file mình có thể hiện cái mình cần. Tue_NV và Thiệp coi thử có thể làm như thế nào để mình đựoc kết quả nhanh nhất là được chứ không nhất thiết là làm như nhưng bước mình yêu cầu. Mình nghĩ nếu chọn cùng một lúc nhiều mặt cắt cùng thực hiện một lần không biết có ngoài khả năng của lisp không. Cảm ơn mọi người quan tâm! Do mạng bị lỗi nên gởi hai lần mà không biết xoá. Nhờ admin xoá dùm bài này với. Thank!

Chào Hoan, làm gì mà yêu cầu "được kết quả nhanh nhất" dữ quá, làm cho Thiep cũng không kịp hoàn thiện Lisp đúng cho mọi trường hợp. Xin hỏi Hoan đang thiết kế vét bùn cái gì mà gấp thế? Thôi thì Hoan tạm sử dụng lisp này vậy:
;;;---------------------------------
;;; LISP vet bun, COPYRIGHT BY THIEP
;;; FREE FROM CADVIET.COM-----------
(defun GiaoDT (e1 e2 / ob1 ob2 g L n kq)
(setq ob1 (vlax-ename->vla-object e1)
ob2 (vlax-ename->vla-object e2)
g (vlax-variant-value
(vla-IntersectWith ob1 ob2 acExtendnone)
)
)
(if (/= (vlax-safearray-get-u-bound g 1) -1)
(setq L (vlax-safearray->list g))
)
(setq n 0)
(repeat (/ (length L) 3)
(setq kq
(append (list (list (nth n L) (nth (+ n 1) L) (nth (+ n 2) L)))
kq
)
)
(setq n (+ n 3))
)
kq
)
(defun LWP (Lpoint *Model* / PntArr)
(setq PntArr (vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length Lpoint)))
)
)
(vlax-safearray-fill PntArr Lpoint)
(vla-AddLightWeightPolyline *Model* PntArr)
)
;;;-----------------------
(defun SS-enlst (ss / c L)
(setq c -1)
(repeat (sslength ss)
(setq L (cons (ssname ss (setq c (1+ c))) L))
)
(reverse L)
)
;;;----------------------
(defun taoRay (ModelS poR1 poR2)
(vla-Addray
ModelS
(vlax-3d-point poR1)
(vlax-3d-point poR2)
)
)

;-----------------------
(defun TextTaluy (model k po h ang / objT)
(setq obj (vla-AddText
*Model*
(strcat "1:" (rtos k 2 1))
(vlax-3d-point po)
h
)
)
(vla-put-Alignment obj acAlignmentTopCenter)
(vla-put-TextAlignmentPoint obj (vlax-3d-point po))
(vla-put-Rotation obj ang)
(vla-put-layer obj "naovet")
)
;;;---------------------
(defun SAVE_MODE ()

(command "Undo" "begin")
(command "UCS" "W" "")
(setq OLD_OSMODE (getvar "OSMODE")
OLD_CECOLOR (getvar "CECOLOR")
OLD_AUTOSNAP (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
)
(setvar "cmdecho" 0)

)
(defun RESTORE ()
(command "Undo" "end")
(setvar "osmode" OLD_OSMODE)
(setvar "AUTOSNAP" OLD_AUTOSNAP)
(setvar "ORTHOMODE" OLD_ORTHOMODE)
(setvar "CECOLOR" OLD_CECOLOR)
(setvar "cmdecho" 1)
)
(vl-load-com)
;;;-----------------ham dinh thong so k_Thiep, d_Thiep, hei_Thiep
(defun c:khd ()
(setq k_Thiep (cond (k_Thiep)
(5)
)
)
(setq oldk_Thiep k_Thiep)
(setq k_Thiep (getreal (strcat "\nChon goc doc nao vet (mau so) <"
(rtos oldk_Thiep 2 1)
"> : "

)
)
)
(if (null k_Thiep)
(setq k_Thiep oldk_Thiep)
)
(setq d_Thiep (cond (d_Thiep)
(5)
)
)
(setq oldd_Thiep d_Thiep)
(setq d_Thiep (getreal (strcat "\nChieu sau nao vet <"
(rtos oldd_Thiep 2 1)
"> : "

)
)
)
(if (null d_Thiep)
(setq d_Thiep oldd_Thiep)
)
(setq hei_Thiep (cond (hei_Thiep)
(5)
)
)
(setq oldhei_Thiep hei_Thiep)
(setq hei_Thiep (getreal (strcat "\nChon chieu cao chu <"
(rtos oldhei_Thiep 2 1)
"> : "

)
)
)
(if (null hei_Thiep)
(setq hei_Thiep oldhei_Thiep)
)
(princ)
(print "Bay gio ban co the su dung lisp vbu.lsp")
)
;;;================================MAIN=============================
(DEFUN c:vbu (/ ActDoc *Model* *layer* en ss p1
Pa Pb p1 p11 p2 p21 p3 p4
objD enD objR1 objR2 enR1 enR2 pin1 pin2
pe1 pe2 objL2 objL1 enL1 enL2 lay an1
an2 pTex1 pTex2 i ss Len lop upp
)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*Model* (vla-get-ModelSpace ActDoc)
*layer* (vla-get-Layers ActDoc)
)
(vla-StartUndoMark ActDoc)
(SAVE_MODE)
(if (not (tblsearch "layer" "naovet"))
(progn
(setq lay (vla-add *layer* "naovet"))
(vla-put-color lay acRed)
)
)
(princ "Chon cac curve be mat nao vet: ")
(setq SS (ssget '((0 . "LWPOLYLINE"))))
(setq Len (SS-enlst ss)
i 1)
(foreach en Len
(setq OBcur (vlax-ename->vla-object en))
(vla-getboundingbox OBcur 'minpoint 'maxpoint)
(setq lop (vlax-safearray->list minpoint)
upp (vlax-safearray->list maxpoint)
un (getvar "viewsize")
ofp (list (/ (+ (car upp) (car lop)) 2) (- (cadr lop) un) 0.0)
)
(vla-zoomwindow
(vlax-get-acad-object)
(vlax-3d-point lop)
(vlax-3d-point upp)
)
(redraw en 3)
(setvar "osmode" 512)
(if (null k_Thiep)
(setq k_Thiep (getreal "\nChon goc doc nao vet (mau so): "))
)
(if (null d_Thiep)
(setq d_Thiep (getreal "\nChieu sau nao vet: "))
)
(if (null hei_Thiep)
(setq hei_Thiep (getreal "\nChon chieu cao chu: "))
)
(setq p1 (getpoint (strcat "\nChon mep nao vet ben TRAI cua mat cat so "
(itoa i)
":"
)
)
p2 (getpoint
(strcat "\nChon mep nao vet ben PHAI cua mat cat so " (itoa i) ":")
)
p11 (list (+ (car p1) k_Thiep) (- (cadr p1) 1) 0.0)
p21 (list (- (car p2) k_Thiep) (- (cadr p2) 1) 0.0)
an1 (angle p1 p11)
an2 (angle p2 p21)
)
;;;================
(vl-cmdf ".offset" d_Thiep en ofp "")
(setq enD (entlast))
(setq objR1 (taoRay *Model* p1 p11)
objR2 (taoRay *Model* p2 p21)
)
(setq enR1 (vlax-vla-object->ename objR1)
enR2 (vlax-vla-object->ename objR2)
)
(setq PA (vlax-curve-getStartPoint enD)
PB (vlax-curve-getEndPoint enD)
)
(setq pin1 (car (giaoDT enR1 enD))
p11 (car (giaoDT enR1 en))
pin2 (car (giaoDT enR2 enD))
p22 (car (giaoDT enR2 en))
pinR (car (giaoDT enR1 enR2))
)
(cond ((/= p1 p11)
(setq p1 p11)
)
((/= p2 p22)
(setq p2 p22)
)
)
(setvar "osmode" 0)
(if (< (car pin1) (car pin2))
(Progn
(vla-delete objR1)
(vla-delete objR2)
(if (< (car PA) (car PB))
(progn
(VL-CMDF "_.break" enD pin2 pin2)
(setq ss (ssname (ssget pin2) 0))
(entdel ss)
(setq pe1 (list (+ (car pin1) 0.1) (+ (cadr pin1) 0.1) 0.0)
pe2 (list (+ (car pin1) 0.1) (- (cadr pin1) 0.1) 0.0)
pe3 (list (- (car pin1) 0.1) (+ (cadr pin1) 0.1) 0.0)
pe4 (list (- (car pin1) 0.1) (- (cadr pin1) 0.1) 0.0)
)
(setq enD (ssname (ssget pin1) 0))
(VL-CMDF "_.break" enD pin1 pin1)
(entdel (ssname (ssget "F" (list pe3 pe4)) 0))
(setq enD (ssname (ssget "F" (list pe1 pe2)) 0))
)
(progn
(VL-CMDF "_.break" enD pin1 pin1)
(setq ss (ssname (ssget pin1) 0))
(entdel ss)
(setq pe1 (list (+ (car pin2) 0.1) (+ (cadr pin2) 0.1) 0.0)
pe2 (list (+ (car pin2) 0.1) (- (cadr pin2) 0.1) 0.0)
pe3 (list (- (car pin2) 0.1) (+ (cadr pin2) 0.1) 0.0)
pe4 (list (- (car pin2) 0.1) (- (cadr pin2) 0.1) 0.0)
)
(setq enD (ssname (ssget pin2) 0))
(VL-CMDF "_.break" enD pin2 pin2)
(entdel (ssname (ssget "F" (list pe1 pe2)) 0))
(setq enD (ssname (ssget "F" (list pe3 pe4)) 0))
)
);;;end if trong
(setq Lp (list (car p1)
(cadr p1)
(car pin1)
(cadr pin1)
)
objL1 (LWP Lp *Model*)
enL1 (vlax-vla-object->ename objL1)
)
(setq Lp (list (car p2)
(cadr p2)
(car pin2)
(cadr pin2)
)
objL2 (LWP Lp *Model*)
enL2 (vlax-vla-object->ename objL2)
)
(vl-cmdf ".pedit" "m" enL1 end enL2 "" "j" "" "")
(setq lineNV (vlax-ename->vla-object (entlast)))
);;;end progn 1
(Progn
(vla-delete objR1)
(vla-delete objR2)
(entdel enD)
(setq Lp (list (car p1)
(cadr p1)
(car pinR)
(cadr pinR)
(car p2)
(cadr p2)
)
)
(setq lineNV (LWP Lp *Model*))
(setq pin1 pinR pin2 pinR)
);;;end progn 2
);;;end if ngoai
(vla-put-layer lineNV "naovet")
(vla-put-color lineNV acbylayer)
;;;---tao text----
(setq pTex1 (polar (acet-geom-midpoint p1 pin1)
(- an1 (/ pi 2))
(/ hei_Thiep 2)
)
)
(TextTaluy *Model* k_Thiep pTex1 hei_Thiep an1)
(setq pTex2 (polar (acet-geom-midpoint p2 pin2)
(+ an2 (/ pi 2))
(/ hei_Thiep 2)
)
)
(TextTaluy *Model* k_Thiep pTex2 hei_Thiep (+ an2 pi))
(setq i (1+ i))
(vla-ZoomExtents (vlax-get-acad-object))
;(redraw en 4)
);;;end foreach
(RESTORE)
(vla-EndUndoMark ActDoc)
(princ "\nChuc cac ban thanh cong. Thiep")
(princ)
)

Hoan chú ý:
- Lisp sẽ hỏi các thông số 1 lần đầu tiên thôi, lần sau sẽ không hỏi nữa cho dù phát lệnh VBU đến lần thứ n. Muốn thay đổi các thông số này phải phát lệnh KHD trước khi phát lệnh VBU.
:bigsmile:
  • 1

#2613 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 20 August 2009 - 04:36 PM

Mình đang tìm cái lisp cộng, trừ, nhân, chia giữa các phần tử tương ứng của 2 hàng text.
Mình nhớ Bác Hoành đã post nó trong topic này nhưng tìm hoài không ra.
Bạn nào nhớ nó ở khoảng trang bao nhiêu thì nhắc mình với. Chức năng tìm kiếm của diễn đàn với 4 từ khóa trên cũng chịu thua rồi :bigsmile:

link ở đây:
http://www.cadviet.c...o...ost&p=65044
  • 1

#2614 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 20 August 2009 - 04:37 PM

Vậy bạn đã thử cái này chưa?
Xin lisp xuất bảng tổng hợp khối lượng sang excel
- Bai viet so 3

Xin nhắc với HoangSon và mọi người một ý nhỏ là : nên post bài vào đúng Topic của nó. Bài viết của Bạn phải được post vào đúng Topic AutoCAd với Excel chứ không phải post vào topic này.

Cảm ơn Tue_NV, mình sẽ rút kinh nghiệm, mình sơ ý quá. Thanks......
  • 0

#2615 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 20 August 2009 - 05:58 PM

link ở đây:
http://www.cadviet.c...o...ost&p=65044


Ồ không! cái em cần nó thê này cơ.
ví dụ phép cộng:
Hàng 1: A B C D ....
Hàng 2: a b c d ...
Hàng kết qủa: A+a B+b C+c D+d
Lisp này em chắc chắn là Bác Hoành post trong chính topic này. nhưng mà topic này dài quá em tìm mà muốn khùng luôn.
Các sếp Mod hay Admin có nên xem xét việc xóa bớt những bài viết không cần thiết (kiểu những bài nêu vấn đề vô nghĩa, những bài chỉ để cảm ơn người viết ...) đối với riêng topic này để rút gọn nó lại được không nhỉ. đây là topic rất có giá trị và có thể coi như thư viện lisp của cadviet. nhưng mà tìm bài trong này thực sự rất mệt mỏi.
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#2616 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 20 August 2009 - 06:02 PM

Mình đang sử dụng lisp tính tổng diện tích các vùng chọn của bạn nhưng bị báo lỗi. Bạn xem lại giúp mình (cái này rất hay, mình đang cần)
Khi thực hiện lệnh thì Lisp chạy bình thường nhưng khi đến đoạn lisp hỏi nhập chiều cao chữ , mình nhập vào xong -> Enter thì bị thoát luôn và báo lỗi như sau:
; error: too many arguments
Bạn có thể xem lại lisp và hướng dẫn giúp mình. Cảm ơn bạn

(defun c:gdt(/ oldim p1 frome cur toe ss ss2 tt S ans po cao te ente)
(setq oldim (getvar "DimZin"))
(setvar "DimZin" 0)
(setvar "cmdecho" 0)
(setq p1 (getpoint "\n Pick diem vao mien de lay dien tich : ") S 0 ss2 (ssadd))
(While p1
(setq frome (entlast));;

(command ".boundary" p1 "");; boundary
(setq toe (entlast));;

(setq cur frome; khoi tao
ss (ssadd)
)
(while (not (eq cur toe));;
(setq
cur (entnext cur)
ss (ssadd cur ss)
)

(command "area" "S" "O" ss "" "")
(setq tt (getvar "area"))
(setq S (+ S tt))
)
(command "area" "A" "O" "L" "" "")
(setq tt (getvar "area"))
(setq S (+ S (* tt 2)))
;(Command "erase" ss "")
(ch2 ss ss2)
;(sssetfirst ss2 ss2)
(setq p1 (getpoint "\n Pick diem vao mien de lay dien tich : "))

)
(initget "T D")
(setq ans (getkword "\n Chon Text de thay gia tri dien tich / chon Diem chen de ghi dien tich :"))
(if (or (= ans "d") (= ans "D"))
(progn
(setq po (getpoint "\n Chon diem chen de ghi dien tich :"))
(setq cao (getdist "\n Nhap chieu cao chu : "))
(wtxt (rtos S 2 2) po 0 cao)
(command "erase" ss2 "")
)
)
(if (or (= ans "t") (= ans "T"))
(progn
(setq te (car(entsel "\n Chon Text de thay gia tri dien tich ")))
(setq ente (entget te))
(setq ente (subst(cons 1 (rtos S 2 2)) (assoc 1 ente) ente))
(entmod ente)
(command "erase" ss2 "")
)
)
(setvar "DimZin" oldim)
(Princ)
)
;
;
(defun ch2(ss1 ss2 / i n)
(setq i 0 n (sslength ss1))
(while (< i n)
(setq ss2 (ssadd (ssname ss1 i) ss2))
(setq i (1+ i))
)
(sssetfirst ss2 ss2)
)
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 2) (cons 73 2) (cons 50 ang) (cons 40 h) (cons 41 0.8))
)
)

  • 0

#2617 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 21 August 2009 - 12:35 AM

bạn thay đoạn

(setq cao (getdist "\n Nhap chieu cao chu : "))
(wtxt (rtos S 2 2) po 0 cao)

thành

(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >: ")))
(if caot1 (setq h caot1))
(command "text" po h "0" (rtos dtich 2 2))

hoặc

(wtxt (rtos S 2 2) po)

Mỗi cái đều có cái hay cái dở của riêng nó. dùng cái nào thì tuỳ bạn.
Ban có thể đọc thêm tại đây để hiểu vì sao lisp trên bị lỗi (phần 3 của bài số 1)
PS: lisp này viết dài dòng rắc rối quá!
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#2618 tomboy

tomboy

    biết vẽ polygon

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

Đã gửi 21 August 2009 - 09:55 AM

Mình đang sử dụng lisp tính tổng diện tích các vùng chọn của bạn nhưng bị báo lỗi. Bạn xem lại giúp mình (cái này rất hay, mình đang cần)
Khi thực hiện lệnh thì Lisp chạy bình thường nhưng khi đến đoạn lisp hỏi nhập chiều cao chữ , mình nhập vào xong -> Enter thì bị thoát luôn và báo lỗi như sau:
; error: too many arguments
Bạn có thể xem lại lisp và hướng dẫn giúp mình. Cảm ơn bạn


(defun c:gdt(/ oldim p1 frome cur toe ss ss2 tt S ans po cao te ente)
(setq oldim (getvar "DimZin"))
(setvar "DimZin" 0)
(setvar "cmdecho" 0)
(setq p1 (getpoint "\n Pick diem vao mien de lay dien tich : ") S 0 ss2 (ssadd))
(While p1
(setq frome (entlast));;

(command ".boundary" p1 "");; boundary
(setq toe (entlast));;

(setq cur frome; khoi tao
ss (ssadd)
)
(while (not (eq cur toe));;
(setq
cur (entnext cur)
ss (ssadd cur ss)
)

(command "area" "S" "O" ss "" "")
(setq tt (getvar "area"))
(setq S (+ S tt))
)
(command "area" "A" "O" "L" "" "")
(setq tt (getvar "area"))
(setq S (+ S (* tt 2)))
;(Command "erase" ss "")
(ch2 ss ss2)
;(sssetfirst ss2 ss2)
(setq p1 (getpoint "\n Pick diem vao mien de lay dien tich : "))

)
(initget "T D")
(setq ans (getkword "\n Chon Text de thay gia tri dien tich / chon Diem chen de ghi dien tich :"))
(if (or (= ans "d") (= ans "D"))
(progn
(setq po (getpoint "\n Chon diem chen de ghi dien tich :"))
(setq cao (getdist "\n Nhap chieu cao chu : "))
(wtxt (rtos S 2 2) po 0 cao)
(command "erase" ss2 "")
)
)
(if (or (= ans "t") (= ans "T"))
(progn
(setq te (car(entsel "\n Chon Text de thay gia tri dien tich ")))
(setq ente (entget te))
(setq ente (subst(cons 1 (rtos S 2 2)) (assoc 1 ente) ente))
(entmod ente)
(command "erase" ss2 "")
)
)
(setvar "DimZin" oldim)
(Princ)
)
;
;
(defun ch2(ss1 ss2 / i n)
(setq i 0 n (sslength ss1))
(while (< i n)
(setq ss2 (ssadd (ssname ss1 i) ss2))
(setq i (1+ i))
)
(sssetfirst ss2 ss2)
)
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 2) (cons 73 2) (cons 50 ang) (cons 40 h) (cons 41 0.8))
)
)

minh sửa lại cho bạn rồi, chạy thử đi nhé
(defun c:gdt (/ oldim p1 frome cur toe ss ss2 tt S entn ans po cao te ente)
(setq oldim (getvar "DimZin"))
(setvar "DimZin" 0)
(setvar "cmdecho" 0)
(setq entn '()
S 0)
(While (setq p1 (getpoint "\n Pick diem vao mien de lay dien tich : "))
(if p1 (progn
(setq frome (entlast))
(command ".boundary" p1 "")
(setq toe (entlast))
(if (not (eq frome toe))
(progn
(command "area" "e" "l" "")
(setq tt (getvar "area"))
(setq S (+ S (* tt 2)))
(setq entn(append entn (list toe)))
)
)
)
)
)
(if entn
(progn
(setq len(length entn)
i 0)
(repeat len
(entdel (nth i entn))
(setq i (1+ i))
)
)
)
(setq ok "YES")
(while (= ok "YES")
(setq ent
(entsel
"\nChon Text de thay gia tri dien tich : "
)
)
(if (not ent)
(progn
(setq err (getvar "errno"))
(if (= err 52)
(setq ok "NO" ans "D")
)
)
(progn
(if (= (cdr(assoc 0 (entget(car ent)))) "TEXT")
(setq te (car ent) ok "NO" ans "T"))
)
)
)
(if (or (= ans "d") (= ans "D"))
(progn
(setq po (getpoint "\n Chon diem chen de ghi dien tich :"))
(setq cao (getdist "\n Nhap chieu cao chu : "))
(wtxt (rtos S 2 2) po 0 cao)
(command "erase" ss2 "")
)
)
(if (or (= ans "t") (= ans "T"))
(progn
(setq ente (entget te))
(setq ente (subst (cons 1 (rtos S 2 2)) (assoc 1 ente) ente))
(entmod ente)

)
)
(setvar "DimZin" oldim)
(Princ)
)
;
;
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT")
(cons 7 sty)
(cons 1 txt)
(cons 10 p)
(cons 11 p)
(cons 72 2)
(cons 73 2)
(cons 50 ang)
(cons 40 h)
(cons 41 0.8)
)
)
)

  • 0

#2619 tomboy

tomboy

    biết vẽ polygon

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

Đã gửi 21 August 2009 - 09:55 AM

Mình đang sử dụng lisp tính tổng diện tích các vùng chọn của bạn nhưng bị báo lỗi. Bạn xem lại giúp mình (cái này rất hay, mình đang cần)
Khi thực hiện lệnh thì Lisp chạy bình thường nhưng khi đến đoạn lisp hỏi nhập chiều cao chữ , mình nhập vào xong -> Enter thì bị thoát luôn và báo lỗi như sau:
; error: too many arguments
Bạn có thể xem lại lisp và hướng dẫn giúp mình. Cảm ơn bạn


(defun c:gdt(/ oldim p1 frome cur toe ss ss2 tt S ans po cao te ente)
(setq oldim (getvar "DimZin"))
(setvar "DimZin" 0)
(setvar "cmdecho" 0)
(setq p1 (getpoint "\n Pick diem vao mien de lay dien tich : ") S 0 ss2 (ssadd))
(While p1
(setq frome (entlast));;

(command ".boundary" p1 "");; boundary
(setq toe (entlast));;

(setq cur frome; khoi tao
ss (ssadd)
)
(while (not (eq cur toe));;
(setq
cur (entnext cur)
ss (ssadd cur ss)
)

(command "area" "S" "O" ss "" "")
(setq tt (getvar "area"))
(setq S (+ S tt))
)
(command "area" "A" "O" "L" "" "")
(setq tt (getvar "area"))
(setq S (+ S (* tt 2)))
;(Command "erase" ss "")
(ch2 ss ss2)
;(sssetfirst ss2 ss2)
(setq p1 (getpoint "\n Pick diem vao mien de lay dien tich : "))

)
(initget "T D")
(setq ans (getkword "\n Chon Text de thay gia tri dien tich / chon Diem chen de ghi dien tich :"))
(if (or (= ans "d") (= ans "D"))
(progn
(setq po (getpoint "\n Chon diem chen de ghi dien tich :"))
(setq cao (getdist "\n Nhap chieu cao chu : "))
(wtxt (rtos S 2 2) po 0 cao)
(command "erase" ss2 "")
)
)
(if (or (= ans "t") (= ans "T"))
(progn
(setq te (car(entsel "\n Chon Text de thay gia tri dien tich ")))
(setq ente (entget te))
(setq ente (subst(cons 1 (rtos S 2 2)) (assoc 1 ente) ente))
(entmod ente)
(command "erase" ss2 "")
)
)
(setvar "DimZin" oldim)
(Princ)
)
;
;
(defun ch2(ss1 ss2 / i n)
(setq i 0 n (sslength ss1))
(while (< i n)
(setq ss2 (ssadd (ssname ss1 i) ss2))
(setq i (1+ i))
)
(sssetfirst ss2 ss2)
)
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 2) (cons 73 2) (cons 50 ang) (cons 40 h) (cons 41 0.8))
)
)

minh sửa lại cho bạn rồi, chạy thử đi nhé
link vá lỗi nè:http://www.cadviet.com/upfiles/2/gdt_1.rar
  • 0

#2620 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 21 August 2009 - 11:57 AM

minh sửa lại cho bạn rồi, chạy thử đi nhé

(defun c:gdt (/ oldim p1 frome cur toe ss ss2 tt S entn ans po cao te ente)
(setq oldim (getvar "DimZin"))
(setvar "DimZin" 0)
(setvar "cmdecho" 0)
(setq entn '()
S 0)
(While (setq p1 (getpoint "\n Pick diem vao mien de lay dien tich : "))
(if p1 (progn
(setq frome (entlast))
(command ".boundary" p1 "")
(setq toe (entlast))
(if (not (eq frome toe))
(progn
(command "area" "e" "l" "")
(setq tt (getvar "area"))
(setq S (+ S (* tt 2)))
(setq entn(append entn (list toe)))
)
)
)
)
)
(if entn
(progn
(setq len(length entn)
i 0)
(repeat len
(entdel (nth i entn))
(setq i (1+ i))
)
)
)
(setq ok "YES")
(while (= ok "YES")
(setq ent
(entsel
"\nChon Text de thay gia tri dien tich : "
)
)
(if (not ent)
(progn
(setq err (getvar "errno"))
(if (= err 52)
(setq ok "NO" ans "D")
)
)
(progn
(if (= (cdr(assoc 0 (entget(car ent)))) "TEXT")
(setq te (car ent) ok "NO" ans "T"))
)
)
)
(if (or (= ans "d") (= ans "D"))
(progn
(setq po (getpoint "\n Chon diem chen de ghi dien tich :"))
(setq cao (getdist "\n Nhap chieu cao chu : "))
(wtxt (rtos S 2 2) po 0 cao)
(command "erase" ss2 "")
)
)
(if (or (= ans "t") (= ans "T"))
(progn
(setq ente (entget te))
(setq ente (subst (cons 1 (rtos S 2 2)) (assoc 1 ente) ente))
(entmod ente)

)
)
(setvar "DimZin" oldim)
(Princ)
)
;
;
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT")
(cons 7 sty)
(cons 1 txt)
(cons 10 p)
(cons 11 p)
(cons 72 2)
(cons 73 2)
(cons 50 ang)
(cons 40 h)
(cons 41 0.8)
)
)
)



bạn thay đoạn

(setq cao (getdist "\n Nhap chieu cao chu : "))
(wtxt (rtos S 2 2) po 0 cao)

thành

(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >: ")))
(if caot1 (setq h caot1))
(command "text" po h "0" (rtos dtich 2 2))

hoặc

(wtxt (rtos S 2 2) po)

Mỗi cái đều có cái hay cái dở của riêng nó. dùng cái nào thì tuỳ bạn.
Ban có thể đọc thêm tại đây để hiểu vì sao lisp trên bị lỗi (phần 3 của bài số 1)
PS: lisp này viết dài dòng rắc rối quá!

Cảm ơn 2 bạn đã quan tâm, nhưng mình đã thử lại nhưng vẫn ăặp các rắc rối như sau:
@Lisp của bạn Thaistreetz không chạy được vẫn báo lỗi
Command: gdt

Pick diem vao mien de lay dien tich :
Pick diem vao mien de lay dien tich :

Chon Text de thay gia tri dien tich / chon Diem chen de ghi dien tich :d

Chon diem chen de ghi dien tich :
Cao text < 3 >:
; error: bad argument type: numberp: nil


@Lisp của bạn Tomboy thì chạy được nhưng vẫn bị lỗi nhỏ
1. Khi chạy xất hiện dòng chữ: Unknown command "TTDT". Press F1 for
help.
không ảnh hưởng đến lisp nhưng thấy không đẹp mắt lắm
2. Khi diện tích được tính lớn gấp 2 lần (mình đã so sánh với kiểu tính Area của Cad)
Các bạn có thể xem lại giúp mình. Cảm ơn các bạn nhiều
  • 0