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

#2141 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 12 June 2009 - 03:36 PM

gửi bạn thanh bình và Tue_NV.
hai bạn nói đúng nhưng mà chổ mình làm là thế đó tất cả mọi cái đều phải nổ ra hết kể cả leader cũng thế đấy các bạn ạ.

nếu vậy thì bạn làm cái líp dim xong x ra không nhanh hơn sao!
  • 0

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


#2142 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 12 June 2009 - 07:11 PM

Dùng lệnh Battman

Lệnh Battman không chuyển màu được bác Tue_NV ạ, nhưng Lisp Test của bác Gia_bach thì OK.
PP dùng Lisp trên của Gia_bach để chuyển về một màu, rồi dùng lệnh Burst do Tue_NV hướng dẩn để chuyển các text trong các Attributes (dùng trong các Anotations) thành Dtext/Mtext, sau đó có thể thay đổi các Dtext/Mtext này dể dàng khi bản vẽ dạng AutoCAD (DWG) được chuyển qua dạng bản vẽ MicroStation (DGN) http://www.bentley.c...Top-Reasons.htm
PP cũng đang tự học pm MicroStation V8. Không biết diển dàn CADViet có viết "LISP" cho pm MicroStation không vậy các Bác ?
Xin cảm ơn các Bác.
PP.
  • 1

#2143 shinnikel

shinnikel

    biết vẽ line

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

Đã gửi 13 June 2009 - 12:16 AM

Hình đã gửi Mình quên nói là khoảng cách P tùy y lisp sẽ tính toán con sô hơp lý :lol2: .Bài đã gửi nhưng chưa ai xem wa thi phai.


