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

#561 ut_cung

ut_cung

    biết vẽ line

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

Đã gửi 17 December 2009 - 01:33 PM

Cứ để em nó (ut_cung) chọn rồi sẽ tự rút kinh nghiệm
Mọi việc thêm rối vì mấy cái "báo cáo" :(

Trời! bác làm như thế là làm khó út rồi. Trong bản vẽ của u có rất nhiều text, mà không phải cái nào cũng chông lên nhau, có cái chồng lên minh mới di chuyển ra thôi, có nó đứng 1 mình thì chứ mặt kệ nó. đúng là như bác Tuệ nói, làm như thế các text trong bản vẽ sẽ rối tung mất.
Bác tuệ giúp út với!
Thank!
  • 0

#562 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 17 December 2009 - 02:50 PM

Trời! bác làm như thế là làm khó út rồi. Trong bản vẽ của u có rất nhiều text, mà không phải cái nào cũng chông lên nhau, có cái chồng lên minh mới di chuyển ra thôi, có nó đứng 1 mình thì chứ mặt kệ nó. đúng là như bác Tuệ nói, làm như thế các text trong bản vẽ sẽ rối tung mất.
Bác tuệ giúp út với!
Thank!

Út sử dụng code này nhé :

(defun c:sxt()
(vl-load-com)
;copyright by Tue_NV
(setq ss (ssget '((0 . "*TEXT"))) i 0 lispobj (list))
(setq kc (getdist "\n Khoang cach giua cac Text :"))
(while (< i (sslength ss))
(vla-getboundingbox (setq obj (vlax-ename->vla-object (ssname ss i))) 'bl 'tl)
(setq lispobj (cons (cons (safearray-value bl) obj) lispobj))
(setq i (1+ i))
)
(setq lispobj (vl-sort lispobj
'(lambda (x y)
(< (caar x) (caar y))
)
)
)
(setq i 0)
(foreach x lispobj
(setq des (list (+ (caaar lispobj) (* i kc)) (cadar x) 0))
(vla-move (cdr x) (vlax-3d-point (car x)) (vlax-3d-point (caar lispobj)))
(vla-move (cdr x) (vlax-3d-point (caar lispobj)) (vlax-3d-point des))
(setq i (1+ i))
)
(princ "Chuc ban lam viec hieu qua _ Tue_NV")
)

Út có thể thiết lập khoảng cách giữa các text bằng cách pick 2 điểm trên màn hình. Lúc đó khoảng cách giữa 2 điểm mà Út vừa Pick đó là khoảng cách Text
Chúc vui vẻ
  • 1

#563 trinhvqh

trinhvqh

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 408 Bài viết
Điểm đánh giá: 222 (khá)

Đã gửi 17 December 2009 - 03:19 PM

LISP Sexy Text (Sxt) của Tue_NV khá phù hợp với Ut_cung.
Nhưng nó hơi "cà chớn" một chút nếu chọn 02 nhóm đối tượng một lúc
Tue_NV nghiên cứu thêm để chỉnh lại
Nếu khắc phục được thì mới là Sắp xếp Text :(

http://www.cadviet.c...files/2/sxt.rar
  • 0

#564 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 17 December 2009 - 04:15 PM

Mình có bản vẽ gồm các block thuộc tính như hình

Hình đã gửi

Đây là các block tên cọc trắc ngang, khi chỉnh tuyến đôi lúc mình phải dùng tay điều chỉnh lại các lý trình cọc vì vậy mình muốn nhờ các bạn trên diễn đàn giúp mình 1 lisp lọc giá trị lý trình ( bỏ các giá trị trước dấu "+" lấy các giá trị sau ) trong Tag : LT_COC , ví dụ trong bản vẽ là bỏ giá trị "92+" lấy giá trị còn lại rồi công hay trừ cho 1 số bất kỳ được không .
Đây là file bản vẽ của mình
http://www.cadviet.c...es/2/tencoc.zip
Cảm ơn nhiều !

Chào bạn Cadviet.MTV,
Bạn xài thử lisp này xem có vừa ý không nhé.

(defun etxt (txt / a n i j c)
(setq a (getstring "\n Nhap ky tu danh dau: ")
n (strlen txt)
i 1)
(while (<= i n)
(setq c (substr txt i 1))
(if (= c a)
(setq j i)
)
(setq i (1+ i))
)
(setq txts (atof (substr txt (1+ j) (- n j))))
txts
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ctc ()
(setq d (getreal "\n Nhap khoang cach muon chinh: ")
ans (getstring "\n Ban muon tiep tuc < y or n > : " ))
(While (= ans "y")
(setq bl (car (entsel "\n chon block muon chinh" ))
blst (entget bl))
(if (/= (cdr (assoc 0 blst)) "INSERT")
(progn
(alert "\n Doi tuong chon khong phai block, hay chon lai")
(setq bl (car (entsel "\n chon block muon chinh" ))
blst (entget bl))
)
)
(if (/= (cdr (assoc 66 blst)) 1)
(progn
(alert "\n Doi tuong chon khong chua thuoc tinh, hay chon lai")
(setq bl (car (entsel "\n chon block muon chinh" ))
blst (entget bl))
)
)
(while (not (equal (cdr(assoc 0 (entget(entnext bl)))) "SEQEND"))
(setq bl (entnext bl)
blst (entget bl))
(if (= (cdr (assoc 2 blst)) "LT_COC" )
(progn
(setq txt (cdr (assoc 1 blst)))
(etxt txt )
(setq blst (subst (cons 1 (rtos (+ txts d) 2 2)) (assoc 1 blst) blst))
(entmod blst)
(entupd bl)
)
)
)
(setq ans (getstring "\n Ban muon tiep tuc < y or n > : "))
)
(princ)
)


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.

#565 duy782006

duy782006

    PHẠM QUỐC DUY

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

Đã gửi 18 December 2009 - 07:58 AM

Line nằm trên layer hiện hành (do người sử dụng thiết lập trước)
khoảng hở line và text tỷ lệ theo chiều cao text do người sử dụng nhập trong command line
Chiều dài line bằng chiều dài text
Nếu được , lisp có hai tùy chọn: line dưới text và trên text

Bạn thử xem:
-Thao tác:
+Nhập lệnh: GCM
+Chọn đối tượng (chọn vô tư lisp tự lọc và nhận các đối tượng text) xong thì enter.
+Lisp hỏi Gach phia: Tren/ text: Bạn nhập T thì gạch trên, D thì gạch dưới (enter sẽ mặc định là gạch dưới).
+Lisp hỏi Khoang cach line voi text bang do lon text chia < 5>: Mặc định khoảng cách line với text là 1/5 độ lớn text muốn thay đổi thì bạn gỏ vào, không thì enter.
*Lisp này chưa tối ưu hóa được nhưng hiện mình đang bận nên không tiếp tục hoàn thiện được bạn dùng tạm vậy.
http://www.cadviet.c.../gachchantd.lsp
  • 1

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


#566 ut_cung

ut_cung

    biết vẽ line

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

Đã gửi 18 December 2009 - 08:36 AM

Út sử dụng code này nhé :


(defun c:sxt()
(vl-load-com)
;copyright by Tue_NV
(setq ss (ssget '((0 . "*TEXT"))) i 0 lispobj (list))
(setq kc (getdist "\n Khoang cach giua cac Text :"))
(while (< i (sslength ss))
(vla-getboundingbox (setq obj (vlax-ename->vla-object (ssname ss i))) 'bl 'tl)
(setq lispobj (cons (cons (safearray-value bl) obj) lispobj))
(setq i (1+ i))
)
(setq lispobj (vl-sort lispobj
'(lambda (x y)
(< (caar x) (caar y))
)
)
)
(setq i 0)
(foreach x lispobj
(setq des (list (+ (caaar lispobj) (* i kc)) (cadar x) 0))
(vla-move (cdr x) (vlax-3d-point (car x)) (vlax-3d-point (caar lispobj)))
(vla-move (cdr x) (vlax-3d-point (caar lispobj)) (vlax-3d-point des))
(setq i (1+ i))
)
(princ "Chuc ban lam viec hieu qua _ Tue_NV")
)

Út có thể thiết lập khoảng cách giữa các text bằng cách pick 2 điểm trên màn hình. Lúc đó khoảng cách giữa 2 điểm mà Út vừa Pick đó là khoảng cách Text
Chúc vui vẻ

Cảm ơn Bác Tuệ đã giúp đỡ!
Bác Tuệ sữa lại giúp út tí nữa nha. Nếu mình quét tấc cả các text nhưng chỉ những text đè lên nhau thì mới sắp xếp lại còn những text không đè lên nhau thì vẫn đứng yên. Thứ hai là khoảng cách các text nếu không nhập lai thì mặt đinh chọn khoảng cách vừa chọn trước đó. thứ 3 là các text được canh về hai phía chứ không phải một phía. Cảm ơn Bác nhiều. Chúc Bác luôn khỏe!
file cad: http://www.cadviet.c...les/2/thu_2.dwg
  • 0

#567 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 18 December 2009 - 08:48 AM

Chào mọi người!
hôm trước mình có tìm được cái lisp mplot dùng thấy rất hay nhưng giờ gặp vấn đề mong anh em giúp đỡ.
Khi mình in bên model thì ok nhưng khi in bên layout thì lisp báo lỗi:
"Command: MPL
Select objects: Specify opposite corner: 1 found
Select objects:
1=0.20
Yes or No, please.
Yes or No, please.
; error: An error has occurred inside the *error* functionFunction cancelled
Save changes to page setup [Yes/No]? *Cancel*"
Ai biết chỉ dùm mình với. Cảm ơn nhiều!
file cad: http://www.cadviet.c...es/2/tnct_7.dwg
(in với block tên là : in)

Cái MPL này của Bác Hoành, không biết mấy hom nay Bác đi đâu nhỉ!
lisp mpl: http://www.cadviet.c...s/2/mplot_2.rar
ai biết giúp mình với!
  • 0
Học học nữa học mãi.
Đúp học lại!

#568 lavos

lavos

    biết pan

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

Đã gửi 18 December 2009 - 08:51 PM

Chào mọi người.
Mình cần LISP dùng tắt lệnh UCS (đổi trục) ở chế độ chọn 3 điểm trên 1 mặt phẳng. Bình thường phải nhập UCS rồi chọn 3. Mình muốn lệnh tắt luôn là U3.
Có bạn nào có thể giúp mình được không?
:(
  • 0

#569 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 19 December 2009 - 08:24 AM

Chào mọi người.
Mình cần LISP dùng tắt lệnh UCS (đổi trục) ở chế độ chọn 3 điểm trên 1 mặt phẳng. Bình thường phải nhập UCS rồi chọn 3. Mình muốn lệnh tắt luôn là U3.
Có bạn nào có thể giúp mình được không?
:(

Học lisp đi, bạn sẽ tự làm được vài... trăm cái tiện ích nho nhỏ như vậy nhưng rất hiệu quả khi sử dụng.
Lisp theo yêu cầu của bạn:

(defun C:U3() (command "ucs" 3))

Đơn giản không ấy mà!
  • 3

#570 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 19 December 2009 - 03:43 PM

Mình có bản vẽ gồm các block thuộc tính như hình

Hình đã gửi

Đây là các block tên cọc trắc ngang, khi chỉnh tuyến đôi lúc mình phải dùng tay điều chỉnh lại các lý trình cọc vì vậy mình muốn nhờ các bạn trên diễn đàn giúp mình 1 lisp lọc giá trị lý trình ( bỏ các giá trị trước dấu "+" lấy các giá trị sau ) trong Tag : LT_COC , ví dụ trong bản vẽ là bỏ giá trị "92+" lấy giá trị còn lại rồi công hay trừ cho 1 số bất kỳ được không .
Đây là file bản vẽ của mình
http://www.cadviet.c...es/2/tencoc.zip
Cảm ơn nhiều !

Hề hề hề, chào bạn Cadviet_MTV,
Sau khi làm cái lisp trước gửi bạn, thấy có điểm bất tiện là mỗi lần chỉnh chỉ chọn được một em, mà như vậy có vẻ chưa thuận lợi lắm cho bạn, mình cải tiến nó đi một tí thành cái lisp mới này, cho phép bạn :
1/- một lần sửa chọn được nhiều em với điều kiện các em phải có cùng khoảng cách thêm hay bớt và phải có cùng ký tự đánh dấu. Muốn vậy khi lisp hỏi bạn nhập ký tự danh dấu chung bạn sẽ nhập nó vào (ở trường hợp bạn nêu ví dụ là dấu "+".)
2/- Chọn nhiều em nhưng chỉnh từng em với điều kiện chì có chung khoảng cách chỉnh sửa nhưng khác ký tự đánh dấu. Ví dụ như : 92+218.27 và 92-106.08
Khi đó khi lisp yêu cầu bạn nhập ký tư đánh dấu chung thì bạn enter để bỏ qua và lisp sẽ yêu cầu bạn nhập ký tự đánh dấu riêng.

Do không chuyên về công việc của bạn nên có thể chưa hiểu hết các yêu cầu bạn đặt ra. Mình cứ mạo muội gửi lisp này để bạn xài thử và góp ý, Nếu cần chỉnh sửa gì bạn cứ nêu lên mình tin là mọi người sẽ gỡ được bạn ạ.
Chúc bạn thành công trong công việc và cuộc sống. Hề hề hề.
Nó đây bạn ơi:

(defun etxt (txt a / n i j b )
(if (= a "")
(setq a (getstring "\n Nhap ky tu danh dau rieng: "))
)
(setq n (strlen txt)
i 1)
(while (<= i n)
(setq b (substr txt i 1))
(if (= b a)
(setq j i)
)
(setq i (1+ i))
)
(setq txts (atof (substr txt (1+ j) (- n j))))
txts
a
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ctc ()
(setq ans (getstring "\n Ban muon chinh gia tri cua block ten coc < y or n > : " ))
(While (= ans "y")
(setq d (getreal "\n Nhap khoang cach muon chinh: "))
(setq a (getstring "\n Nhap ky tu danh dau chung: "))
(setq ss (ssget (list (cons 0 "INSERT") (cons 66 1)))
i 0
n (sslength ss))
(while (and ss (< i n))
(setq bl (ssname ss i)
blst (entget bl))
(while (not (equal (cdr(assoc 0 (entget(entnext bl)))) "SEQEND"))
(setq bl (entnext bl)
blst (entget bl))
(if (= (cdr (assoc 2 blst)) "LT_COC" )
(progn
(setq txt (cdr (assoc 1 blst)))
(etxt txt a)
(setq blst (subst (cons 1 (rtos (+ txts d) 2 2)) (assoc 1 blst) blst))
(entmod blst)
(entupd bl)
)
)
)
(setq i (1+ i))
)
(setq ans (getstring "\n Ban muon tiep tuc < y or n > : ")
a "")
)
(princ)
)

  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#571 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 19 December 2009 - 04:56 PM

Nhờ các Bác giúp sửa dùm cái Lisp này.
Bản vẽ, các notes và Lisp có trong link này. Cám ơn nhiều
http://www.cadviet.c...cho_holes_2.zip

Hình đã gửiHình đã gửi
  • 0

#572 lavos

lavos

    biết pan

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

Đã gửi 19 December 2009 - 08:37 PM

Học lisp đi, bạn sẽ tự làm được vài... trăm cái tiện ích nho nhỏ như vậy nhưng rất hiệu quả khi sử dụng.
Lisp theo yêu cầu của bạn:

(defun C:U3() (command "ucs" 3))

Đơn giản không ấy mà!



Cám ơn bạn ssq nhiều lắm =) mình cũng muốn học LISP nhưng chưa có thời gian với cả nhìn mấy cái code là mình muốn :( rồi..=s

btw mình muốn hỏi cái LISP này: ví dụ mình lưu các chế độ màn hình đật tên là 1, 2, 3... mình muốn dùng lệnh v1, v2, v3... để xem các chế độ màn hình đó... Và muốn để các chế độ màn hình xem từ bên trái, bên phải, từ trên xuống, từ duới lên là L1, R1, U1, D1

Có bạn nào giúp mình được k?
  • 0

#573 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 20 December 2009 - 09:17 AM

1- mình cũng muốn học LISP nhưng chưa có thời gian
2- với cả nhìn mấy cái code là mình muốn :( rồi..=s
3- mình muốn hỏi cái LISP này: ví dụ mình lưu các chế độ màn hình đật tên là 1, 2, 3... mình muốn dùng lệnh v1, v2, v3... để xem các chế độ màn hình đó... Và muốn để các chế độ màn hình xem từ bên trái, bên phải, từ trên xuống, từ duới lên là L1, R1, U1, D1
4- Có bạn nào giúp mình được k?

1- Thời gian 24h/ngày như nhau với tất cả mọi người. Bạn có nhu cầu thì tự khắc bạn sẽ sắp xếp được!
2- Vấn đề tâm lý thôi, ban đầu ai cũng vậy. Bạn thử làm được 1 cái sẽ không còn cảm giác đó nữa.
3- Mấy cái này dễ ợt, cần gì phải nhờ vả người khác!
4- Có! Người đó chính là bạn!
Tạm thời, ssg sẽ giúp bạn, nhưng ssg không cho cá, cũng không cho cần câu mà chỉ hướng dẫn bạn cách làm cần câu. Nếu đồng ý thì hãy cùng ssg làm các bước sau:

1- Nhập lệnh trực tiếp
Tại dòng command, gõ lệnh -view (dấu - ở trước có tác dụng không hiện hộp thoại mà chỉ thao tác bằng dòng lệnh). Nhập o, sau đó nhập l -> bạn sẽ thấy Left view

2- Chương trình lisp để xem Left view
(defun C:VL()
(command "view" "O" "L")
)
3- Phân tích
Dòng 1: có tác dụng khai báo với AutoCAD rằng, tôi muốn định nghĩa một lệnh mới có tên là VL. Tên lệnh nằm sau C:. Defun tức là Define a Function - định nghĩa một hàm, một chức năng.
Dòng 2: hoàn toàn tương tự với các thao tác khi bạn nhập lệnh trực tiếp với AutoCAD. Điểm khác duy nhất là toàn bộ các thao tác đã được lập trình trước. Đọc đến dòng này, AutoCAD sẽ hiểu rằng, bạn muốn thực hiện lệnh "view" sau đó nhập "O", nhập "L".
Dòng 3: là dấu đóng ngoặc cho cái mở ngoặc đầu tiên ở dòng 1 (đã mở thì phải đóng, đơn giản vậy thôi)
Chia ra 3 dòng để phân tích cho dễ, bạn có thể gom chúng lại thành 1 dòng duy nhất cho gọn, nó vẫn chạy tốt:
(defun C:VL() (command "view" "O" "L"))

4- Phát triển
"Thừa thắng xông lên", bạn sẽ làm được Top view, Right view, SE view, SW view..., và cũng không chỉ với "các loại view" mà với bất cứ loạt thao tác nào bạn muốn AutoCAD thực hiện tự động theo ý đồ của bạn. Nếu có chỗ nào chưa hiểu lắm thì cũng mặc xác nó, bạn hãy làm như... các em bé, cứ bắt chước y chang như người lớn làm. Dần dần rồi sẽ hiểu!

Hãy dành một chút thời gian suy ngẫm về toàn bộ các ý tứ mà ssg đã chuyển tải đến bạn.
Chúc bạn thành công!
  • 2

#574 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

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

Nhờ các Bác giúp sửa dùm cái Lisp này.
Bản vẽ, các notes và Lisp có trong link này. Cám ơn nhiều
http://www.cadviet.c...cho_holes_2.zip

Hình đã gửiHình đã gửi

Hề hề hề,
Chịu rồi, chịu thua rồi.
Mình xài CAD2004 nên khi load lisp, nó bảo là không chơi, chỉ chơi với thằng 2005.
Vậy nên chả biết đằng nào mà sửa, 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.

#575 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 21 December 2009 - 12:51 PM

Hề hề hề,
Chịu rồi, chịu thua rồi.
Mình xài CAD2004 nên khi load lisp, nó bảo là không chơi, chỉ chơi với thằng 2005.
Vậy nên chả biết đằng nào mà sửa, hề hề hề.

Thank you Bác, thôi thì Bác viết giúp em 1 cái Lisp mới vậy.
Merry Christmas and Happy New Year!

Lisp này có thể sửa lại để select các Circles và Line rồi ghi text như bản vẽ đã upload.
;; free lisp from cadviet.com
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td (/ diem PT1 PT2 PT3 tapx tapy
           x y xx yy h n di kc
           C PT PTX PTY PTD PTC N
           p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
  (setq om (getvar "osmode"))
  (setq tapx '()
    tapy '()
    stt '()
    k 0
    h (getreal "\nnhap chieu cao chu:"))
    
(while
  (setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
  (progn
    (setq   PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
        PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
         x (rtos(car diem) 2 4)
             y (rtos (cadr diem) 2 4)
       tapx (append tapx (list x))
       tapy (append tapy (list y))
         k (+ 1 k)
         N (strcat "P" (rtos k 2 0))
        stt (append stt (list N))
      );setq
  (setvar "osmode" 0)
  (command "text" "j" "BL" PT1 h 0 x)
  (setq TB (textbox (entget(entlast)))
    LC (car TB)
    RC (cadr TB)
    di (distance LC RC)
    PT3 (polar PT1 0 (+ di h))
    C  (polar PT3 0 (* 1.5 h))
   );setq
    (command "text" PT2 h 0 y
         "pline" diem PT1 PT3 ""
         "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
         "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )
    
    (setvar "osmode" om)
    );progn  
  );dong while
  
;tao bang thong ke
  (setq    kc (* 2 di)
        PT (getpoint"\nvi tri dat bang :")
    PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
      p1 (list (car PT) (+ (cadr PT)(* 2 h)))
      p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
          p3 (list (car p1) (+ (cadr p1)(* 2 h)))
      p4 (list (car p2) (+ (cadr p2)(* 2 h)))
    PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
    PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
    PTY (list (+ kc (car PTX)) (cadr PTX))
      p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
      p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
      p33 (list (+ kc (car p22)) (cadr p22))
      L1 (list (+ di (car p3))(cadr p3))
      L2 (list (+ kc (car L1))(cadr L1))
     n (length tapx)
     k 0
    );setq
(setvar "osmode" 0)
  (command "line" p1 p2 ""
       "text" "j" "m" p11 h 0 ""
       "text" "j" "m" p22 h 0 "X"
       "text" "j" "m" p33 h 0 "Y"
       "line" p3 p4 "")    

  (while (< k n)
    (setq xx (nth k tapx)
      yy (nth k tapy)
     tstt(nth k stt))
    (command "text" "j" "m" PTD h 0 tstt
             "text" "j" "m" PTX h 0 xx
         "text" "j" "m" PTY h 0 yy
         "line" PT PTC "")    
    (setq PT (list (car PT) (- (cadr PT)(* 2 h)))
         PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
     PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
     PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
     PTY (list (+ kc (car PTX)) (cadr PTX))
      k (+ 1 k));setq
  );while
  (if (= k n)
    (setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
          PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
      L11 (list (+ di (car PT))(cadr PT))
      L22 (list (+ kc (car L11))(cadr L11))
      );setq
    );if
(command "line" p3 PT ""
          "line" p4 PTC ""
      "line" L1 L11 ""
      "line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
  (command "Undo" "End")
  (princ)
);DONG toado

  • 0

#576 tieu_ngu_nhi_43

tieu_ngu_nhi_43

    biết zoom

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

Đã gửi 21 December 2009 - 05:20 PM

-Bạn nào có lisp có chức năng như sau thì cho mình nhé:
+ Đo và điền giá trị diện tích hatch
+ Cộng tổng diện tích các hatch được chọn rồi ghi ra text
>>> Chân thành cảm ơn

Mình đâu cần phải dùng lisp mà cũng tính đc thôi mà bạn.
Dùng lệnh BO để bao kín vùng hath. Đó là những đường PL khép kín. Sau đó dùng lênh AA/A/O chọn tất cả đối tượng là đường PL khép kín. Nó sẽ tính đc tổng diện tích đó bạn. Cũng không mất thời gian lắm đâu.
  • 0

#577 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 22 December 2009 - 08:35 AM

Cảm ơn Bác Tuệ đã giúp đỡ!
Bác Tuệ sữa lại giúp út tí nữa nha.
1. Nếu mình quét tấc cả các text nhưng chỉ những text đè lên nhau thì mới sắp xếp lại còn những text không đè lên nhau thì vẫn đứng yên.
2. Thứ hai là khoảng cách các text nếu không nhập lai thì mặt đinh chọn khoảng cách vừa chọn trước đó.
3. thứ 3 là các text được canh về hai phía chứ không phải một phía.
file cad: http://www.cadviet.c...les/2/thu_2.dwg

Yêu cầu này của Út thì Tue_NV đã làm rồi nhưng không thành công. Tue_NV chỉ có thể làm được yêu cầu thứ 2 và thứ 3 của Út khi Út chỉ chọn 1 nhóm Text đè lên nhau hoặc không đè lên nhau thôi nhé.
Đây là Lisp giãn Text đều ra 2 phía chỉ thực hiện với 1 nhóm Text
Yêu cầu thứ 2 và thứ 3 của Út được đáp ứng
Út chạy thử code này nhé :

(defun c:sxtt(/ ss kc i obj lispobj lisdau lisobj diemBcuoi tdi spt des)
(vl-load-com)
;copyright by Tue_NV
(setq ss (ssget '((0 . "*TEXT"))) i 0 lispobj (list))
(if (not kco) (setq kco (cdr(assoc 40 (entget(ssname ss 0))))) )
(setq kc (getdist (strcat "\n Khoang cach giua cac Text <" (rtos kco 2 2) "> :")))
(if (not kc) (setq kc kco) (setq kco kc))

(while (< i (sslength ss))
(vla-getboundingbox (setq obj (vlax-ename->vla-object (ssname ss i))) 'bl 'tl)
(setq lispobj (cons (cons (list (safearray-value tl) (safearray-value bl)) obj) lispobj))
(setq i (1+ i))
)
(setq lispobj (vl-sort lispobj
'(lambda (x y)
(< (caaar x) (caaar y))
)
)
)
(setq lisdau (mapcar 'caar lispobj))
;(setq liscuoi (mapcar 'cadar lispobj))
(setq lisobj (mapcar 'cdr lispobj))
(setq diemBcuoi (list (car (last lisdau)) (cadr (last lisdau)) 0))

(setq tdi (tdiem (car lisdau) diemBcuoi))
(setq spt (/ (float (length lispobj)) 2) i spt)
;(if (= (rem i 1) 0)
(progn
(setq i (- i 0.5)) (setq j 0)
(foreach x lisobj
(setq des (list (- (car tdi) (* i kc)) (cadr (nth j lisdau)) 0))
(vla-move x (vlax-3d-point (nth j lisdau)) (vlax-3d-point tdi))
(vla-move x (vlax-3d-point tdi) (vlax-3d-point des))
(setq i (1- i)) (setq j (1+ j))

)
)

(princ "Chuc ban lam viec hieu qua _ Tue_NV")
)
;
(defun tdiem(x y)
(list (/ (+ (car x) (car y)) 2) (/ (+ (cadr x) (cadr y)) 2) 0)
)

Không biết khẩu AKA (ACA) của bác trinhvqh có giải quyết được vụ này không :( ? Nếu có thể giải quyết trọn vẹn thì phiền bác cho khẩu AKA của bác giúp Útcưng tí nhé.
Thanks bác
:rolleyes:

Bài viết đã được chỉnh sửa nội dung bởi Tue_NV: 22 December 2009 - 06:09 PM

  • 2

#578 trinhvqh

trinhvqh

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 408 Bài viết
Điểm đánh giá: 222 (khá)

Đã gửi 22 December 2009 - 10:56 AM

Không biết khẩu AKA (ACA) của bác trinhvqh có giải quyết được vụ này không :( ? Nếu có thể giải quyết trọn vẹn thì phiền bác cho khẩu AKA của bác giúp Útcưng tí nhé.
Thanks bác
:rolleyes:


Tue_NV bữa ni biết dzỡn rồi đấy
Ut_cung nó tham lam quá (được voi đòi tiên)
Lisp sxtt của Tue_NV cũng tạm ổn rồi

Nếu dùng ACA thì nó cũng giải quyết sắp xếp từng nhóm thôi
Có lẽ Tue_NV nên tham khảo một chút để hoàn thành LISP sxtt
Ở đây không phải bao giờ cũng canh chính giữa
Giữa (theo Ut_cung chỉ là tương đối)

Khi sử dụng Space Evenly của ACA nó ưu điểm hơn một chút là chọn khoảng cách 02 điểm rồi sắp xếp Text trong phạm vi 02 điểm đó
Nhưng nhược điểm là nó không lưu khoảng cách đó
http://www.cadviet.c...les/2/space.rar
  • 0

#579 anhthuhoa

anhthuhoa

    biết pan

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

Đã gửi 22 December 2009 - 11:12 AM

Yêu cầu này của Út thì Tue_NV đã làm rồi nhưng không thành công. Tue_NV chỉ có thể làm được yêu cầu thứ 2 và thứ 3 của Út khi Út chỉ chọn 1 nhóm Text đè lên nhau hoặc không đè lên nhau thôi nhé.
Đây là Lisp giãn Text đều ra 2 phía chỉ thực hiện với 1 nhóm Text
Yêu cầu thứ 2 và thứ 3 của Út được đáp ứng
Út chạy thử code này nhé :


(defun c:sxtt(/ ss kc i obj lispobj lisdau lisobj diemBcuoi tdi spt des)
(vl-load-com)
;copyright by Tue_NV
(setq ss (ssget '((0 . "*TEXT"))) i 0 lispobj (list))
(if (not kco) (setq kco (cdr(assoc 40 (entget(ssname ss 0))))) )
(setq kc (getdist (strcat "\n Khoang cach giua cac Text :")))
(if (not kc) (setq kc kco) (setq kco kc))

(while (< i (sslength ss))
(vla-getboundingbox (setq obj (vlax-ename->vla-object (ssname ss i))) 'bl 'tl)
(setq lispobj (cons (cons (list (safearray-value tl) (safearray-value bl)) obj) lispobj))
(setq i (1+ i))
)
(setq lispobj (vl-sort lispobj
'(lambda (x y)
(< (caaar x) (caaar y))
)
)
)
(setq lisdau (mapcar 'caar lispobj))
;(setq liscuoi (mapcar 'cadar lispobj))
(setq lisobj (mapcar 'cdr lispobj))
(setq diemBcuoi (list (car (last lisdau)) (cadr (last lisdau)) 0))

(setq tdi (tdiem (car lisdau) diemBcuoi))
(setq spt (/ (float (length lispobj)) 2) i spt)
;(if (= (rem i 1) 0)
(progn
(setq i (- i 0.5)) (setq j 0)
(foreach x lisobj
(setq des (list (- (car tdi) (* i kc)) (cadr (nth j lisdau)) 0))
(vla-move x (vlax-3d-point (nth j lisdau)) (vlax-3d-point tdi))
(vla-move x (vlax-3d-point tdi) (vlax-3d-point des))
(setq i (1- i)) (setq j (1+ j))

)
)

(princ "Chuc ban lam viec hieu qua _ Tue_NV")
)
;
(defun tdiem(x y)
(list (/ (+ (car x) (car y)) 2) (/ (+ (cadr x) (cadr y)) 2) 0)
)

Không biết khẩu AKA (ACA) của bác trinhvqh có giải quyết được vụ này không :( ? Nếu có thể giải quyết trọn vẹn thì phiền bác cho khẩu AKA của bác giúp Útcưng tí nhé.
Thanks bác
:rolleyes:

Tôi đã xem bản vẽ minh hoạ "thu_2.dwg" và xử lý theo yêu cầu của tác giả. Xin mời bạn tham khảo:
1- Xoay toàn bộ hàng một góc -90o bàng lệnh "rotate";
2- Vào: Expres--> Text--> Convert Text To Mtext;
3- Dùng lệnh "properties" điều chỉnh giá trị "Line Space Distance" tạo khoảng cách theo ý;
4- Xoay Mtext một góc 90o bàng lệnh "rotate";
5- Dùng lệnh "Explode" nếu bạn cần;
Mô tả thì hơi dài nhưng làm nhanh thôi.
  • 0

#580 luu_quang

luu_quang

    Chưa sử dụng CAD

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

Đã gửi 22 December 2009 - 12:07 PM

Đây là phần tiếp theo của topic Viết lisp theo yêu cầu, mời các bạn tiếp tục thảo luận.


các bác ơi giup em, làm sao để copy các đối tượng từ một file Cad này sang một file Cad khác mà các layout của đối tượng gốc thay đổi theo layout của file mới:
ví dụ như
* đối tượng của flie gốc gồm các layout nét khuất tên Đường Đứt. màu đỏ.
* đối tượng trong file nhận có nét đứt tên khuất, màu xanh,
vạy làm sao để sau copy các layout file gốc không qua bên file nhận nếu có thể được thì có thể chuyển tên Đường Đứt, màu đỏ thành Khuất, màu xanh không.
vì khi copy thì các layout file gốc thường làm rối layout file nhận,.
cảm ơn các bác :(
  • 0