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

#2621 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 - 01:56 PM

Bạn chuyển qua dùng lisp này đi. lisp kia mình thấy viết hơi dài dòng nếu chỉ để tính diện tích.
Bạn chú ý nhé. những lisp tính diện tích dạng này ở diễn đàn khá nhiều. bạn thử tìm kiếm bằng hộp thoại tìm kiếm xem. chứ nhờ mọi người một lisp quen thuộc thế này sẽ có rất ít người trả lời bạn, đồng thời bạn cũng mất thời gian chờ đợi rồi lỡ mất việc.
Lisp tính diện tích này bạn có thể sửa lại fần xuất kết quả ra màn hình như mình đã gợi ý ở bài trên cho fù hợp với nhu cầu sử dụng của bạn

(defun C:gdt (/ P1 dtich dtich1 ss1 ss2)
(setvar "cmdecho" 0)
(command "undo" "Begin" "")
(command "UCS" "W" "")
(command "Undo" "Mark")
(setq lacol (getvar "CEColor"))
(setq laos (getvar "OsMODE"))
(setq ladim (getvar "Dimzin"))
(setvar "OSMODE" 0)

(setq P1 (getpoint "\n Chi diem trong vung tinh dien tich"))
(command "CECOLOR" 4)
(command "boundary" P1 "")
(setvar "CECOLOR" lacol)
(setq ss1 (ssget "L")
ss2 (ssadd)
ss2 (ssadd (ssname ss1 0) ss2)
ent (ssname ss1 0)
);setq

(command "area" "o" "l")

(setq dtich (getvar "Area"))

(setq P1 (getpoint "\n Chi diem tiep theo ..."))
(while (/= P1 nil)

(command "CECOLOR" 4 "boundary" P1 "")
(setvar "CECOLOR" lacol)
(setq ss1 (ssget "L")
ss2 (ssadd (ssname ss1 0) ss2)
ent (ssname ss1 0)
);setq
(command "area" "o" "l")
(setq dtich1 (getvar "Area")
dtich (+ dtich dtich1)
);command
(setq P1 (getpoint "\n Chi diem tiep theo ..."))
);while
(setvar "OSMODE" laos)
(command "erase" ss2 "")
(setvar "dimzin" 0)
(setq res (entsel "\n Chon text ghi ket qua, Click hoac Enter de ghi ket qua ra man hinh "))
(if res
(progn
(setq res (entget (car res)))
(setq res (subst (cons 1 (rtos dtich 2 2)) (assoc 1 res) res))
(entmod res)
);progn
(progn
(setq p (getpoint "\n Chon diem nhap ket qua" ))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >: ")))
(if caot1 (setq h caot1))
(command "text" p h "0" (rtos dtich 2 2))
);progn
);if

(setvar "dimzin" ladim)
(command "UCS" "p" "")
(command "undo" "end" "")
(setvar "cmdecho" 1)
)

  • 1

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


#2622 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 - 02:04 PM

Quái lạ. có phải do mạng nhà mình không thế này. mấy hôm rồi post bài ở cadviet rất khó khăn!
  • 0

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


#2623 thiep

thiep

    biết dimbaseline

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

Đã gửi 21 August 2009 - 02:18 PM

Quái lạ. có phải do mạng nhà mình không thế này. mấy hôm rồi post bài ở cadviet rất khó khăn!

Rất giống như Thiep về vấn đề này: Khi nhấn nút "thêm bài trả lời" thì trang web lại "xin lỗi" và yêu cầu mình phải đăng nhập lại, cỡ 5 lần như vậy mới thành công.
  • 0

#2624 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 21 August 2009 - 02:35 PM

Quái lạ. có phải do mạng nhà mình không thế này. mấy hôm rồi post bài ở cadviet rất khó khăn!

Đồng cảnh ngộ !
Có lẽ do Lưu lượng Internet VN ra quốc tế bị giảm do lỗi cáp
  • 1

#2625 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 - 04:01 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

mình chỉ sửa để chương trình của bạn chạy được thôi, chứ diện tích tính được lớn gấp 2 lần diện tích của a cad là do source của bạn S = S+2tt mình nghĩ do công việc của bạn cần phải nhân đôi diện tích nên mình vẫn giữ nguyên cái đó.
theo yêu cầu của bạn thì mình sửa lại cho đúng với diện tích của máy 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))
(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)

)
)
(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)
)
)
)

  • 1

