Đến nội dung


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

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)


  • Please log in to reply
2854 replies to this topic

#2461 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 25 March 2015 - 09:31 AM

Cảm ơn bác Doan Van Ha!

Em cũng thử cách của bác nhưng sao nó vẫn không ra kết quả bác nhỉ?

(defun C:00 (  / loop I NUMBER TXT)
(setq i 1)
(setq Number 0.0993347)
(setq loop nil)
(while loop
  	(cond
	  (T
		(if (not (equal Number (fix Number) 1e-15))
		    (setq Number (* Number 10))
		    (setq loop T)
		)
	  )
	)
  	(setq i (1+ i))
)
(Princ i)
(princ)
)

  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#2462 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 25 March 2015 - 09:41 AM

Anh không hiểu nhu cầu của em, nhưng loop=nil thì còn while gì nữa. Chắc muốn thế này:

(defun C:11 ( / I NUMBER)
 (setq i 0)
 (setq Number 0.0993347)
 (while (not (equal Number (fix Number) 1e-15))
  (setq Number (* Number 10))
  (setq i (1+ i)))
 (Princ i)
 (princ))

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#2463 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 25 March 2015 - 09:45 AM

Dạ, tuyệt rồi bác Doan Van Ha ạ!

Em cảm ơn bác!


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#2464 phamhuy1

phamhuy1

    biết vẽ rectang

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

Đã gửi 29 March 2015 - 01:06 PM

(defun LenCurve (cur) 
(vlax-curve-getDistAtParam cur (vlax-curve-getEndParam cur)) ) 
(defun C:CK (/ e k p ps pe L fuzz kc p0 flag p1 OK kc1) (vl-load-com)
(setq e (car (entsel "\nChon curve:")) 
k (getreal "\nKhoang cach giua 2 diem theo duong thang:") 
p (trans (getpoint "\nChon diem tai 1 in 2 dau mut :") 1 0)
ps (vlax-curve-getStartPoint e) 
pe (vlax-curve-getEndPoint e) L (LenCurve e) fuzz 1e-8)
(cond ((equal p ps fuzz) (setq kc k p0 ps flag 1))
((equal p pe fuzz) (setq kc (- L k) p0 pe flag -1))
((alert "Phai chon diem bat dau tai 1 trong 2 dau mut!"))	)
(setq p1 p0) (while p1 (setq OK nil) (while (not OK) 
(setq p1 (vlax-curve-getPointAtDist e kc) kc1 (distance p0 p1)) 
(if (equal kc1 k fuzz) (setq OK T) (setq kc (+ kc (* flag (- k kc1)))))
(if (equal p1 ps fuzz) (exit))	) 
(if p1 (entmake (list (cons 0 "POINT") (cons 10 p1))))
(setq p0 p1) (setq kc (+ kc (* flag k)))	) (princ))

Đây là lisp chia các điểm cách đều trên Objects như : line, pline, spline, arc... lisp chạy tốt nhưng không hiểu sao lại luôn báo lỗi : error: bad argument type: 2D/3D point: nil . Cho em hỏi cách khắc phục nó ạ :( .


  • 0

#2465 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 29 March 2015 - 02:25 PM

Cái này chắc ok.

(defun LenCurve (cur)
(vlax-curve-getDistAtParam cur (vlax-curve-getEndParam cur))
)
(defun C:CK (/ e k p ps pe L fuzz kc p0 flag p1 OK kc1)
(vl-load-com)
(setq e  (car (entsel "\nChon curve:"))
k  (getreal "\nKhoang cach giua 2 diem theo duong thang:")
p  (trans (getpoint "\nChon diem  bat dau tai 1 trong 2 dau mut :") 1 0)
ps  (vlax-curve-getStartPoint e)
pe  (vlax-curve-getEndPoint e)
L  (LenCurve e)
fuzz 1e-8
)
(cond ((equal p ps fuzz)
(setq kc k
p0 ps
flag 1
)
)
((equal p pe fuzz)
(setq kc (- L k)
p0 pe
flag -1
)
)
((alert "Phai chon diem bat dau tai 1 trong 2 dau mut!"))
)
(setq p1 p0)
(while p1
(setq OK nil)
(while (and (not OK) (setq p1 (vlax-curve-getPointAtDist e kc))) 
(setq kc1 (distance p0 p1))
(if (equal kc1 k fuzz)
(setq OK T)
(setq kc (+ kc (* flag (- k kc1))))
)
(if (equal p1 ps fuzz)
(exit)
)
)
(if p1
(entmake (list (cons 0 "POINT") (cons 10 p1)))
)
(setq p0 p1)
(setq kc (+ kc (* flag k)))
)
(princ)
)

  • 1

#2466 phamhuy1

phamhuy1

    biết vẽ rectang

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

Đã gửi 29 March 2015 - 03:09 PM

Anh Tot77 hay thật :) , tìm mãi mà không biết lỗi ở đâu chỉ mang máng nghi ngờ từ vòng lặp while thứ 2 mà ko biết sửa sau :P . thank u!!!


  • 0

#2467 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 04 April 2015 - 04:56 PM

