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

#2541 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 09 August 2009 - 06:19 AM

sao mình đo với các góc khác nhau thì lại cho các kết quả khác nhau,mặc dù mình CHAMFER cùng 1 khoảng cách!bạn xem lại file CAD dùm mình nhé!
http://www.cadviet.c...les/2/gktvg.dwg

Bạn thử test Code này xem sao. Test cả trường hợp LINE và cả POLYLINE luôn bạn nhé :

(defun c:gktvg()
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 2999)
(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)
(princ)
)

  • 1

#2542 790312

790312

    biết lệnh fillet

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

Đã gửi 09 August 2009 - 05:09 PM

bạn dùng thử hai lệnh này xem

(defun c:dh1() (command ".dimstyle" "r" "1000")) ; "1000 la ten dimstyle vi du"
(defun c:dh() (command ".dimstyle" "r" "" ))

Sao mình đánh lệnh dh1 nó không hiểu.Bạn có thể hướng dẫn cho mình với.Thanks.
  • 0

#2543 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 10 August 2009 - 12:01 AM

Bạn thử test Code này xem sao. Test cả trường hợp LINE và cả POLYLINE luôn bạn nhé :

cảm ơn TUE rất nhiều nhen!lần này thì rất đúng với ý mình rồi!cảm ơn sự tận tình của YEU rất nhiều!
  • 0

#2544 pdhuyxn2

pdhuyxn2

    biết vẽ circle

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

Đã gửi 10 August 2009 - 09:25 AM

Nhờ các Bác viết cho lisp nội dung sau:
Tại bảng tính excel đánh tên người, mỗi người 1 dòng theo thứ tự từ 1 đến 1000.
Sau đó chuyển sang cad mỗi lần pick 1 điểm thứ tự text của mỗi người trong bảng hiện lên theo thứ tự từ 1 đến 10000.

bảng excel:
1: An
2: Hoà
3: Hùng
4: Chiến
VVV........


Tại excel tên từng người là theo hàng xắp xếp.Nhưng xang cad mỗi tên ở 1 toạ dộ XY khác nhau bạn ạ
Mong các bạn giúp đỡ.
  • 0

#2545 quygtvt

quygtvt

    biết vẽ circle

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

Đã gửi 10 August 2009 - 11:13 AM

mình đọc rùi!!! nhưng đề bài ra là khác nhau mà!!! mình muốn làm tròn dim, không phải text!!! :bigsmile:
Mình đang gặp phải trường hợp có bản vẽ các giá trị cứ bị lẻ: ví dụ: 4501, 18003, 9001.... lí do là khi đo để chế độ bắt điểm không tốt, nếu sửa lại bằng tay thì nông dân quá!!! Cũng có trường hợp khi scale đối tượng, các giá trị cũng bị lẽ như thế này. nên mình mới muốn hỏi mọi người có cách nào để giá trị dim khi đo luôn là bội số của 0 và 5 không?
Các cao thủ lish giúp cái nào!!! :bigsmile: :bigsmile: :)

Cái này không phải dùng Lisp bạn ạ, là Cad thôi.
Bạn làm thế này:
Command line: D
Trong hộp thoại "Dimension Style Manager" bạn chọn "Style" muốn sửa và chọn "Modify". Chọn Tab "Primary Unit", sửa ô Round off thành 5 là được.
  • 0
Không thể nói trời không xanh hơn,
và mắt em không xanh khác ngày thường

Hình đã gửi


#2546 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 10 August 2009 - 02:22 PM

bác Tue_NV có thể viết cho e 1 cái lisp mà có thể kéo dài đường hatch được ko? mỗi lần thay đổi khung của phần hatch thì bình thường là em phải xoá phần hatch cũ đi rồi mới chọn khung để hatch lại. vậy thì bác thử xem viết lisp nào mà có thể chọn phần khung mới để kéo dài hacth cũ cho lấp đầy khung mới. kiểu như lệnh extent kéo dài 1 đường thẳng tới 1đường thẳng khác ấy bác ah! thanks!
  • 0

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#2547 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 10 August 2009 - 04:07 PM