#2626 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 - 04:36 PM

khẩn cấp !!!
chào các bác, e muốn xin lisp có thể thay đổi toàn bộ mầu của các đối tượng có trong bản vẽ ( kể cả block ) về chế độ "by layer" không ah? chẳng là e phải chuyển toàn bộ các đối tượng block của bên xây dựng về mầu 8

phải ý bạn như thế này không, chạy thử đi nhé! lệnh CHC tức là change color
(defun c:chc ( / sset i entg clor)
(setq sset (ssget))
(if sset
(progn
(setq len (sslength sset)
i 0
)
(repeat len
(setq entg (entget (ssname sset i))
clor (assoc 62 entg)
i (1+ i)
)
(if clor
(progn
(setq entg (vl-remove clor entg))
(entmake entg)
(entdel (cdr (assoc -1 entg)))
)
)
)
)
)
)

  • 0

#2627 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 - 06:45 PM

mình chỉ sửa để chương trình của bạn chạy được thôi, chứ diện tích tính được lớn gấp 2 lần diện tích của a cad là do source của bạn S = S+2tt mình nghĩ do công việc của bạn cần phải nhân đôi diện tích nên mình vẫn giữ nguyên cái đó.
theo yêu cầu của bạn thì mình sửa lại cho đúng với diện tích của máy 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))
(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)

)
)
(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)
)
)
)

Mình cảm ơn bạn đã quan tâm, lisp chạy rất tốt nhưng mình làm phiền bạn tý nữa nha, cố gắng giúp mình
1. Mình không muốn khi chạy có cái đuôi lòng thòng phía sau:
Command: ttdt
Unknown command "TTDT". Press F1 for help.
Unknown command "TTDT". Press F1 for help.

2. Vấn đề này mình đang đau đầu không biết giải quyết ra sau, mình muốn bạn chỉnh lại dùm mình khi diện tích được tính ra là một giá trị thực tế (cụ thể như: một mảnh đất với KT: 100x100 = 10.000m2, còn với lisp này thì giá trị được tính là 100m2 với tỷ lệ vẽ 1/10). Bạn có thể thêm chuỗi S= trước giá trị d/t và thêm cuỗi m2 (mét vuông) sau giá trị d/t và gán text là Vni-Helve, còn những cái khác vẫn giữ nguyên.
Nếu được bạn bớt chút thời gian giúp mình, cảm ơn bạn nhiều.

Bài viết đã được chỉnh sửa nội dung bởi HoangSon614: 21 August 2009 - 09:38 PM

  • 0

#2628 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 22 August 2009 - 11:05 AM

mình chỉ sửa để chương trình của bạn chạy được thôi, chứ diện tích tính được lớn gấp 2 lần diện tích của a cad là do source của bạn S = S+2tt mình nghĩ do công việc của bạn cần phải nhân đôi diện tích nên mình vẫn giữ nguyên cái đó.
theo yêu cầu của bạn thì mình sửa lại cho đúng với diện tích của máy 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))
(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)

)
)
(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)
)
)
)



Mình cảm ơn bạn đã quan tâm, lisp chạy rất tốt nhưng mình làm phiền bạn tý nữa nha, cố gắng giúp mình
1. Mình không muốn khi chạy có cái đuôi lòng thòng phía sau:
Command: ttdt
Unknown command "TTDT". Press F1 for help.
Unknown command "TTDT". Press F1 for help.
2. Vấn đề này mình đang đau đầu không biết giải quyết ra sau, mình muốn bạn chỉnh lại dùm mình khi diện tích được tính ra là một giá trị thực tế (cụ thể như: một mảnh đất với KT: 100x100 = 10.000m2, còn với lisp này thì giá trị được tính là 100m2 với tỷ lệ vẽ 1/10). Bạn có thể thêm chuỗi S= trước giá trị d/t và thêm cuỗi m2 (mét vuông) sau giá trị d/t và gán text là Vni-Helve, còn những cái khác vẫn giữ nguyên.
Nếu được bạn bớt chút thời gian giúp mình, cảm ơn bạn nhiều.