Sau khi sử dụng hàm SSGET để chọn các đường pline bằng hàm

(setq SSS (ssget "C" diemdau diemtren1 fltr)), khi chạy chương trình nó xử lý từ dưới lên trên bây giờ mình muốn nó xử lý từ trên xuống dưới

Nhờ mọi người giúp đỡ sắp xếp lại thứ tự các pline từ trên xuống dưới (chỉ sắp xếp theo tọa độ Y)


  • 0

#2468 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 04 April 2015 - 08:16 PM

Bạn có thể nói rõ hơn không?

Mình đang viết lisp điền cao độ của các lớp đắp k98. đã chạy ok rồi nhưng còn vướng 1 cái là đánh số thứ tự cho các cao độ. hiện tại là nó đánh số từ dưới lên bây giò muốn đánh từ trên xuống


  • 0

#2469 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 04 April 2015 - 10:15 PM

Mình đang viết lisp điền cao độ của các lớp đắp k98. đã chạy ok rồi nhưng còn vướng 1 cái là đánh số thứ tự cho các cao độ. hiện tại là nó đánh số từ dưới lên bây giò muốn đánh từ trên xuống

Nếu chạy OK rồi thì chỉ cần dùng hàm (reverse list) để đảo chiều là đuợc.


  • 1

#2470 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 05 April 2015 - 12:02 PM

Thay vì ssget "C" bạn thử dùng ssget "F" như này xem sao.

(defun c:te (/ A N SS) 
(setq ss (ssget "f" (list (setq a (getpoint)) (getpoint a)))
n 0)
(while (> (sslength ss ) 0)
(command "change" (ssname ss 0) "" "P" "c" (itoa (setq n (1+ n))) "")
(ssdel (ssname ss 0) ss)
)
)

  • 0

#2471 vanngeonhuxua

vanngeonhuxua

    biết vẽ pline

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

Đã gửi 05 April 2015 - 04:34 PM

Mọi người cho hỏi em sai chỗ nào với:

Command: (setq pt1 (getpoint))
(-3638.75 -3687.08 0.0)
Command: (setq pt2 (getpoint))
(-4289.96 -1634.83 0.0)
Command: (getdist pt2 pt1)
; error: bad argument type: stringp: (-3638.75 -3687.08 0.0)


  • 0

#2472 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 05 April 2015 - 04:44 PM

Không dùng getdist được mà phải dung distance, xem lại help.
  • 0

#2473 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 05 April 2015 - 05:32 PM

Khi xuât dữ liệu từ cad qua excel 

Muốn xuống dòng dùng lệnh (princ "\n" fid)

Muốn bỏ qua 1 cột dùng (princ "," fid)

Muốn bỏ qua 3 cột dùng (princ "," fid) (princ "," fid) (princ "," fid)

Khi muốn bỏ qua nhiều hơn 3 cột không thể dùng lệnh như trên được nữa.

Nhờ mọi người giúp đỡ 

Cám ơn nhiều


  • 0

#2474 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 05 April 2015 - 06:11 PM

Thử dùng (princ ",,,,,,,,,," fid) xem sao.
  • 1

#2475 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 05 April 2015 - 11:07 PM

Thử dùng (princ ",,,,,,,,,," fid) xem sao.

Cám ơn bạn đã giúp đỡ mình đã làm được. Cho mình hỏi thêm tí nữa có lệnh nào để kiểm tra vị trí ô chuột đang đứng có dữ liệu hay không???


  • 0

#2476 collagen

collagen

    Chưa sử dụng CAD

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

Đã gửi 05 April 2015 - 11:24 PM

hay quá đang mày mò bữa giờ , rất hay


  • 0

#2477 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 06 April 2015 - 06:44 PM

(defun tinhdientichdoituong( e)
  (vla-get-area (vlax-ename->vla-object e))
)

Mình lạc hậu quá, các bạn sửa giúp mình cái code trên sao cho nó kiểm tra nếu tính được diện tích thì trả về diện tích ngược lại trả về nil. Cám ơn các bạn


  • 0

#2478 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 06 April 2015 - 09:59 PM

Cả ô chuột thì lisp chưa đúng.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#2479 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 07 April 2015 - 12:56 AM

(defun tinhdientichdoituong( ename)
  (vla-get-area (vlax-ename->vla-object ename))
)

Code trên mình trích trên Cadviet, mình chỉ có thể kiểm tra ename có phải là POLYLINE, HATCH ... thôi, nhưng mình nghĩ chỉ biết như vậy chưa đủ. Thật tình đến giờ này mình chưa nắm đc mấu chốt của vl nên hầu như mình bí,


  • 0

#2480 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 07 April 2015 - 08:46 AM

Bạn TrungNgaMy thử xem:

(if

 (vl-catch-all-error-p (setq area (vl-catch-all-apply 'vlax-curve-getArea (list (vlax-ename->vla-object (car (entsel)))))))

 nil

 area)

 

(if

 (vl-catch-all-error-p (setq area (vl-catch-all-apply 'vlax-curve-getArea (list (vlax-ename->vla-object (car (entsel)))))))

 nil

 area)


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.