bác Tue_NV có thể viết cho e 1 cái lisp mà có thể kéo dài đường hatch được ko? mỗi lần thay đổi khung của phần hatch thì bình thường là em phải xoá phần hatch cũ đi rồi mới chọn khung để hatch lại. vậy thì bác thử xem viết lisp nào mà có thể chọn phần khung mới để kéo dài hacth cũ cho lấp đầy khung mới. kiểu như lệnh extent kéo dài 1 đường thẳng tới 1đường thẳng khác ấy bác ah! thanks!

Bạn đã sử dụng Lisp move hatch(HM) chưa?
Bạn sử dụng thử nhé :
http://www.cadviet.c...st=0#entry43821
  • 2

#2548 thiep

thiep

    biết dimbaseline

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

Đã gửi 10 August 2009 - 04:21 PM

bác Tue_NV có thể viết cho e 1 cái lisp mà có thể kéo dài đường hatch được ko? mỗi lần thay đổi khung của phần hatch thì bình thường là em phải xoá phần hatch cũ đi rồi mới chọn khung để hatch lại. vậy thì bác thử xem viết lisp nào mà có thể chọn phần khung mới để kéo dài hacth cũ cho lấp đầy khung mới. kiểu như lệnh extent kéo dài 1 đường thẳng tới 1đường thẳng khác ấy bác ah! thanks!

Yêu cầu của bach1212, chưa cần đến lisp đâu. Chỉ cần khi tạo hatch, bạn bấm vào ô Associative là được. Khi muốn mở rộng hatch, bấm rê các nút của boundảy là được, hoặc dùng lệnh stretch.

Chào cả nhà CADVIET, sau hơn 1 tháng vắng mặt, mà topic này đã phát triển thêm 14 trang. Thật là vui khi thấy Tue_NV, Gia Bach, G288, ntvn... vẫn cần mẫn giúp ích cho đời.
  • 1

#2549 thiep

thiep

    biết dimbaseline

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

Đã gửi 11 August 2009 - 11:16 AM

Conghoan hãy chờ đợi. Tue_NV đang tìm 1 phương án khả thi hơn. Mình đã thử test trên CAD2007 rồi, tại sao lại bị lỗi như vậy
Cong hoan chịu khó chờ nhé. Dạo này Tue_NV hơi bận. Tue_NV đang tìm phương án khác để hoàn thiện nó.
Chào conghoan

Cảm ơn Tue_NV nhiều. Mình rất vui khi biết lisp này vẫn còn hy vọng để hoàn thiện. Mình thấy có một nguyên nhân làm cho mình test không thành công xin được góp ý để Tue sửa lại cho dễ nha. Cad 2004 mình test cũng như cad 2007 chứ không ảnh hưởng gì cả, 2004 vẫn lỗi như thế. Và cùng có chung một nguyên nhân là polyline tự nhiên quá dốc thì xảy ra lỗi này, còn nếu như đường polyline bằng phẳng thì OK. Mình đinh up file cho Tue de nhin nhưng uo hoài không được. mình nói chung là thế này: nếu đường mái dốc cắt đường offset bên dưới thì nó nối lại với nhau còn không thì nó không nối lại với nhau được. Khi nào rãnh Tue_NV nghieng cuu giúp nha!
Thank!

Chào conghoan1003 và Tue_NV,
Thiep cũng có một thời gian làm việc cùng với Bảm đảm An toàn Hàng Hải II, nạo vét luồng SG - Vũng Tàu từ Tân Cảng đến Ghềnh Rái, Người ta nạo vét đến cots 8.2m sai số 0.3m (mốc cao độ Mũi Nai). Còn yêu cầu của Conghoan thi vét bùn theo bề mặt địa hình tự nhiên rồi offset xuống, lại không có sai số nạo vét!
Thôi thì cũng theo yêu cầu này, Thiep xin gánh cho Tue một chút tạo ra lisp như ý muốn của CongHoan:

(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 taoRay (ModelS poR1 poR2)
(vla-Addray
ModelS
(vlax-3d-point poR1)
(vlax-3d-point poR2)
)
)
(defun taoLine (ModelS p1 p2)
(vla-AddLine
ModelS
(vlax-3d-point p1)
(vlax-3d-point p2)
)
)
(defun TextTaluy (model k po h ang / objT)
(setq obj (vla-AddText
*Model*
(strcat "1:" (itoa k))
(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 c:vbu (/ ActDoc *Model* *layer* en ss p1 Pa Pb
p11 p2 p3 p4 p21 objD enD objR1
objR2 enR1 enR2 pin1 pin2 pe1 pe2 objL2
objL1 enL1 enL2 lay ang1 ang2 poTex1 poTex2
)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*Model* (vla-get-ModelSpace ActDoc)
*layer* (vla-get-Layers ActDoc)
)
(vla-StartUndoMark ActDoc)
(if (not (tblsearch "layer" "naovet"))
(progn
(setq lay (vla-add *layer* "naovet"))
(vla-put-color lay acRed)
)
)
(setvar "osmode" 512)
(setq en (car(entsel "\nChon curve be mat nao vet: ")))
(setq k (cond (k) (5)))
(setq oldk k)
(setq k (getint (strcat "\nChon goc doc nao vet (mau so): <"
(itoa oldk)
"> : "
)
)
)
(if (null k) (setq k oldk))
(setq d (cond (d) (5)))
(setq oldd d)
(setq d (getreal (strcat "\nChieu sau nao vet: <"
(rtos oldd 2 1)
"> : "
)
)
)
(if (null d) (setq d oldd))
(setq hei (cond (hei) (0.5)))
(setq oldhei hei)
(setq hei (getreal (strcat "\nChon chieu cao chu: <"
(rtos oldhei 2 1)
"> : "
)
)
)
(if (null hei) (setq hei oldhei))
(setq p1 (getpoint "\nChon bien luong ben trai mat cat: ")
p2 (getpoint "\nChon bien luong ben phai mat cat: ")
p11 (list (+ (car p1) k) (- (cadr p1) 1) 0.0)
p21 (list (- (car p2) k) (- (cadr p2) 1) 0.0))
(setq objD (vla-copy (vlax-ename->vla-object en)))
(vla-move objD (vlax-3d-point (list 0.0 0.0 0.0)) (vlax-3d-point (list 0.0 (- d) 0.0)))
(setq objR1 (taoRay *Model* p1 p11)
objR2 (taoRay *Model* p2 p21))
(setq enR1 (vlax-vla-object->ename objR1)
enR2 (vlax-vla-object->ename objR2)
enD (vlax-vla-object->ename objD))
(setq PA (vlax-curve-getStartPoint enD)
PB (vlax-curve-getEndPoint enD)
)
(setq pin1 (car (giaoDT enR1 enD))
pin2 (car (giaoDT enR2 enD)))
(vla-delete objR1)
(vla-delete objR2)
(setvar "osmode" 0)
(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))
)
)
(setq objL2 (taoline *Model* p2 pin2)
ang2 (vla-get-Angle objL2)
enL2 (vlax-vla-object->ename objL2)
objL1 (taoline *Model* p1 pin1)
ang1 (vla-get-Angle objL1)
enL1 (vlax-vla-object->ename objL1)
)
(vl-cmdf ".pedit" "m" enL1 end enL2 "" "" "j" "" "")
(vla-put-layer (vlax-ename->vla-object (entlast)) "naovet")
(setq poTex1 (polar (ACET-GEOM-MIDPOINT p1 pin1) (- ang1 (/ pi 2)) (/ hei 2)))
(TextTaluy *Model* k poTex1 hei ang1)
(setq poTex2 (polar (ACET-GEOM-MIDPOINT p2 pin2) (+ ang2 (/ pi 2)) (/ hei 2)))
(TextTaluy *Model* k poTex2 hei (+ ang2 pi))
(vla-EndUndoMark ActDoc)
(princ)
)

  • 3

#2550 Minh_Ha

Minh_Ha

    biết zoom

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

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

- Chào cadviet. Hôm nay mình có 1 việc nhờ mọi người viết dùm mình 1 đọan lisp in nhiều bản vẽ cùng lúc trong 1 file cad,
mình có tìm trên cadviet có phần Mplot của bạn Nguyen Hoanh sử dụng rất hiệu quả nhưng do công ty mình dùng cadLT bản quyền nên không dùng được *.VLX. Công việc của mình in rất nhiều nên mình rất cần đọan lisp tương tự như Mplot. Đọan lisp chỉ cần chọn Block là khung bản vẽ và in tòan bộ bản vẽ đó ra. Rất mong sự giúp đỡ của mọi người.
  • 0

#2551 hailuavnn

hailuavnn

    biết vẽ ellipse

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

Đã gửi 12 August 2009 - 04:35 PM

Bạn có thể post yêu cầu về autolisp ở topic này.