tomboy có thể giúp mình vấn đề đã nêu ở trên không? Cảm ơn bạn
  • 0

#2629 nguyễn hữu vượng

nguyễn hữu vượng

    biết pan

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

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

các Bác ơi cho em hỏi, em có 1 dòng tọa độ như thế này: "123456.789,2332456.546,1.234" bây giờ em muốn chuyển nó thành tọa độ (123456.789 2332456.546 1.234) được không, các bác chỉ cho em với. thanks
  • 0

#2630 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 23 August 2009 - 10:22 AM

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:

Chào anh Thiệp!
Lisp này khi conghoan dùng gặp phải vấn đề như thế này Thiệp xem lại giúp mình với!
1. Khi mình chọn mép nạo vét thì mình cần dùng truy bắt điểm là hai đường giao nhau (intersection), vì mình có đường trồng cỏ là đường giới hạn mà lisp thì chỉ có Nearest. nếu mình truy bwts điểm bằng ntersection thì sẽ bị lỗi.
2.Khi chọn đường tự nhiên thì mình chọn xong rồi ENTER, thay vì như thế Thiệp đổi lại bằng cách pick chọn rồi tự tiếp tục chọn hai điiểm giới hạn vét mà không cần ENTER.
3. Thường thì mái dốc vét hai bên bằng nhau nhưng cũng có trường hợp hai bên khác nhau Thiệp thêm vào với nhé.
4. Mình thấy mỗi lần chọn mặt cắt thì nó zoom all, có lẽ ý của Thiep để như vậy dễ nhìn nhưng mình thấy cũng không tiện lắm có thể bỏ cái này đi.
PS: hôm trước mình nghe nói Thiep sắp đi Lào vậy có đi không thế? Mình đang làm đường vào Cảng Cái Mép-Thị Vải ở dưới Bà Rịa. Công trình này đã nạo vét xong rồi, nhưng ngành mình làm công việc này nhiều lắm nên mình muốn tìm một cái lisp nào nhanh nhất để thực hiện thôi. Mình đưa ra ý tưởng như thế này Thiệp xem thử có khả thi không nhé: trên mỗi mặt cắt mình để lại hai layer (tự nhiên và giới hạn vét) , layer tự nhiên là polyline còn layer giới hạn là line, mục đích là khi mình chọn các đường tự nhiên thì mình dung thuộc tính polyline thì nó sẽ không chọn những đường giới hạn. Còn phạm vi vét là từ điểm giao giữa đường tự nhiên và đường giới hạn vét. đây là ý tưởng của mình mong được Thiep và anh em diễn đàn giúp đỡ. file cad: http://www.cadviet.c...es/2/tnct_2.dwg
Mình cảm ơn anh em diễn đàn nhiều! Chúc anh em sức khoẻ và cuối tuần vui vẽ!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2631 svba1608

svba1608

    Tưởng Thị Tú Khuyên

  • Moderator
  • PipPipPipPipPipPipPip
  • 601 Bài viết
Điểm đánh giá: 620 (tốt)

Đã gửi 23 August 2009 - 04:22 PM

Một lần nữa nhờ mọi người viết hộ em 1 lisp. Tên lisp có thể mô tả là: thay đổi (hoặc nhập) số thứ tự theo sự chỉ định của chuột. Nghĩa là em có một bản vẽ có nhiều số, các số đặt lung tung, không theo trình tự nào cả. Bây giờ em muốn có 1 lisp như sau:
+ Nhập lệnh.
+ Nhập số bắt đầu (từ bàn phím), ví dụ số 25.
+ Nhập khoảng cách (độ tăng, giảm), ví dụ 1.
+ Dùng chuột pick vào 1 text bất kỳ, text đó biến thành số 25.
+ Pick vào text thứ 2, text đó thành số 26, text thứ 3 sẽ là 27…
Rất mong nhận được sự giúp đỡ. Cảm ơn!
  • 0
http://khuyen.space

#2632 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 23 August 2009 - 07:36 PM