;┌───────────────────────────┐
;│1991/09/12 新日軽(株)小矢部工場 │
;│ OM設計課 野口 敏章 │
;│ CW ピッチ計算 LISP │
;└───────────────────────────┘
(defun c:snc_keisan01 ()
; *** ユーザーにL,A,Pの入力を求める。 ***
(setq echo (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq leng (getreal "\nNhap kthuoc L: "))
(setq flag T)
(while flag
(setq tanbu (getstring "\nNhap kthuoc [A]。(muon A co dinh thi nhap them k truoc A): "))
(if (wcmatch (substr tanbu 1 1) "#")
(if (/= (setq tanbu (atof tanbu)) 0) (setq flag nil))
(if (or (= (substr tanbu 1 1) "k") (= (substr tanbu 1 1) "K")) (progn (setq tanbu (atof (substr tanbu 2 (1- (strlen tanbu))))) (setq kotei "tan") (setq flag nil)))
)
)
(setq flag T)
(while flag
(if (= kotei nil)
(setq pitch (getstring "\nNhap buoc nhay (P)。(muon P co dinh thi nhap them k truoc P): "))
(setq pitch (getstring "\nNhap buoc nhay (P)。: "))
)
(if (wcmatch (substr pitch 1 1) "#")
(if (/= (setq pitch (atof pitch)) 0) (setq flag nil))
(if (/= kotei "tan") (if (or (= (substr pitch 1 1) "k") (= (substr pitch 1 1) "K")) (progn (setq pitch (atof (substr pitch 2 (1- (strlen pitch))))) (setq kotei "pit") (setq flag nil))))
)
)

; *** 端部側固定の場合の計算 ***
(if (= kotei "tan")
(progn
;(setq n (fix (/ (- leng (* 2.0 tanbu)) pitch)))
(setq n (fix (+ (/ (- leng (* 2.0 tanbu)) pitch) 0.95))) ;二捨三入
;(setq n (fix (+ (/ (- leng (* 2.0 tanbu)) pitch) 0.5))) ;四捨五入
(setq pitch (/ (- leng (* 2.0 tanbu)) n))
)
)

; *** ピッチ側固定の場合の計算 ***
(if (= kotei "pit")
(progn
;(setq n (fix (/ (- leng (* 2.0 tanbu)) pitch)))
(setq n (fix (+ (/ (- leng (* 2.0 tanbu)) pitch) 0.95))) ;二捨三入
;(setq n (fix (+ (/ (- leng (* 2.0 tanbu)) pitch) 0.5))) ;四捨五入
(setq tanbu (/ (- leng (* n pitch)) 2.0))
)
)
; *** 固定なしの場合の計算 ***
(if (and (/= kotei "pit") (/= kotei "tan"))
(progn
;(setq n (fix (/ (- leng (* 2.0 tanbu)) pitch)))
(setq n (fix (+ (/ (- leng (* 2.0 tanbu)) pitch) 0.95))) ;0.05捨0.06入
;(setq n (fix (+ (/ (- leng (* 2.0 tanbu)) pitch) 0.5))) ;四捨五入
(setq pitch (* (fix (/ (/ (- leng (* tanbu 2.0)) n) 10.0)) 10.0))
(setq tanbu (/ (- leng (* pitch n)) 2.0))
)
)

; *** 計算結果の表示 ***
(setq hyouji (strcat "\nKET QUA: < " (rtos leng) "=" (rtos tanbu) "+" (rtos pitch 2 1) "×" (rtos n) "+" (rtos tanbu) " > OK chua? chua thi tinh lai! "))
(princ hyouji)
; *** メモリの開放 ***
(setvar "cmdecho" echo)
(setq pitch nil tanbu nil leng nil n nil hyouji nil flag nil kotei nil echo nil)
)

; *** エラー処理 ***
(defun *error* (emsg)
(setq pitch nil tanbu nil leng nil n nil hyouji nil flag nil kotei nil echo nil)
(princ)
)


  • 0

#2144 thiep

thiep

    biết dimbaseline

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

Đã gửi 13 June 2009 - 12:34 PM

Chào shinnikel
Lisp của bạn sưu tầm của tác giả Nhật bổn chỉ đơn giản làm bài toán số học theo kiểu gần đúng. Có 3 trường hợp xảy ra như sau:
- dim A cố định
- dim A không cố định, bước nhảy P cố định,
- dim A không cố định, bước nhảy P không cố định,
Từ đó Lisp sẽ cho ra 1 biểu thức gần đúng cho L. Mục đích để làm gì cũng chưa hiểu ý định của tác giả.
Dù gì theo yêu cầu của shinnikel, thiep cũng chỉnh sửa lại Lisp này cho gọn gàng dể hiểu hơn:
(defun DXF (code en) (cdr (assoc code (entget en))))
;------------------
(defun c:snc_keisan (/ pitch tanbu leng hyouji echo)
(setq echo (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq leng (dxf 42 (car (entsel "\nPick kich thuoc L: "))))
(setq tanbu (dxf 42 (car (entsel "\nPick kich thuoc A: "))))
(initget 128 "Y N")
(setq A (getkword "\nBan muon kich thuoc A co dinh (enter for Y): "))
(if (not A)
(setq A "Y")
(setq A "N")
)
(setq pitch (getreal "\nNhap buoc nhay P: "))
(if (= A "N")
(progn
(initget 128 "Y N")
(setq P (getkword
"\nBan muon buoc nhay P co dinh (enter for Y): "
)
)
(if (not P)
(setq P "Y")
(setq P "N")
)
)
)
(setq dimgiua (- leng (* 2.0 tanbu)))
;----co 3 truong hop xay ra:
(cond (and (= A "N") (= P "N"))
(setq pitch (* (fix (/ (/ dimgiua (fix (+ 0.95 (/ dimgiua pitch)))) 10.0)) 10.0))
(setq tanbu (/ Lchia 2.0))
)
;-----------------------
(cond (and (= A "Y") (= P "N"))
(setq pitch (/ Lchia (fix (+ 0.95 (/ dimgiua pitch)))))
)
;-------------------------------
(cond (= A "Y")
(setq pitch (* (fix (/ (/ dimgiua (fix (+ 0.95 (/ dimgiua pitch)))) 10.0)) 10.0))
(setq tanbu (/ (- leng (* pitch (fix (+ 0.95 (/ dimgiua pitch))))) 2.0))
)
;----------------------------
(setq hyouji (strcat "\nKET QUA: < "
(rtos leng)
"="
(rtos tanbu)
"+"
(rtos pitch 2 1)
"×"
(rtos (fix (+ 0.95 (/ dimgiua pitch))))
"+"
(rtos tanbu)
" > OK chua? chua thi tinh lai! "
)
)
(setvar "cmdecho" echo)
(princ hyouji)
(princ)
)

  • 0

#2145 shinnikel

shinnikel

    biết vẽ line

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

Đã gửi 13 June 2009 - 02:26 PM

[quote name='thiep' date='Jun 13 2009, 12:34' post='64073']
Chào shinnikel
Lisp của bạn sưu tầm của tác giả Nhật bổn chỉ đơn giản làm bài toán số học theo kiểu gần đúng. Có 3 trường hợp xảy ra như sau:
-Cám ơn Thịêp nhưng lisp không chay đươc ban ơi công dụng của lisp này là sd máy đụt lô tư đông, lâý dâú đê băt vít.Ban xem lại dùm mình cái nha :lol2:
  • 0

#2146 thiep

thiep

    biết dimbaseline

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

Đã gửi 13 June 2009 - 03:39 PM

-Cám ơn Thịêp nhưng lisp không chay đươc ban ơi công dụng của lisp này là sd máy đụt lô tư đông, lâý dâú đê băt vít.Ban xem lại dùm mình cái nha :lol2:

Lỗi như thế nào? thiep test ổn mà. Hay là do copy vào Codebox, mã lisp nhảy lộn, cứ dính chùm giữa setq và biến. . .
Hay là bạn tải ở đây:
http://www.cadviet.c.../snc_keisan.lsp
  • 0

#2147 shinnikel

shinnikel

    biết vẽ line

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

Đã gửi 13 June 2009 - 04:57 PM

Lỗi như thế nào? thiep test ổn mà. Hay là do copy vào Codebox, mã lisp nhảy lộn, cứ dính chùm giữa setq và biến. . .
Hay là bạn tải ở đây:
http://www.cadviet.c.../snc_keisan.lsp

Mình lâý địa chỉ của bạn cho thì sd đươc nhưng có 1 sô vân đê như thê này lisp không nhân đươc kích thươc giả(mình băt buôc phai sd ) thư 2 nêú đã chọn vào A thi đó là kt cô định rôi không cân hỏi nưả và kêt quả cuôi cùng mình muôn chèn vô Dim nôi dung @=Pxn
Cám ơn Thiêp rât nhiiêù đã theo dõi và sưa dùm mình. :lol2:
  • 0

#2148 shinnikel

shinnikel

    biết vẽ line

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

Đã gửi 13 June 2009 - 05:03 PM

Ngày hôm nay mình đơi lisp của bạn đó nha :lol2: :lol2: :D
  • 0

#2149 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 13 June 2009 - 05:38 PM

Chào bạn shinnikel.
Bạn viết là :
Trình tự thực hiện Lisp :
1 Nhập kích thước hay chọn Dim L=
2. Nhập kích thước A : khoảng cách 2 biên
3. Nhập khoảng cách bước nhảy P
Cho kết quả A + Pxn + A
Thế thì khoảng cách bước nhảy P có phải là số 7 trong hình không bạn?
Bạn nói rõ để mình có thể giúp cho bạn.
Chào bạn
  • 0

#2150 shinnikel

shinnikel

    biết vẽ line

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

Đã gửi 13 June 2009 - 09:35 PM

Chào bạn shinnikel.
Bạn viết là :
Trình tự thực hiện Lisp :
1 Nhập kích thước hay chọn Dim L=
2. Nhập kích thước A : khoảng cách 2 biên
3. Nhập khoảng cách bước nhảy P
Cho kết quả A + Pxn + A
Thế thì khoảng cách bước nhảy P có phải là số 7 trong hình không bạn?
Bạn nói rõ để mình có thể giúp cho bạn.
Chào bạn

Chào Tue_NV khoảng cách bước nhảy P ở đây là 328.6 đã được làm tròn, khoảng cách P lúc đầu do mình chọn ngẫu nhiên lisp sẽ tính cho ta số gần đúng và làm tròn đoạn mã lúc đầu mình gửi bạn có thể test, đoạn mã lúc đầu của mình đẵ thỏa được phần tính toán chủ yếu mình muốn nhờ các bạn sửa giúp để cải thiện công việc mình chỉ cần Pick...Pick và Pick để cho ra kết quả để hạn chế sai sót lúc đầu khi tính toán mình copy trong dòng command rồi dán vô trong những lúc thao tác nhanh có thể dán vô còn sót lại nội dung củ :lol2: để hạn chế lỗi đó mình chỉ còn cách cầu cứu các bạn thui. Cám ơn đã đọc và quan tâm :lol2: Ok
Có lẽ các bạn ngạc nhiên khi thấy bước vít của mình có số lẽ trong đó vì những tấm kim loại của mình khi gia công đục lỗ sử dụng máy tự động chỉ cần lập trình thi nó cứ pan pan & pan cho đến hết.
  • 0

#2151 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 14 June 2009 - 09:53 AM

Chào Tue_NV khoảng cách bước nhảy P ở đây là 328.6 đã được làm tròn, khoảng cách P lúc đầu do mình chọn ngẫu nhiên lisp sẽ tính cho ta số gần đúng và làm tròn đoạn mã lúc đầu mình gửi bạn có thể test, đoạn mã lúc đầu của mình đẵ thỏa được phần tính toán chủ yếu mình muốn nhờ các bạn sửa giúp để cải thiện công việc mình chỉ cần Pick...Pick và Pick để cho ra kết quả để hạn chế sai sót lúc đầu khi tính toán mình copy trong dòng command rồi dán vô trong những lúc thao tác nhanh có thể dán vô còn sót lại nội dung củ :lol2: để hạn chế lỗi đó mình chỉ còn cách cầu cứu các bạn thui. Cám ơn đã đọc và quan tâm :lol2: Ok
Có lẽ các bạn ngạc nhiên khi thấy bước vít của mình có số lẽ trong đó vì những tấm kim loại của mình khi gia công đục lỗ sử dụng máy tự động chỉ cần lập trình thi nó cứ pan pan & pan cho đến hết.

Tue_NV không hiểu câu bạn nói là : với số P tuỳ ý thì Lisp sẽ tính toán ra con số hợp lý?
Vậy con số nào là con số hợp lý???? và hợp lý như thế nào? Bạn nói vầy chỉ có mình bạn hiểu mà thôi
Tue_NV đã viết đoạn Lissp này. Nếu có gì chưa được hãy post lên đây và nói rõ


(defun c:Tdim()

(setq L (getreal "\n Nhap so L = hoac Enter de chon DIMENSION chieu dai : "))
(setq Ltinh L)

(if (null L)
(progn
(setq L (car(entsel "\nChon kich thuoc chieu dai : ")))

(setq ent (entget L))

(if (= (cdr(assoc 1 ent)) "")
(setq Ltinh (cdr(assoc 42 ent)))
(setq Ltinh (atof(cdr(assoc 1 ent))))
)
)
)

(setq A (getreal "\n Nhap so A = hoac Enter de chon DIMENSION chieu dai : "))
(setq Atinh A)

(if (null A)
(progn
(setq A (car(entsel "\nChon kich thuoc chieu dai : ")))

(setq entt (entget A))

(if (= (cdr(assoc 1 entt)) "")
(setq Atinh (cdr(assoc 42 entt)))
(setq Atinh (atof(cdr(assoc 1 entt))))
)
)
)
(setq P (getreal "\n Nhap khoang cach buoc nhay :"))
(setq n (/ (- Ltinh (* 2 Atinh)) P))
(setq Di (entget(car(entsel "\n Pick chon Dim can xuat ket qua :"))))
(entmod (subst(cons 1 (strcat "@=" (rtos P 2 2) "x" (rtos n 2 0))) (assoc 1 Di) Di))

(prompt (strcat "\n" (rtos Atinh 2 0) " + " (rtos P 2 2) "x" (rtos n 2 0) " + " (rtos Atinh 2 0)))
(princ)
)

  • 0

#2152 shinnikel

shinnikel

    biết vẽ line

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

Đã gửi 14 June 2009 - 07:24 PM

[quote name='Tue_NV' date='Jun 14 2009, 9:53' post='64158']
Tue_NV không hiểu câu bạn nói là : với số P tuỳ ý thì Lisp sẽ tính toán ra con số hợp lý?
Vậy con số nào là con số hợp lý???? và hợp lý như thế nào? Bạn nói vầy chỉ có mình bạn hiểu mà thôi
Tue_NV đã viết đoạn Lissp này. Nếu có gì chưa được hãy post lên đây và nói rõ

Chào Tue_NV để mình giải thích chút về P trong công việc của mình P có rất nhiều giá trị chuẩn nếu bước vít có thể nhìn thấy giao động từ 300 trở xuống bước vít không nhìn thấy đầu vít thì khoảng 350 còn 1 số loại tacke bắt vào tường khoảng 500. Lisp mới bạn viết cho mình các bước thực hiện rất ok chỉ có điều kết quả tính toán không đúng ví dụ với lisp bạn viết mình test như sau: với L=2500 , A=100 , P=350(đây là bước vít không nhìn thấy) kết quà tính toán của bạn sẽ là @=350x7 nếu lấy các con số A+@=Pxn+A =2650 khác với L ban đầu là 2500 còn lisp ban đầu của mình sẽ cho kết quả là @=328.6×7 cộng các con số lại sẽ được L=2500.2 gần giống với L ban đầu. Trình tự đục lỗ tự động như sau người thợ sẽ lấy dấu từ mép nhập A=100 , @=328.6×7 máy sẽ tự động chạy dao tiến vào 100 rồi đụt 1 phát sau đó chay tiếp 328.6 đụt 1 phát nữa và cứ thế tiếp tục 6 phát nữa rồi lấy sp ra. Bạn xem file của mình nha: file minh hoa nhờ bạn hoàn thiện dùm chân thành cám ơn. :lol2:
  • 0

#2153 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 14 June 2009 - 09:09 PM

Chào Tue_NV để mình giải thích chút về P trong công việc của mình P có rất nhiều giá trị chuẩn nếu bước vít có thể nhìn thấy giao động từ 300 trở xuống bước vít không nhìn thấy đầu vít thì khoảng 350 còn 1 số loại tacke bắt vào tường khoảng 500. Lisp mới bạn viết cho mình các bước thực hiện rất ok chỉ có điều kết quả tính toán không đúng ví dụ với lisp bạn viết mình test như sau: với L=2500 , A=100 , P=350(đây là bước vít không nhìn thấy) kết quà tính toán của bạn sẽ là @=350x7 nếu lấy các con số A+@=Pxn+A =2650 khác với L ban đầu là 2500 còn lisp ban đầu của mình sẽ cho kết quả là @=328.6×7 cộng các con số lại sẽ được L=2500.2 gần giống với L ban đầu. Trình tự đục lỗ tự động như sau người thợ sẽ lấy dấu từ mép nhập A=100 , @=328.6×7 máy sẽ tự động chạy dao tiến vào 100 rồi đụt 1 phát sau đó chay tiếp 328.6 đụt 1 phát nữa và cứ thế tiếp tục 6 phát nữa rồi lấy sp ra. Bạn xem file của mình nha: file minh hoa nhờ bạn hoàn thiện dùm chân thành cám ơn. :lol2:

Chào shinnikel
Lisp đây. Tue_NV đã sửa lại rồi. Hy vọng đúng ý bạn
Chú ý rằng Lisp chấp nhận cả Dim độ chế, nhưng với loại Dim này chỉ tính đối với Dim số, chứ với Dim có cả chữ và số thì nó không tính được như ý của mình. Ví dụ như Dim L=2500 (có cả chữ và số) thì sẽ ra kết quả không như ý. Dim 2500 thì tính đúng ý mình.


(defun c:Tdim()
(setq oldim (getvar "DimZin"))
(setvar "Dimzin" 0)
(setq L (getreal "\n Nhap so L = hoac Enter de chon DIMENSION chieu dai : "))
(setq Ltinh L)

(if (null L)
(progn
(setq L (car(entsel "\nChon kich thuoc chieu dai : ")))

(setq ent (entget L))

(if (= (cdr(assoc 1 ent)) "")
(setq Ltinh (cdr(assoc 42 ent)))
(setq Ltinh (atof(cdr(assoc 1 ent))))
)
)
)

(setq A (getreal "\n Nhap so A = hoac Enter de chon DIMENSION chieu dai : "))
(setq Atinh A)

(if (null A)
(progn
(setq A (car(entsel "\nChon kich thuoc chieu dai : ")))

(setq entt (entget A))

(if (= (cdr(assoc 1 entt)) "")
(setq Atinh (cdr(assoc 42 entt)))
(setq Atinh (atof(cdr(assoc 1 entt))))
)
)
)
(setq Pt (getreal "\n Nhap khoang cach buoc nhay :"))
(setq n (atof(rtos(/ (- Ltinh (* 2 Atinh)) Pt) 2 0)))
(setq P (/ (- Ltinh (* 2 Atinh)) n))

(setq Di (entget(car(entsel "\n Pick chon Dim can xuat ket qua :"))))
(entmod (subst(cons 1 (strcat "@=" (rtos P 2 2) "x" (rtos n 2 0))) (assoc 1 Di) Di))

(prompt (strcat "\n" (rtos Atinh 2 0) " + " (rtos P 2 2) "x" (rtos n 2 0) " + " (rtos Atinh 2 0)))
(setvar "Dimzin" oldim)
(princ)
)

:lol2:
  • 1

#2154 shinnikel

shinnikel

    biết vẽ line

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

Đã gửi 14 June 2009 - 10:15 PM

Cám ơn Tue_NV bạn rất nhiệt tình còn vấn đề L= mình nghĩ có thể giải quyết được bạn có thể sửa kết quả lại để làm tròn 1 số không hiện tại bạn đang cho làm tròn tới 2 số, nếu kết quả ra .00 bạn có thể bỏ luôn cho mình có được không bao giờ bạn rảnh sửa giúp mình cũng được chúc bạn và mọi ngươi ngủ ngon mai phải bắt đầu cài rôi hihi.. :lol2:
  • 0

#2155 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 14 June 2009 - 10:29 PM

Cám ơn Tue_NV bạn rất nhiệt tình còn vấn đề L= mình nghĩ có thể giải quyết được bạn có thể sửa kết quả lại để làm tròn 1 số không hiện tại bạn đang cho làm tròn tới 2 số, nếu kết quả ra .00 bạn có thể bỏ luôn cho mình có được không bao giờ bạn rảnh sửa giúp mình cũng được chúc bạn và mọi ngươi ngủ ngon mai phải bắt đầu cài rôi hihi.. :lol2:

"Việc hôm nay chớ để đến ngày mai "
(defun c:Tdim()
(setq oldim (getvar "DimZin"))
(setvar "Dimzin" 0)
(setq L (getreal "\n Nhap so L = hoac Enter de chon DIMENSION chieu dai : "))
(setq Ltinh L)

(if (null L)
(progn
(setq L (car(entsel "\nChon kich thuoc chieu dai : ")))

(setq ent (entget L))

(if (= (cdr(assoc 1 ent)) "")
(setq Ltinh (cdr(assoc 42 ent)))
(setq Ltinh (atof(cdr(assoc 1 ent))))
)
)
)

(setq A (getreal "\n Nhap so A = hoac Enter de chon DIMENSION chieu dai : "))
(setq Atinh A)

(if (null A)
(progn
(setq A (car(entsel "\nChon kich thuoc chieu dai : ")))

(setq entt (entget A))

(if (= (cdr(assoc 1 entt)) "")
(setq Atinh (cdr(assoc 42 entt)))
(setq Atinh (atof(cdr(assoc 1 entt))))
)
)
)
(setq Pt (getreal "\n Nhap khoang cach buoc nhay :"))
(setq tp (getint "\n So chu so thap phan :"))
(setq n (atof(rtos(/ (- Ltinh (* 2 Atinh)) Pt) 2 0)))
(setq P (/ (- Ltinh (* 2 Atinh)) n))

(setq Di (entget(car(entsel "\n Pick chon Dim can xuat ket qua :"))))
(entmod (subst(cons 1 (strcat "@=" (rtos P 2 tp) "x" (rtos n 2 0))) (assoc 1 Di) Di))

(prompt (strcat "\n" (rtos Atinh 2 0) " + " (rtos P 2 tp) "x" (rtos n 2 0) " + " (rtos Atinh 2 0)))
(setvar "Dimzin" oldim)
(princ)
)

  • 1

#2156 khanhduydang

khanhduydang

    biết zoom

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

Đã gửi 15 June 2009 - 02:46 AM

http://www.cadviet.c...les/THETICH.lsp

Mình sử dụng lisp này để tính thể tích khối Solid. Nhưng khi dùng lisp cho scale khối đó theo 1 phương thì thể tính thể tích bằng lisp đó được nữa.
Cụ thể:
1. Mình có 1 hình hộp
2. Mình tính được thể tích bình thường khi extrude xong bằng lisp theo link trên.
3. Sau đó mình dùng scale 1 phương (cũng bằng lisp) có trên diễn đàn cadviet mình.
4. Cuối cùng là không còn tính được thể tích nữa.
Hic hic nhờ các bác giúp dùm.
:lol2: Xin cám ơn các bác trước nha. Mình mô tả vậy chắc rõ ràng phải không?
  • 0

#2157 shinnikel

shinnikel

    biết vẽ line

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

Đã gửi 15 June 2009 - 07:06 AM

[quote name='Tue_NV' date='Jun 14 2009, 22:29' post='64210']
"Việc hôm nay chớ để đến ngày mai "
Chào buổi sáng như vậy Lisp mình đã được cải tiến rồi Thanks. :lol2:
  • 0

#2158 hauhn

hauhn

    Chưa sử dụng CAD

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

Đã gửi 16 June 2009 - 09:12 AM

Chào các bạn. Mình load trên CAD việt 1 lisp nâng cốt đồng mức lên 1 cao độ Z nhất định để khôi phục bình đồ chạy HS. lisp rất hay, tuy nhiên mình muốn nhờ các bạn sửa giúp mình 1 chút.
Trong bản bình đồ đã bị phá các đường đồng mức bị phá thành các đoạn cùng cao độ. lisp yêu cầu mình nhập liên tục các đồng mức vì vậy muốn nhập phải mất công nối các đường này lại. việc này với bình đồ nhỏ thì không vấn đề gì nhưng với bình đồ lớn là khá mất thời gian. Mình muốn nhờ bạn sửa lại thành cho phép chọn nhiều đường đồng mức cùng lúc.
thứ 2, mình đã có 1 lisp nâng cốt từ text hay nói cách khác mình có thể đọc được giá trị value của text gán cho Z.
mình muốn sửa đổi lisp đồng mức thành 2 tùy chọn là nhập giá trị Z cho đường đồng mức hoặc chọn text và gán giá trị đó thay cho việc nhập.
Mình mới học về lisp nên chỉnh code của lisp đồng mức toàn bị loạn lên và báo lỗi ko chạy được. nhờ các bạn sửa giúp mình, thanks.
http://www.cadviet.c...inh_chay_HS.rar
http://www.cadviet.c.../dong_muc_1.lsp
http://www.cadviet.c...files/Movet.lsp
  • 0

#2159 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 17 June 2009 - 10:35 AM

Hôm trước mình thấy trên diễn đàn có lệnh sắp xếp text rất hay nhưng chỉ sắp xếp theo lề trái. Bác nào giùp mình "nâng cấp" nó lên thành sắp xếp theo lề trái, lề phải, hay canh giữa tuỳ mình chọn.
Khi mình chạy lisp thì chương trình sẽ hỏi: bạn muốn canh trái, canh phải, hay canh giữa.
Sau đó chọn các text cần sắp xếp, rồi ấn enter. (dòng text tự động sắp xếp theo text trên cùng)
Rồi tiếp tục chọn các text tiếp theo rồi enter.
Thank!
đây là code hôm trước mình tìm được các bạn tham khảo nha.
(defun c:st1()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(>
(caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)

(setq ddau (cdr(assoc 10 (entget(car lst))))
i 0)

(foreach e lst
(setq ent (entget e))
(setq dcuoi (cdr(assoc 10 ent)))
(setq ddauu (list (car ddau) (cadr dcuoi) 0))
(command "move" e "" dcuoi ddauu)
(setq i (1+ i))
)
(setvar "osmode" oldos)
(Princ)
)

(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

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!

#2160 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 17 June 2009 - 01:46 PM

Chào các bạn. Mình load trên CAD việt 1 lisp nâng cốt đồng mức lên 1 cao độ Z nhất định để khôi phục bình đồ chạy HS. lisp rất hay, tuy nhiên mình muốn nhờ các bạn sửa giúp mình 1 chút.
Trong bản bình đồ đã bị phá các đường đồng mức bị phá thành các đoạn cùng cao độ. lisp yêu cầu mình nhập liên tục các đồng mức vì vậy muốn nhập phải mất công nối các đường này lại. việc này với bình đồ nhỏ thì không vấn đề gì nhưng với bình đồ lớn là khá mất thời gian. Mình muốn nhờ bạn sửa lại thành cho phép chọn nhiều đường đồng mức cùng lúc.
thứ 2, mình đã có 1 lisp nâng cốt từ text hay nói cách khác mình có thể đọc được giá trị value của text gán cho Z.
mình muốn sửa đổi lisp đồng mức thành 2 tùy chọn là nhập giá trị Z cho đường đồng mức hoặc chọn text và gán giá trị đó thay cho việc nhập.
Mình mới học về lisp nên chỉnh code của lisp đồng mức toàn bị loạn lên và báo lỗi ko chạy được. nhờ các bạn sửa giúp mình, thanks.
http://www.cadviet.c...inh_chay_HS.rar
http://www.cadviet.c.../dong_muc_1.lsp
http://www.cadviet.c...files/Movet.lsp

Chào hauhn
LISP đã sửa theo ỵêu cầu của bạn.
;------------------------------------
;---- Nang Text 3D for SDSK----------
;------------------------------------
(defun c:movet (/ ss ee cd p newVal)
(command "UNDO" "begin")
(if (setq ss (ssget '((0 . "TEXT"))))
(foreach ee (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq p (cdr (assoc 10 ee) )
cd (cdr (assoc 1 ee))
newVal (getreal (strcat "\nNhap cao do <" cd "> :")) )
(if newVal
(setq p (list (car p) (cadr p) newVal ) )
(setq p (list (car p) (cadr p) (atof cd) ) )
)
(entmod (subst (cons 10 p) (assoc 10 ee) ee))
)
)
(command "UNDO" "end")
)
;---------------------------------------
;---- Set cao do cho duong dong muc ----
;---------------------------------------
(defun c:GDM (/ ss e caodo buoc)
(vl-load-com)
(command "UNDO" "begin")
(if (not (tblsearch "LAYER" "DM_so_hoa"))
(command "-layer" "n" "DM_so_hoa" "c" "1" "DM_so_hoa" "")
)
(or *caodo* (setq *caodo* 50.0))
(or *buoc* (setq *buoc* 0.5))
(setq caodo (getreal (strcat"\nNhap cao do ban dau cua duong dong muc <" (rtos *caodo*) ">:"))
buoc (getreal (strcat"\nNhap chenh cao giua cac duong dong muc <" (rtos *buoc*) ">:"))
)
(if buoc (setq *buoc* buoc) (setq buoc *buoc*))
(if caodo (setq *caodo* caodo) (setq caodo *caodo*))
(while
(and
(princ (strcat "\nChon duong dong muc cho cao do <" (rtos caodo 2 2) "> / Enter de ket thuc"))
(setq ss (ssget (list (cons 0 "*POLYLINE") (cons 8 "~DM_so_hoa"))))
)
(foreach e (mapcar 'vlax-ename->vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (vlax-property-available-p e 'Elevation)
(progn
(vla-put-Elevation e caodo)
(vla-put-Layer e "DM_so_hoa")
)
)
)
(setq caodo (+ caodo buoc)
*caodo* caodo)
)
(command "UNDO" "end")
)

  • 1