Cadviet.com có thể viết dùm mình một lisp giống như lệnh Wall trong Revit được không nghĩa là lúc mình chọn lệnh (giả sử là Wall đi nha) thì lisp sẽ cho mình chọn chiều dày tường (100 hoặc 200) sau đó chọn cách vẽ ( theo tâm trục hoặc theo biên) và các Wall khi vẽ khi giao nhau sẽ cắt nhau luôn không.

Bài viết đã được chỉnh sửa nội dung bởi hailuavnn: 14 August 2009 - 02:12 PM

  • 0

#2552 thanhlamct

thanhlamct

    biết lệnh offset

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

Đã gửi 12 August 2009 - 06:41 PM

Chào các bác!
Mình có một tuyến ống đặt trong file đo đạc địa hình, trên đó có rất nhiều các điểm cốt mặt đất, trên tuyến ống đã đánh số thứ tự của các cọc tính toán (ví dụ 50m/cọc). các cọc này là các block tên là "coc".
Mình cần 1 file lisp có chức năng: sau khi select các block "coc" thì lấy 1 giá trị cốt mặt đất gần các block đó nhất và xuất ra 1 file excel.
Có ai biết thì giúp mình với.
Xin cảm ơn!
  • 0

#2553 hailuavnn

hailuavnn

    biết vẽ ellipse

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

Đã gửi 14 August 2009 - 02:13 PM

Cadviet.com có thể viết dùm mình một lisp giống như lệnh Wall trong Revit được không nghĩa là lúc mình chọn lệnh (giả sử là Wall đi nha) thì lisp sẽ cho mình chọn chiều dày tường (100 hoặc 200) sau đó chọn cách vẽ ( theo tâm trục hoặc theo biên) và các Wall khi vẽ khi giao nhau sẽ cắt nhau luôn không.

Không có ai trả lời mình hết vậy ta :bigsmile: :bigsmile: :bigsmile: :)
  • 0

#2554 tomboy

tomboy

    biết vẽ polygon

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

Đã gửi 14 August 2009 - 04:44 PM

Chào các bác!
Mình có một tuyến ống đặt trong file đo đạc địa hình, trên đó có rất nhiều các điểm cốt mặt đất, trên tuyến ống đã đánh số thứ tự của các cọc tính toán (ví dụ 50m/cọc). các cọc này là các block tên là "coc".
Mình cần 1 file lisp có chức năng: sau khi select các block "coc" thì lấy 1 giá trị cốt mặt đất gần các block đó nhất và xuất ra 1 file excel.
Có ai biết thì giúp mình với.
Xin cảm ơn!