Một lần nữa nhờ mọi người viết hộ em 1 lisp. Tên lisp có thể mô tả là: thay đổi (hoặc nhập) số thứ tự theo sự chỉ định của chuột. Nghĩa là em có một bản vẽ có nhiều số, các số đặt lung tung, không theo trình tự nào cả. Bây giờ em muốn có 1 lisp như sau:
+ Nhập lệnh.
+ Nhập số bắt đầu (từ bàn phím), ví dụ số 25.
+ Nhập khoảng cách (độ tăng, giảm), ví dụ 1.
+ Dùng chuột pick vào 1 text bất kỳ, text đó biến thành số 25.
+ Pick vào text thứ 2, text đó thành số 26, text thứ 3 sẽ là 27…
Rất mong nhận được sự giúp đỡ. Cảm ơn!


(defun C:sst ()
(setvar "cmdecho" 0)
(command "undo" "Begin" "")

(if (not i) (setq i 1))
(if (not a) (setq a 1))
(setq i1 (getreal (strcat"\nSTT Ðâu Tiên < " (rtos i 2 0) " >: "))
a1 (getreal (strcat"\nSo gia < " (rtos a 2 0) " >: " )))
(if i1 (setq i i1))
(if a1 (setq a a1))
(while
(progn
(setq res (entsel (strcat "\nChon text de ghi STT thu " (rtos i 2 0) "")))
(setq res (entget (car res)))
(setq res (subst (cons 1 (rtos i 2 0)) (assoc 1 res) res))
(entmod res)
(setq i (+ i a))
);progn
);while
(command "undo" "end" "")
(setvar "cmdecho" 1)
);end

  • 1

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


#2633 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 23 August 2009 - 07:52 PM

Một lần nữa nhờ mọi người viết hộ em 1 lisp. Tên lisp có thể mô tả là: thay đổi (hoặc nhập) số thứ tự theo sự chỉ định của chuột. Nghĩa là em có một bản vẽ có nhiều số, các số đặt lung tung, không theo trình tự nào cả. Bây giờ em muốn có 1 lisp như sau:
+ Nhập lệnh.
+ Nhập số bắt đầu (từ bàn phím), ví dụ số 25.
+ Nhập khoảng cách (độ tăng, giảm), ví dụ 1.
+ Dùng chuột pick vào 1 text bất kỳ, text đó biến thành số 25.
+ Pick vào text thứ 2, text đó thành số 26, text thứ 3 sẽ là 27…
Rất mong nhận được sự giúp đỡ. Cảm ơn!

Em sử dụng đoạn code này thử xem nhé :
(defun c:dstt(/ so oldim delta dt ent)
;copyright by Tue_NV
(setq oldim (getvar "Dimzin"))
(setvar "Dimzin" 0)
(initget 1)
(setq so (getreal "\n Nhap so bat dau :"))
(initget 1)
(setq delta (getreal "\gia so < + / - > : "))
(initget 5)
(setq tp (getint "\n So chu so thap phan : "))

(while (setq dt (entsel "\n Chon so can thay doi : "))
(setq ent (entget(car dt)))
(setq ent (entmod (subst (cons 1 (rtos so 2 tp)) (assoc 1 ent) ent)))
(setq so (+ so delta))
)
(setvar "Dimzin" oldim)
(princ)
)

  • 3

#2634 tomboy

tomboy

    biết vẽ polygon

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

Đã gửi 23 August 2009 - 09:10 PM

tomboy có thể giúp mình vấn đề đã nêu ở trên không? Cảm ơn bạn

OK, mình rất sẵn sàng,
Link của bạn đây: http://www.cadviet.c...files/2/gdt.rar
down về chạy thử rồi cho nhận xét nhé!
Xin lỗi Hoángon614 nhé, tại mình chưa test kỹ nên không thể tránh khỏi sai sót, đây là Link mà mình đã sửa chữa.
Link vá lỗi đây: http://www.cadviet.com/upfiles/2/gdt_2.rar
Note: diện tích tính được trong acad phụ thuộc vào đơn vị vẽ, nếu người vẽ đơn vị là m thì diện tích là m2, còn nếu vẽ đơn vị là cm thì diện tích là cm2. Do vậy bạn đừng lo là chương trình tính sai, trong chuơng trình mình cũng hỗ trợ cả tỉ lệ diện tích nữa đấy, trong lúc tính diện tích bạn đáp lệnh O thì nó sẽ ra hộp thoại để cho bạn sửa lại tỉ lệ điện tích cũng như các yếu tố phụ trợ khác.
  • 0

