Chuyển đến nội dung
Diễn đàn CADViet

ngokiet

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    404

  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    43

Bài đăng được đăng bởi ngokiet

  2. Đã đăng · Trả lời báo cáo

    4 giờ trước, TranAnhTuong đã nói:

     

     

    Bác cho em xin Lisp ah! Em cảm ơn bác nhiều!

    Mấy bác đang chào hàng đó. Liên hệ đặt mua đi. Liên hệ tốt không chừng được miễn phí hi hi. Dạo náy cadviet nhiều người nhờ vả nhưng thiếu ý tứ với người giúp nên cũng ít viết dùm rồi.

    • Like 1

  3. Đã đăng · Trả lời báo cáo

    Bạn thử lệnh

    (getvar "MILLISECS") ; xem mili giây hiện hành

    (rtos (getvar "cdate") 2 6) ; Xem năm thang ngay giờ phút giây 

    Autolisp không có hàm delay. Vì vậy bạn có thể dùng

    (while (eq (getvar 'cdate) x)) hay (while (eq (getvar"MILLISECS") x)) Để đợi tới thời điểm nào đó.

    HÌnh như cdate chính xac theo giây.  millisecs chính xác theo %giây.

  6. Đã đăng · Trả lời báo cáo 

    (defun c:ff(/ e1 e2 p1 p2 break)
  (defun break(en / ob)
    (setq ob (vlax-ename->vla-object en)
	  p1 (vlax-curve-getparamatpoint ob
	       (vlax-curve-getclosestpointto ob (trans p1 1 0)))
	  p2 (vlax-curve-getparamatpoint ob
	       (vlax-curve-getclosestpointto ob (trans p2 1 0))))
    (If (> p1 p2) (mapcar 'set '(p1 p2) (list p2 p1)))
    (setq p1 (1+ (fix p1))
	  p2 (fix p2))
    (if (eq p1 p2)
      (command "breaK" (list en (setq p1 (vlax-curve-getpointatparam ob p1))) p1)
      (progn
	(command "breaK" (list en (setq p2 (vlax-curve-getpointatparam ob p2))) p2)
	(command "breaK" (list en (setq p1 (vlax-curve-getpointatparam ob p1))) p1))))  
    
  (if (and (mapcar 'set '(e1 p1) (entsel "Chon 1:"))
	   (mapcar 'set '(e2 p2) (entsel "Chon 2:")))
    (progn
      (command "Fillet" p1 p2)
      (if (null (entget e1)) (break e2)
	(if (null (entget e2)) (break e1)))
      (princ))))

    Viết nhanh theo kiểu bác Đoàn. Làm sơ sơ nên nếu 2 đối tượng khác màu / layer nhau thì sẽ mất 1 đối tượng.

    • Like 1

  7. Đã đăng · Trả lời báo cáo

    4 giờ trước, nghia7x đã nói:

    đúng rồi bác nhưng để mà được như "sau" thì mình phải dùng cả Trim + Extend , BR+ BF thì mới ra đc , còn dùng fillet thì nó nhập làm 1 mất tiêu ( Cad 16) . Ông trong cty dùng Cad 10 thì nối được bằng fillet nhưng ko nhập thành 1

    Trim/Extend thì có thể chung 1 lệnh. ví dụ như Trim thì nhấn Shift là Extend và ngược lại. Bạn có thể chọn kiểu Extend edge của trim/extend để dễ sài hơn.

    Còn viết lisp thì phức tạp. Mình không có cad 10 để test thử nhưng mình nghĩ nó là lisp. Nếu máy sài được thì có lisp sẳn nên lấy sài tiếp thôi. Chứ viết lisp này cũng khá phức tạp nếu viết kỹ.

    Mình viết cho bạn 1 đoạn lisp ngắn là break polyline tại 1 điểm

    (defun c:bb(/ p) (command "BREAK" (setq p (getpoint)) p))

    Có thể dùng ngắt polyline sau fillet/chamfer.

  10. Đã đăng · Trả lời báo cáo

    8 giờ trước, Duong Nhat Duy đã nói:

    Mình muốn viết 1 lisp Fillet 2 đối tượng khác cao độ (trc khi fillet cho cao độ về 0)

    Mình muốn nó như 1 lệnh Fillet xịn trong command.

    Mình định dùng pause nhưng ko biết có cách nào lấy thông tin nhập liệu từ người dùng qua lệnh pause ko, giả sử bên dưới mình muốn lấy thông tin của 2 đối tượng fillet thì làm ntn:

    • cadvietlisp.lsp
      lisp help
    •   
    
(command "FILLET")
(while (= (logand (getvar "CMDACTIVE") 1) 1)
  (command pause)
  )

    Hoặc là có cách tiếp cận nào khác không ?

    Các bạn giúp mình nhé, cảm ơn !

    Cách đơn giản có thể là chuyển tất cả dối tượng trên bản vẽ về cao độ 0 rồi thực hiện lệnh. Cách khó là tự viết lại 2 hàm trên.

    Còn muốn giữ preview thì ko dc.

    • Vote tăng 1

  11. Đã đăng · Trả lời báo cáo

    Hic mấy bác cũng hay thật. Mình đọc chỉ hiểu sơ được ý chủ thớt thôi. Theo mình thì bài toán này có mấy trường hợp.

    - Chiều dài được tính là theo khoảng cách hay chiều dài. (Vd như arc length hay distance khoảng cách điểm đầu điểm cuối.

    - Khoảng 2 đầu được vẽ như thế nào khi chiều dài lẻ.

    - Khi Pline kín mà khoảng cách lẻ thì vẽ như thế nào?

    Theo AutoCad thì linetype nó vẽ theo chiều dài. Lypetype generation thì nó xác định theo toàn đường hay từng đoạn.

    Phần 2 đầu thì nó làm phần dư. Nếu pline khép kín thì nó chuyển qua chia đều.

    Mình viết thử 1 phương án khoảng cách theo length, Nhưng trim luôn 2 đầu. Không chạy được với Pline - Fit/smooth( Với đường này cần explore nó ra rồi join lại sẽ chạy được)

    Các đường khác như circle,arc, elip, elip arc, spline chạy bình thường.

    Lisp sử dụng command break nên chạy hơi chậm. 

    (defun c:br1(/ oso l1 l2 l0 n ob)
  
  (initget 0 "5x5 10x10 20x10")
  (mapcar 'set '(l1 l2)
	  (nth (vl-position (cond ((getkword " Chon [5x5/10x10/20x10]:"))
				  ("5x5"))
		 '("5x5" "10x10" "20x10"))
	       '((5 10) (10 20) (20 30))))
  (setq oso (getvar 'osmode))
  (setvar 'osmode 0)
  (foreach ex (acet-ss-to-list (ssget))
    (if (/= (setq ob  (vlax-ename->vla-object ex)
		  Len (vlax-curve-getdistatparam ob (vlax-curve-getendparam ob))
		  n   (fix (/ (- len l1) l2))
		  l0  (/ (- len l1 (* n l2)) 2)) 0)
      (progn
	(command "break" (list ex (vlax-curve-getpointatdist ob (- len l0))) (vlax-curve-getendpoint ob))
	(command "break" (list ex (vlax-curve-getstartpoint ob)) (vlax-curve-getpointatdist ob l0))))
    (repeat n
      (command "break" (list ex (vlax-curve-getpointatdist ob l1)) (vlax-curve-getpointatdist ob l2))
      (setq ex (entlast)ob (vlax-ename->vla-object ex))))
  
  (setvar 'osmode oso)
  (princ))

     

     

    • Like 2
    • Vote tăng 1

  12. Đã đăng · Trả lời báo cáo 

    (defun acos (x) (if (<= -1 x 1) (atan (sqrt(- 1 (* x x))) x)))
(defun gg(a b c)
  (if (and (/= a 0) (/= b 0))
    (acos (/ (- (+ (* a a) (* b b)) (* c c)) (* 2 a b)))))
(defun cdtg(en / lp d ag a0 a1)
  (setq en (entget en))
  (if (and (eq (cdr (assoc 0 en)) "LWPOLYLINE")
	   (eq (cdr (assoc 90 en)) 4)
	   (eq (cdr (assoc 70 en)) 0)
	   (setq lp (mapcar 'cdr (vl-remove-if-not '(lambda(x) (eq (car x) 10)) en))
		 d  (mapcar 'distance lp (cdr lp))
		 ag (apply 'gg d)))
    (progn
      (setq a0 (if (> (sin (- (angle (cadr lp) (caddr lp)) (setq a1 (angle (cadr lp) (car lp))))) 0) (+ a1 ag) (- a1 ag))
	    lp (list (car lp) (cadr lp) (polar (cadr lp) a0 (cadr d)))
	    en (vl-remove-if '(lambda(x) (vl-position (car x) '(10 40 41 42 91))) en))
      (entmod (append
		(subst '(90 . 3) '(90 . 4) (subst '(70 . 1) '(70 . 0) en))
		(apply 'append
		       (mapcar '(lambda(x) (cons (cons 10 x) '((40 . 0) (41 . 0) (42 . 0) (91 . 0)))) lp)))))))
(defun c:pl2tg()
  (cdtg (car(entsel)))
  (princ))
(defun c:tg(/ en n)
  (setq en (entlast) n 4)
  (while (entnext en) (setq en (entnext en)))
  (command "pline" pause)
  (while (/= (getvar 'cmdactive) 0)
    (if (> (setq n (1- n)) 0) (command pause) (command "")))
  (if (/= en (entlast)) (cdtg (entlast)))
  (princ))

    Buổi sáng code nhanh cho bạn.

    - Lệnh pl2tg: Chuyển đỗi polyline có 3 cạnh (4 dỉnh ,  open) thành pl tam giác có chiều dài 3 cạnh bằng 3 cạnh pl.

    - Lệnh tg. Vẽ tam giác bằng cách vẽ pl 3 cạnh trên.

    * Lưu ý là cạnh đầu tiên pl sẽ không đổi, điểm thứ 3 sẽ định hướng tam giác.

     Nếu xác định được tam giác sẽ chuyển nếu ko thì thôi.

    • Like 1
    • Vote tăng 1

  13. Đã đăng · Trả lời báo cáo

    46 phút trước, DuongTrungHuy đã nói:

    À cám ơn Doan Nguyen Van nhé. Thì ra là vậy.

     

    Hì ý là 2 hình có chu vi 1 cái là 12.0 và 1 cái 12.0000001 mà lại cho rằng 2 hình này bằng nhau. 

    Thì đúng rồi cái này chạm đến sai số thì thua thật, mà thật, nếu có 2 hình như thế thì mình cũng cho = thôi vì không có ý nghĩa thực tế lắm.

    Thực ra về số, khái niệm bằng nhau cũng chỉ có đối với số nguyên, còn với số thực thì khái niệm = chỉ là tương đối.

    Mà Bạn nói xét thêm các góc nhỡ nó cũng sai nhau cách 0.0000001 mà mình cho nó = cũng sai. Thôi thì vậy là quá xui cho nó rồi cho nó = nhau thôi (đùa tí).

     

    Còn ý bạn về cái cặp cạnh tương ứng, nếu Bạn làm vậy thì đúng dài mất thời gian thật.

    Cám ơn Bạn nhé. Chúc công việc tốt đẹp.  

    Ví dụ như 2 hình này thì theo cách lisp của bạn là bằng nhau?

     

    new block.dwg

  14. Đã đăng · Trả lời báo cáo

    Mình có viết thử 1 chút. 

    (defun c:sspline(/ en1 en2 infopl sspl)
  (defun infopl(en / d a b p tm)
    (mapcar '(lambda(x)
	       (Cond ((eq (car x) 10) (setq p (append p (list (cdr x)))))
		     ((eq (car x) 42) (setq b (append b (list (cdr x)))))))
	    en)
    (setq d (mapcar 'distance p (append (cdr p) (list (car p))))
	  a (mapcar 'angle (cons (last p) p) p)
	  a (mapcar '- a (cons (last a) a))
	  a (mapcar '(lambda(x) (if (< x 0) (+ x pi pi) x)) a))
    (list (cdr (assoc 70 en)) d a b))
  (defun sspl(s1 s2 / n ss1 ss2 rex s3 k)
    (defun rex(x) (append (cdr x) (list (car x))))
    (defun ss1(s1 s2 eqn) (vl-every '(lambda(a b) (equal a b eqn)) s1 s2))
    (defun ss2(s1 s2 / sc)
      (setq sc (/ (caar s1) (caar s2)))
      (if (and (vl-every '(lambda(a b) (equal sc (/ a b) 1e-12)) (car s1) (car s2)) ; So saanh canh
	       (ss1 (cadr s1) (cadr s2) 1e-8) ; So sanh goc
	       (ss1 (caddr s1) (caddr s2) 1e-8)); So sanh bul
	sc))
    (if (and
	  (eq (car s1) (car s2))
	  (eq (setq n (length (cadr s1))) (length (cadr s2))))
      (progn
	(if (eq (car s1) 0) (setq n 1))
	(setq s1 (cdr s1) s2 (cdr s2)
	      s3 (mapcar 'reverse (list (car s1) (mapcar '(lambda(x) (- (+ pi pi) x)) (cadr s1)) (mapcar '- (caddr s1))))
	      s3 (list (car s3) (rex (cadr s3)) (caddr s3)))
	(while (and (not (or (setq k (ss2 s1 s2))
			     (setq k (ss2 s3 s2))))
		    (/= (setq n (1- n)) 0))
	  (setq s1 (mapcar 'rex s1)
		s3 (mapcar 'rex s3)))
	k)))
  (if (and (setq en1 (car (nentsel "Select pline 1:")))
	   (eq (cdr(assoc 0 (setq en1 (entget en1)))) "LWPOLYLINE")
	   (setq en2 (car (nentsel "Select pline 2:")))
	   (eq (cdr(assoc 0 (setq en2 (entget en2)))) "LWPOLYLINE"))
    (if (setq en1 (sspl (infopl en1) (infopl en2)))
      (alert (strcat "2 Polyline dong dang ti le canh " (rtos en1)))
      (alert (strcat "2 Polyline khong dong dang " )))))

    - Chỉ xét đồng dạng. chưa xét đối xứng.

    - Viết theo kiểu xét các cạnh và góc bằng nhau.

    - Có so sánh luôn polyline cả line và arc.

    Có sai 1 chút nhưng chưa rảnh đề sửa là nếu open PL thì lỡ so sánh luôn bulge cuối không có cạnh. Và chưa so sánh luôn phần đối xúng.

  15. Đã đăng · Trả lời báo cáo

    6 giờ trước, Doan Nguyen Van đã nói:

    E giải quyết đc rồi, bác cũng có thể viết mà, có khi còn trường hợp nào xót thì sao.

    hinh4.png.78763ac19fece0ce144ecf4799e1e414.png

    Chắc là vậy đó bác, e còn bước so sánh đường tròn ngoại tiếp cho chắc

    Không biết chủ thớt có phân biệt hình đối xứng nhau không? Ví dụ 2 tam giác đối xứng nhau thì có đầy đủ tính bạn xét nhưng chiều quay ngược nhau.

     

  16. Đã đăng · Trả lời báo cáo

    2 phút trước, Doan Nguyen Van đã nói:

    Đây là 1 trường hợp đạt đủ các điều kiện: Diện tích, chu vi, thứ tự các cạnh bằng nhau, số đỉnh bằng nhau, nhưng vẫn không phải giống nhau.

    ·- Vấn đề là mình hỏi là đã giải quyết các vấn đề này chưa thôi?

    Chứ có vấn đề là giải quyết được hết.

    Vì mình tính viết thử nhưng có bạn viết rồi thôi.

    Cách suy nghĩ mình so sánh đa giác là dựa trên n cạnh và n góc. Cho nên khi so sánh cũng đơn giản. Nếu tìm hình đồng dạng thì góc không thay đổi chỉ tính tỉ lệ cạnh. Cách dịch chuyển hay đảo chiều cũng dễ.

     

  17. Đã đăng · Trả lời báo cáo

    10 phút trước, Doan Nguyen Van đã nói:

    Vừa nãy e có sửa bên trên rồi ạ.

    Nếu lấy danh sách đỉnh để so sánh thì rất tốn công sắp xếp các tổ hợp đỉnh có thể xảy ra nên e không dùng đỉnh để xác định.

    Tất nhiên vì như thế nên nếu có 2 tam giác như bác nói thì vẫn sẽ nhận biết là giống nhau 

    Mình hỏi trước đó là ví dụ như tứ giác bất kỳ ABCD thì vẽ ngược lại DBCA hay thứ tự đỉnh khác là CDAB thì tứ giác đó giống nhau nhưng lisp phân biệt hay thống kê chung luôn?

    Thật sự thì cũng dễ nhưng để khỏi sót thôi. Thay vì so sánh 1 lấn thì phải so sánh nhiều lần hơn thôi. (n cạnh thì so sánh 2n lần). Tuy nhiên nếu sơ bộ diện tích, chu vi kiểm tra trước thì cũng ít phải so sánh.

  19. Đã đăng · Trả lời báo cáo

    12 phút trước, naturooo đã nói:

    Như hàm sau của LM: 

    
;;--------------------=={ String Subst }==--------------------;;
;;                                                            ;;
;;  Substitutes a string for all occurrences of another       ;;
;;  string within a string.                                   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  new - string to be substituted for 'old'                  ;;
;;  old - string to be replaced                               ;;
;;  str - the string to be searched                           ;;
;;------------------------------------------------------------;;
;;  Returns:  String with 'old' replaced with 'new'           ;;
;;------------------------------------------------------------;;

(defun LM:StringSubst ( new old str / inc len )
    (setq len (strlen new)
          inc 0
    )
    (while (setq inc (vl-string-search old str inc))
        (setq str (vl-string-subst new old str inc)
              inc (+ inc len)
        )
    )
    str
)

    Thì viết cấu trúc lệnh như thế nào để thay thế chuỗi như sau được ạ:

    "C:\\test1\\test2\\test3"

    Thành:

    "C:\test1\test2\test3"

    Em thử mãi không được :(

    Cái "C:\\test1\\test2\\test3" thì Cad hiểu là cái dưới

    Còn cái "C:\test1\test2\test3" thì cad hiều /t là tab ascii là 9

    Vì vậy

    (LM:StringSubst "\t" "\\t" "C:\\test1\\test2\\test3")

     

     

    • Like 1

  23. Đã đăng · Trả lời báo cáo

    20 phút trước, Ma Vương đã nói:

     

    Cái quan trọng chủ topic hỏi là không biết tangent line 1 2 với đường tròn 3  góc 15º  bằng cách nào
    Dùng shift + Tangent không được.
    Mình dùng cách lấy đường tâm, quay 15º rồi move đường line đó cho cắt đường tròn tại khu vực có thể dễ tangent. Rồi vẽ đường line xuất phát từ tâm đường tròn và kết thúc là vuông góc với đường line 15º. Rồi extend nó giao với đường tròn. Rồi move đường line 15º đó tới điểm giao đó. Chính xác 100%. Chỉ là mình không biết có cách nào nhanh hơn không thôi.

    Rõ ràng bắt tanger không được đánh góc vì góc phải xác định điểm base. Nên muốn vẽ thì phải tìm phương án khác thôi. Suy nghĩ nhanh được cách nào thì làm cách đó thôi. Còn cách nhanh thì có thể vẽ line thăng đứng qua điểm quad tiếp xúc vòng tròn rồi quay theo tâm vòng tròn 15 độ là xong.

    Mình trả lời để bạn ấy suy nghĩ thoáng 1 chút trong cách vẽ thôi chứ không bắt buộc phải cố gắng làm chuyện không thể. Lý do cad vẽ bắt điểm 1 số trường họp điểm động thì sẽ thiếu 1 số chức năng.

  24. Đã đăng · Trả lời báo cáo 

    (defun c:nd(/ ss tt st i)
  (or (setq ss (vl-sort (mapcar '(lambda(x) (cons (vla-get-EffectiveName (setq x (vlax-ename->vla-object x)))
					          (vlax-safearray->list(vlax-variant-value(vla-get-insertionpoint x)))))
			         (acet-ss-to-list (ssget '((0 . "INSERT")))))
		        '(lambda(x y) (if (eq (car x) (car y)) (< (caddr x) (caddr x)) (< (car x) (car y))))))
      (exit))
  (setq tt (list (car ss))
	i 1)
  (foreach x (append (cdr ss) '(nil))
    (if (eq (car x) (caar tt)) (setq tt (cons x tt))
      (progn
	(or (tblsearch "LAYER" (setq st (strcat "Noi Diem " (itoa i))))
	    (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")
			   (cons 2 st) '(70 . 0))))
	(entmakex (vl-list* '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 st) '(100 . "AcDbPolyline")
				(cons 90 (length tt)) '(70 . 0)
			    (mapcar '(lambda (x)(cons 10 (cdr x))) tt)))
	(setq tt (list x)
	      i  (1+ i)))))
  (princ))

    Viết nhanh .Sài đỡ.

    • Like 2
    • Vote tăng 1

  25. Đã đăng · Trả lời báo cáo

    Bạn vẽ Cad mà cứ nghĩ vẽ đường nào đúng đường đó là không nên. Bạn nên nghĩ đến vẽ các đường phụ đễ xác định đường mình cần vẽ.

    Tùy theo tình hình mà nên vẽ cái nào trước. Nếu có sẵn 1 số thứ thì vẽ riêng rồi move vào cũng được. 

    Nếu mình vẽ mới hết thì mình vẽ vậy

    image.png.8f40dd1b2d8f11a0b57ee1ed9ce88733.png

    Tuy nhiên do thực tế thì thường người ta ve 3 cái lỗ tròn trước. Nên bạn có thể vẻ 3 bước đầu rồi move về tâm vòng tròn trên là dc.

    Nên bật polar tracking (F10) với góc 15 là dễ vẽ hơn

     

×