------------------------------------------
ok, mình đã viết xong cho bạn rồi, bạn hãy làm theo cách này nhé:
thứ nhất : thứ tự của các cọc phải nằm trong layer "STT" , cao độ mặt đất phải nằm trong lớp "DO CAO" và tên Block phải là "COC" và có điểm chèn của Block phải nằm lân cận Block đó, nếu nằm đúng tim của nó thì càng tốt. tất cả Layer và tên Block không phân biệt chữ hoa hay thường
thứ hai: tên của số thứ tự phải nằm gần Block đó, không phân biệt Number hay alphabet, nếu là number thì càng tốt
thứ ba: tất cả các đối tượng đang xét đó phải là TEXT và không được lock nhé:
Note: Lệnh là XLS, nếu trùng lệnh nào trong acad thì bạn hãy dùng notepad để sửa lại nhé, cách sửa tìm chữ C:XLS có trong file đó và sửa thành C: + TÊN LỆNH mà bạn muốn.
(defun c:xls (/ input xuly output data val)
(defun input (/ text_loc sset stt docao block sslen i entn entg dxf la
p blname)
(defun text_loc (entn / p entg text jum72 jum73 i loc ketqua)
(setq p '())
(setq entg (entget entn))
(setq text (cdr (assoc 0 entg)))
(if (= text "TEXT")
(progn
(setq jum72 (cdr (assoc 72 entg)))
(setq jum73 (cdr (assoc 73 entg)))
(cond
((= jum72 1) (setq i 11))
((= jum72 2) (setq i 11))
((= jum72 4) (setq i 11))
((= jum72 3) (setq i 10))
((= jum72 5) (setq i 10))
((= jum72 0)
(progn
(if (= jum73 0)
(setq i 10)
(setq i 11)
)
)
)
)
(setq loc (cdr (assoc i entg)))
(setq p loc)
)
)
(setq ketqua p)
)
;;; ----------mainsub----------
(alert
"\n B¹n ph¶i ®Æt tªn Layer vµ Block nh­ sau:
\nLayer: \"STT\" lµ sè thø tù cäc, \"Do cao\" lµ ®é cao mÆt ®Êt
\nBlock: ®Æt tªn lµ \"Coc\""
)
(setq sset (ssget))
(setq stt '()
docao '()
block '()
sslen (sslength sset)
i 0
)

(if sset
(progn
(repeat sslen
(setq entn (ssname sset i))
(setq entg (entget entn))
(setq dxf (cdr (assoc 0 entg)))
(cond
((= dxf "TEXT")
(progn
(setq la (strcase (cdr (assoc 8 entg))))
(cond
((= la "STT")
(setq p (text_loc entn)
p (subst 0 (nth 2 p) p)
stt
(append
stt
(list
(list (cdr (assoc 1 entg)) p)
)
)
)
)
((= la "DO CAO")
(setq p (text_loc entn)
p (subst 0 (nth 2 p) p)
docao (append docao
(list (list (cdr (assoc 1 entg))
p
)
)
)
)
)
)
)
)
((= dxf "INSERT")
(progn
(setq blname (strcase (cdr (assoc 2 entg))))
(if (= blname "COC")
(setq p (cdr (assoc 10 entg))
p (subst 0 (nth 2 p) p)
block (append block (list p))
)
)
)
)
)
(setq i (+ i 1))
)
)
)
(list stt docao block)
)
;;; -------------end input--------------
(defun xuly (data / stt docao block len i n kqbl
pbl j mss line txt p d kq kqtt
linett ptt linebl caodo
)
(setq stt (nth 0 data)
docao (nth 1 data)
block (nth 2 data)
)
(if (and stt docao block)
(progn
(setq len (length block)
i 0
n (length docao)
kqbl '()
)
(repeat len
(setq pbl (nth i block))
(setq j 0)
(setq mss 2000000000)
(repeat n
(setq line (nth j docao)
txt (nth 0 line)
p (nth 1 line)
d (distance pbl p)
)
(if (< d mss)
(setq mss d
kq (list txt pbl)
)
)
(setq j (+ j 1))
)
(setq kqbl (append kqbl (list kq)))
(setq i (+ i 1))
)
(setq len (length stt)
i 0
n (length kqbl)
kqtt '()
)
(repeat len
(setq linett (nth i stt)
tt (nth 0 linett)
ptt (nth 1 linett)
j 0
n (length kqbl)
mss 2000000000
)
(repeat n
(setq linebl (nth j kqbl)
caodo (nth 0 linebl)
pbl (nth 1 linebl)
j (+ j 1)
d (distance ptt pbl)
)
(if (< d mss)
(setq mss d
kq (list tt caodo (atof tt))
)
)
)
(setq kqtt (append kqtt (list kq)))
(setq i (+ i 1))
)
(setq kqtt (vl-sort kqtt
(function (lambda (e1 e2)
(< (nth 2 e1) (nth 2 e2))
)
)
)
)
)
)
kqtt
)
;;; -------------end xuly --------------
(defun output (val / path fn f n i line lines)
(if val
(progn
(setq path (getvar "dwgprefix"))
(setq fn
(getfiled "Select a Lisp File" path "txt;dat;sl;kq;elv" 1)
)
(if fn
(progn
(setq f (open fn "w"))
(setq n (length val)
i 0
)
(repeat n
(setq line (nth i val)
lines (strcat (nth 0 line) "\t" (nth 1 line))
i (+ i 1)
)
(write-line lines f)
)
(close f)
)
)
(alert (strcat "Xem kÕt qu¶ trong file: " fn))
)
)
)
;;; --------------------MAIN------------------
(setq data (input))
(setq val (xuly data))
(output val)
)
  • 1

#2555 tomboy

tomboy

    biết vẽ polygon

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

Đã gửi 14 August 2009 - 05:02 PM

- Chào cadviet. Hôm nay mình có 1 việc nhờ mọi người viết dùm mình 1 đọan lisp in nhiều bản vẽ cùng lúc trong 1 file cad,
mình có tìm trên cadviet có phần Mplot của bạn Nguyen Hoanh sử dụng rất hiệu quả nhưng do công ty mình dùng cadLT bản quyền nên không dùng được *.VLX. Công việc của mình in rất nhiều nên mình rất cần đọan lisp tương tự như Mplot. Đọan lisp chỉ cần chọn Block là khung bản vẽ và in tòan bộ bản vẽ đó ra. Rất mong sự giúp đỡ của mọi người.

ý tưởng của bạn rất hay tại vì mình thấy công việc in ấn trên bản vẽ là rất vất vả nếu như đang gấp mà phải đóng hồ sơ đi mà lúc đó mới in bản vẽ thì quả là rất cực . nhiều lúc mình cũng muốn viết 1 đoạn code để giải quyết công việc này nhưng tại vì nếu viết ra thì người sử dụng nó bắt buộc phải quản lý bản vẽ theo 1 tiêu chuẩn riêng do đó sẽ khó khăn hoặc không thuận tiện cho những người chưa rành về cad. công việc này đòi hỏi bạn muốn in bản vẽ nào thì phải áp khung bản vẽ đó, mà khung bản vẽ đó phải do tác giả lập nên, do vậy để thuận tiện cho cả người dùng lẫn người viết chương trình thì bạn có thể gửi cho mình 1 số khung bản vẽ được không, vụ KHUNG A1, A2, A3, A4 chứ không mình viết xong lại không đúng với tiêu chuẩn khung của bạn đang xài. đc email của mình: qanh060275@yahoo.com và gửi thêm 1 bản vẽ mà bạn đã sắp xếp thứ tự để chỉ việc in rồi nhé:
  • 0

#2556 tomboy

tomboy

    biết vẽ polygon

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

Đã gửi 14 August 2009 - 05:09 PM

Không có ai trả lời mình hết vậy ta :bigsmile: :bigsmile: :bigsmile: :)