#2635 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 23 August 2009 - 09:43 PM

OK, mình rất sẵn sàng,
Link của bạn đây: http://www.cadviet.c...files/2/gdt.rar
down về chạy thử rồi cho nhận xét nhé!

Cảm ơn bạn đã quan tâm, nhưng vẫn mắc một số lỗi. Bạn có thể xem lại giúp mình, cụ thể như:
1. Không đọc được tiếng việt của box
2. Khi nhập chiều cao chữ thoát luôn và báo lỗi
3. Diện tích thể hiện tại dòng command không chính xác (mình có khu đất 1000m2, vẽ tl 1/10 nhưng kết quả là: 100.000m2, tăng gấp 100 lần)
Command: gdt

Pick diem vao mien de lay dien tich : S=100000m2
Pick diem vao mien de lay dien tich :

Chon Text de thay gia tri dien tich or [Option]:
Chon diem chen de ghi dien tich :
Nhap chieu cao chu :<2.5>
Unknown command "J". Press F1 for help.
Unknown command "MC". Press F1 for help.
2.500000

Unknown command "GDT". Press F1 for help.
0
Unknown command "S=100000M2". Press F1 for help.
Unknown command "GDT". Press F1 for help.
nil

  • 0

#2636 bonchen

bonchen

    Chưa sử dụng CAD

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

Đã gửi 23 August 2009 - 11:34 PM

Các anh viết dùm em 1 lisp,em cám ơn trước..^^..
Trên cad em có nhiều text (vd:1,2,3,4,…..a,b,c,d,e….v.v.) em muốn nối các text đó bằng đường line,em có kiếm các lisp có liên quan rùi nhưng ko đúng với ý em…ý em muốn lisp như sau:
+tại dòng command: noitext (em vd)
+nhap cac diem can noi:1,2,3,4,a,d
Enter (thì 1 nối 2, 2 nối 3, 3 nối 4, 4 nối a, a nối d,nhưng d thì ko được nối lại điểm 1)
Enter xong thi trở lại
+nhap cac diem can noi:
  • 0

#2637 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 24 August 2009 - 12:12 AM

Các anh viết dùm em 1 lisp,em cám ơn trước..^^..
Trên cad em có nhiều text (vd:1,2,3,4,…..a,b,c,d,e….v.v.) em muốn nối các text đó bằng đường line,em có kiếm các lisp có liên quan rùi nhưng ko đúng với ý em…ý em muốn lisp như sau:
+tại dòng command: noitext (em vd)
+nhap cac diem can noi:1,2,3,4,a,d
Enter (thì 1 nối 2, 2 nối 3, 3 nối 4, 4 nối a, a nối d,nhưng d thì ko được nối lại điểm 1)
Enter xong thi trở lại
+nhap cac diem can noi:


Thế này thì có khác gì so với việc bạn vẽ theo cách thông thường nhỉ?
gõ L -> enter -> bắt điểm vào 1 -> bắt điểm vào 2 ->...-> bắt điểm vào d -> ok
chẳng khác tý nào cả
  • 0

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


#2638 matran

matran

    biết vẽ line

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

Đã gửi 24 August 2009 - 01:17 AM

Thế này thì có khác gì so với việc bạn vẽ theo cách thông thường nhỉ?
gõ L -> enter -> bắt điểm vào 1 -> bắt điểm vào 2 ->...-> bắt điểm vào d -> ok
chẳng khác tý nào cả

ý bạn ấy kg muốn dùng chuột (zôm pan chi cho mệt), chỉ dùng bàn phím đánh số trên dòng command đấy mà.
  • 1

#2639 tomboy

tomboy

    biết vẽ polygon

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

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

Cảm ơn bạn đã quan tâm, nhưng vẫn mắc một số lỗi. Bạn có thể xem lại giúp mình, cụ thể như:
1. Không đọc được tiếng việt của box
2. Khi nhập chiều cao chữ thoát luôn và báo lỗi
3. Diện tích thể hiện tại dòng command không chính xác (mình có khu đất 1000m2, vẽ tl 1/10 nhưng kết quả là: 100.000m2, tăng gấp 100 lần)
Command: gdt