trong lĩnh vực thiết kế xây dựng của bạn thì mình không rành về chuyên môn lắm, nên bạn có thể gửi bản vẽ có wall trong đó đc không, tại vì mình không biết wall mà bạn vẽ thuộc đối tượng nào: LINE hay LWPOLYLINE, vẽ nét đôi hay nét đơn ... và tim trục nằm ở đâu. Nếu được mình sẽ cố gắng giúp bạn
  • 0

#2557 duytrung

duytrung

    biết pan

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

Đã gửi 15 August 2009 - 10:24 AM

Các bạn có lisp chuyển text của font TCVN3(ABC) về font VNI Windows cho tớ xin nha. Chứ chuyển thủ công đuối quá.
  • 0

#2558 duy782006

duy782006

    PHẠM QUỐC DUY

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

Đã gửi 15 August 2009 - 10:32 AM

Các bạn có lisp chuyển text của font TCVN3(ABC) về font VNI Windows cho tớ xin nha. Chứ chuyển thủ công đuối quá.

(Hiện nay mình mới viết được phần này còn chuyễn ngược lại thì chưa thành công).
*Tên lệnh: TCVN-VNI
Nhập lệnh xong lisp hỏi chọn đối tượng bạn chọn các text muốn chuyễn mã lisp sẽ tự tạo 1 textstyle tên THEP font VNI-HELVE và chuyễn các text này về textstryle này tất nhiên đã chuyễn mã rồi, bây giờ bạn có thể chỉnh sửa các text này bằng bảng mã VNI.*** như bình thường. Lưu ý các text sau khi chuyễn mã sẽ viết hoa toàn bộ bất kể trước đó viết thường hay hoa.
http://www.4shared.c...b/chuyenma.html
  • 3

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#2559 viennv

viennv

    biết zoom

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

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

Chào các bác! Em muốn đánh số thứ tự 1A, 2A, 3A ... . Bác nào đã viết lisp mà chỉ cần copy 1A thì tự động
những text sau là 2A, 3A ko a. Nếu có thì có thể post lên được ko ạ. Cảm ơn các bác nhiều.
  • 0

#2560 viennv

viennv

    biết zoom

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

Đã gửi 15 August 2009 - 12:17 PM

Chào các bác! Em muốn đánh số thứ tự 1A, 2A, 3A ... . Bác nào đã viết lisp mà chỉ cần copy 1A thì tự động
những text sau là 2A, 3A ko a. Nếu có thì có thể post lên được ko ạ. Cảm ơn các bác nhiều.
  • 0