Pick diem vao mien de lay dien tich : S=100000m2
Pick diem vao mien de lay dien tich :

Chon Text de thay gia tri dien tich or [Option]:
Chon diem chen de ghi dien tich :
Nhap chieu cao chu :<2.5>
Unknown command "J". Press F1 for help.
Unknown command "MC". Press F1 for help.
2.500000

Unknown command "GDT". Press F1 for help.
0
Unknown command "S=100000M2". Press F1 for help.
Unknown command "GDT". Press F1 for help.
nil

Mình sửa lại cho bạn rồi, thông cảm nhé tại mình chưa test kỹ,
link nè: http://www.cadviet.c...les/2/gdt_2.rar (bản vá lỗi mới nhất đó)
Note: nếu bản vẽ tỉ tệ 1/10 thì trong Option của lệnh GDT phần tỉ lệ đo vẽ bạn nhập số 10 vào nhé!
Sory: link vá lỗi này nhé http://www.cadviet.c...les/2/gdt_1.rar
  • 0

#2640 thiep

thiep

    biết dimbaseline

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

Đã gửi 24 August 2009 - 08:23 AM

Chào anh Thiệp!
Lisp này khi conghoan dùng gặp phải vấn đề như thế này Thiệp xem lại giúp mình với!
1. Khi mình chọn mép nạo vét thì mình cần dùng truy bắt điểm là hai đường giao nhau (intersection), vì mình có đường trồng cỏ là đường giới hạn mà lisp thì chỉ có Nearest. nếu mình truy bwts điểm bằng ntersection thì sẽ bị lỗi.
2.Khi chọn đường tự nhiên thì mình chọn xong rồi ENTER, thay vì như thế Thiệp đổi lại bằng cách pick chọn rồi tự tiếp tục chọn hai điiểm giới hạn vét mà không cần ENTER.
3. Thường thì mái dốc vét hai bên bằng nhau nhưng cũng có trường hợp hai bên khác nhau Thiệp thêm vào với nhé.
4. Mình thấy mỗi lần chọn mặt cắt thì nó zoom all, có lẽ ý của Thiep để như vậy dễ nhìn nhưng mình thấy cũng không tiện lắm có thể bỏ cái này đi.
PS: hôm trước mình nghe nói Thiep sắp đi Lào vậy có đi không thế? Mình đang làm đường vào Cảng Cái Mép-Thị Vải ở dưới Bà Rịa. Công trình này đã nạo vét xong rồi, nhưng ngành mình làm công việc này nhiều lắm nên mình muốn tìm một cái lisp nào nhanh nhất để thực hiện thôi. Mình đưa ra ý tưởng như thế này Thiệp xem thử có khả thi không nhé: trên mỗi mặt cắt mình để lại hai layer (tự nhiên và giới hạn vét) , layer tự nhiên là polyline còn layer giới hạn là line, mục đích là khi mình chọn các đường tự nhiên thì mình dung thuộc tính polyline thì nó sẽ không chọn những đường giới hạn. Còn phạm vi vét là từ điểm giao giữa đường tự nhiên và đường giới hạn vét. đây là ý tưởng của mình mong được Thiep và anh em diễn đàn giúp đỡ. file cad: http://www.cadviet.c...es/2/tnct_2.dwg
Mình cảm ơn anh em diễn đàn nhiều! Chúc anh em sức khoẻ và cuối tuần vui vẽ!

Gởi Hoan, theo đề nghị của Hoan, các mục 1, 2, 3, 4 Thiep sẽ chỉnh lại nhanh chóng. Còn ý tưởng mới của Hoan Thiep chưa hiểu lắm. Có phải Hoan nói nạo vét không phải offset từ mặt cắt tự nhiên xuống n mét, mà nạo vét xuống tới cots tuyệt đối nào đó không? Các luồng sông biển bên Hàng Hải cũng làm vậy và có một sai số nạo vét nữa. Hoan cứ đưa lên 1 bản vẽ ví dụ xem.
  • 0