Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
tuan138

Nhờ Tư Vấn Lisp Chuyển Polyline Sang Arc

Các bài được khuyến nghị

Dear các bác em có bài toán mong các bác giúp đỡ và tư vấn.

 

Em đang làm việc với rất nhiều đường cong dạng  Polyline nhưng polyline ( hoặc spline) thi không Dimradius được.

 

Cách bình thường của em là em đồ lại Arc dọc theo các đường neo của Polyline để tạo các cung tương tự và Dim theo từng đoạn. Nhưng với khối lượng rất nhiều đường nên mất rất nhiều thời gian.

 

Em đã tìm lisp để convert Polyline sang arc nhưng không tìm thấy giải pháp.

 

Về ý tưởng code thì sẽ viết code cứ 3 điểm neo vẽ 1 đường cong hoặc 6 điểm neo vẽ 1 đường cong. Tuy nhiên mới học lisp ở giai đoạn đọc để hiểu còn chưa thông nên nhờ các bác giúp đỡ để học hỏi.

 

Bác nào tư vấn giúp em về trường hợp này được không ạ?

 

Chân thành cảm ơn các bác.

 

Ví dụ về polyline(bản vẽ)

https://www.dropbox.com/s/y7x9zzh9agi0piu/polyline.dwg?dl=0

 

 

 

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Trường hợp này toàn cung tròn là được vẽ bằng các segment pline thẳng thì làm sao mà dimradius được. Chỉ còn cách làm tay thôi :D số bạn đen rồi.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Trường hợp này toàn cung tròn là được vẽ bằng các segment pline thẳng thì làm sao mà dimradius được. Chỉ còn cách làm tay thôi :D số bạn đen rồi.

Cảm ơn bác đã trả lời. 

 

Vậy thì đen thật bác ạ. :ph34r:

 

Em có thể phá các pline đó sau đó lấy các tập hợp điểm trùng nhau, dựa vào các tập hợp điểm đó vẽ các đoạn acr ngắn được không bác.

Mong được bác tư vấn tiếp :)

 

Cảm ơn Bee rất nhiều.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Cảm ơn bác đã trả lời. 

 

Vậy thì đen thật bác ạ. :ph34r:

 

Em có thể phá các pline đó sau đó lấy các tập hợp điểm trùng nhau, dựa vào các tập hợp điểm đó vẽ các đoạn acr ngắn được không bác.

Mong được bác tư vấn tiếp :)

 

Cảm ơn Bee rất nhiều.

Explode pline thì không cần. Code này của 1 đồng chí Russia :D

Thử nghịch xem nhé. Chuyển các segment là line thành arc segment. Nhớ di chuột ít thôi nhé ^_^

(defun c:hehehe ( / massoclst nthmassocsubst v^v unit _ilp doc lw enx gr enxb p1 p2 p3 b i n )

  (vl-load-com)

  (defun massoclst ( key lst )
    (if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst)))))
  )

  (defun nthmassocsubst ( n key value lst / k slst p j plst m tst pslst )
    (setq k (length (setq slst (member (assoc key lst) lst))))
    (setq p (- (length lst) k))
    (setq j -1)
    (repeat p
      (setq plst (cons (nth (setq j (1+ j)) lst) plst))
    )
    (setq plst (reverse plst))
    (setq j -1)
    (setq m -1)
    (repeat k
      (setq j (1+ j))
      (if (equal (assoc key (member (nth j slst) slst)) (nth j slst) 1e-6)
        (setq m (1+ m))
      )
      (if (and (not tst) (= n m))
        (setq pslst (cons (cons key value) pslst) tst t)
        (setq pslst (cons (nth j slst) pslst))
      )
    )
    (setq pslst (reverse pslst))
    (append plst pslst)
  )

  (defun v^v ( u v )
    (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p )
    (if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7))
      (progn
        (setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1))))
              p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (trans o 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (list (car op) (cadr op) (caddr p1p))
              tp  (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0)
        )
        (if (inters p1p p2p op tp nil)
          (progn
            (setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0))
            p
          )
          nil
        )
      )
      (progn
        (setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor))))
        (setq p (trans pp nor 0))
        p
      )
    )
  )

  (or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
  (vla-startundomark doc)
  (if (and (setq lw (entsel "\nPick LWPOLYLINE..."))
          (= (cdr (assoc 0 (setq enx (entget (car lw))))) "LWPOLYLINE")
      )
    (progn
      (setq i (fix (vlax-curve-getParamAtPoint
                  (car lw)
                  (vlax-curve-getClosestPointToProjection (car lw) (trans (cadr lw) 1 0) '(0.0 0.0 1.0))
                  ) ;_  vlax-curve-getParamAtPoint
              ) ;_  fix
           p1 (vlax-curve-getPointAtParam (car lw) i)
           p3 (vlax-curve-getPointAtParam (car lw) (1+ i))
           lw (car lw)
      )
      (setq enxb (massoclst 42 enx))
      (while (= 5 (car (setq gr (grread t))))
        (setq p2 (_ilp (trans (cadr gr) 1 0) (mapcar '+ (trans (cadr gr) 1 0) '(0.0 0.0 1.0)) p1 (cdr (assoc 210 (entget lw)))))
        (setq b ((lambda (a) (/ (sin a) (cos a)))
                (/ (- (angle (trans p2 0 lw) (trans p3 0 lw)) (angle (trans p1 0 lw) (trans p2 0 lw))) 2.0)
               )
        )
        (setq n -1)
        (foreach dxf42 enxb
          (setq n (1+ n))
          (if (= n i)
            (setq enx (nthmassocsubst n 42 b enx))
            (setq enx (nthmassocsubst n 42 (+ (cdr dxf42) b) enx))
          )
        )
        (entupd (cdr (assoc -1 (entmod enx))))
      )
    )
    (prompt "\n Nothing selected or picked object not a LWPOLYLINE ")
  )
  (vla-endundomark doc)
  (princ)
)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Trường hợp này toàn cung tròn là được vẽ bằng các segment pline thẳng thì làm sao mà dimradius được. Chỉ còn cách làm tay thôi :D số bạn đen rồi.

Có thể cách này được không bạn.

1.- Đầu tiên ta vẽ cung tròn qua 3 điểm đầu 1,2,3

2.- Tiếp đến ta vẽ cung tròn tiếp xúc với cung cũ tại 3 và đi qua điểm 4.

3.- Lại vẽ tiếp cung đi tiếp xúc với cung tròn last tại 4 và đi qia điểm 5.

4.- Cứ thế cho đến hết v.v....

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Có thể cách này được không bạn.

1.- Đầu tiên ta vẽ cung tròn qua 3 điểm đầu 1,2,3

2.- Tiếp đến ta vẽ cung tròn tiếp xúc với cung cũ tại 3 và đi qua điểm 4.

3.- Lại vẽ tiếp cung đi tiếp xúc với cung tròn last tại 4 và đi qia điểm 5.

4.- Cứ thế cho đến hết v.v....

Bạn xem file của chủ thớt gửi chưa ?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Explode pline thì không cần. Code này của 1 đồng chí Russia :D

Thử nghịch xem nhé. Chuyển các segment là line thành arc segment. Nhớ di chuột ít thôi nhé ^_^

(defun c:hehehe ( / massoclst nthmassocsubst v^v unit _ilp doc lw enx gr enxb p1 p2 p3 b i n )

  (vl-load-com)

  (defun massoclst ( key lst )
    (if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst)))))
  )

  (defun nthmassocsubst ( n key value lst / k slst p j plst m tst pslst )
    (setq k (length (setq slst (member (assoc key lst) lst))))
    (setq p (- (length lst) k))
    (setq j -1)
    (repeat p
      (setq plst (cons (nth (setq j (1+ j)) lst) plst))
    )
    (setq plst (reverse plst))
    (setq j -1)
    (setq m -1)
    (repeat k
      (setq j (1+ j))
      (if (equal (assoc key (member (nth j slst) slst)) (nth j slst) 1e-6)
        (setq m (1+ m))
      )
      (if (and (not tst) (= n m))
        (setq pslst (cons (cons key value) pslst) tst t)
        (setq pslst (cons (nth j slst) pslst))
      )
    )
    (setq pslst (reverse pslst))
    (append plst pslst)
  )

  (defun v^v ( u v )
    (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p )
    (if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7))
      (progn
        (setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1))))
              p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (trans o 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (list (car op) (cadr op) (caddr p1p))
              tp  (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0)
        )
        (if (inters p1p p2p op tp nil)
          (progn
            (setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0))
            p
          )
          nil
        )
      )
      (progn
        (setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor))))
        (setq p (trans pp nor 0))
        p
      )
    )
  )

  (or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
  (vla-startundomark doc)
  (if (and (setq lw (entsel "\nPick LWPOLYLINE..."))
          (= (cdr (assoc 0 (setq enx (entget (car lw))))) "LWPOLYLINE")
      )
    (progn
      (setq i (fix (vlax-curve-getParamAtPoint
                  (car lw)
                  (vlax-curve-getClosestPointToProjection (car lw) (trans (cadr lw) 1 0) '(0.0 0.0 1.0))
                  ) ;_  vlax-curve-getParamAtPoint
              ) ;_  fix
           p1 (vlax-curve-getPointAtParam (car lw) i)
           p3 (vlax-curve-getPointAtParam (car lw) (1+ i))
           lw (car lw)
      )
      (setq enxb (massoclst 42 enx))
      (while (= 5 (car (setq gr (grread t))))
        (setq p2 (_ilp (trans (cadr gr) 1 0) (mapcar '+ (trans (cadr gr) 1 0) '(0.0 0.0 1.0)) p1 (cdr (assoc 210 (entget lw)))))
        (setq b ((lambda (a) (/ (sin a) (cos a)))
                (/ (- (angle (trans p2 0 lw) (trans p3 0 lw)) (angle (trans p1 0 lw) (trans p2 0 lw))) 2.0)
               )
        )
        (setq n -1)
        (foreach dxf42 enxb
          (setq n (1+ n))
          (if (= n i)
            (setq enx (nthmassocsubst n 42 b enx))
            (setq enx (nthmassocsubst n 42 (+ (cdr dxf42) b) enx))
          )
        )
        (entupd (cdr (assoc -1 (entmod enx))))
      )
    )
    (prompt "\n Nothing selected or picked object not a LWPOLYLINE ")
  )
  (vla-endundomark doc)
  (princ)
)

Bác Bee tìm được lisp hay ghê.

 

Em thử nghiên cứu cái lisp của bác xem.

 

Cảm ơn Bác Bee nhiều nhé.

 

Mà bác Bee ơi. Muốn làm theo cách mà bác @DuongTrungHuy thì có làm được không bác Bee nhỉ:

 

1.- Đầu tiên ta vẽ cung tròn qua 3 điểm đầu 1,2,3

2.- Tiếp đến ta vẽ cung tròn tiếp xúc với cung cũ tại 3 và đi qua điểm 4.

3.- Lại vẽ tiếp cung đi tiếp xúc với cung tròn last tại 4 và đi qia điểm 5.

4.- Cứ thế cho đến hết v.v....

 

Em cảm ơn các bác đã quan tâm đến vấn đề của em  :D

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Bác Bee tìm được lisp hay ghê.

 

Em thử nghiên cứu cái lisp của bác xem.

 

Cảm ơn Bác Bee nhiều nhé.

 

Mà bác Bee ơi. Muốn làm theo cách mà bác @DuongTrungHuy thì có làm được không bác Bee nhỉ:

 

1.- Đầu tiên ta vẽ cung tròn qua 3 điểm đầu 1,2,3

2.- Tiếp đến ta vẽ cung tròn tiếp xúc với cung cũ tại 3 và đi qua điểm 4.

3.- Lại vẽ tiếp cung đi tiếp xúc với cung tròn last tại 4 và đi qia điểm 5.

4.- Cứ thế cho đến hết v.v....

 

Em cảm ơn các bác đã quan tâm đến vấn đề của em  :D

Vẫn làm đc ^_^ nhưng sẽ không chính xác 1 số góc cong. Thử cái này xem nhé.

(defun c:test (/ ss pLlst vLst n p1 p2 p3)
  (command "ucs" "name" "save" "temp")
  (command "ucs" "w")
  (if (not (setq ss (ssget '((0 . "LWPOLYLINE")))))
    (print "Ban da khong chon pline.")
    (progn
      (setq pLlst (vl-remove-if
		    'listp
		    (mapcar 'cadr (ssnamex ss))
		  )
      )
      
      (foreach pl pLlst
	(setq vLst   (mapcar 'cdr
			     (vl-remove-if-not
			       '(lambda (x) (= 10 (car x)))
			       (entget pl)
			     )
		     )
	)				;setq
	(setq n 0)
	(while (< 1 (length vLst))
	  (setq	p1 (nth n vLst)
		p2 (nth (+ n 1) vLst)
		p3 (nth (+ n 2) vLst)
	  )				;setq
	  (command "_arc" "_none" p1 "_none" p2 "_none" p3)
	  (setq vLst (cddr vLst))
	)				;while
      )					;foreach
    )					;progn
  )					;if
  (command "ucs" "name" "restore" "temp")
  (command "ucs" "name" "delete" "temp")
  (princ)
)					;defun
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Vẫn làm đc ^_^ nhưng sẽ không chính xác 1 số góc cong. Thử cái này xem nhé.

(defun c:test (/ ss pLlst vLst n p1 p2 p3)
  (command "ucs" "name" "save" "temp")
  (command "ucs" "w")
  (if (not (setq ss (ssget '((0 . "LWPOLYLINE")))))
    (print "Ban da khong chon pline.")
    (progn
      (setq pLlst (vl-remove-if
		    'listp
		    (mapcar 'cadr (ssnamex ss))
		  )
      )
      
      (foreach pl pLlst
	(setq vLst   (mapcar 'cdr
			     (vl-remove-if-not
			       '(lambda (x) (= 10 (car x)))
			       (entget pl)
			     )
		     )
	)				;setq
	(setq n 0)
	(while (< 1 (length vLst))
	  (setq	p1 (nth n vLst)
		p2 (nth (+ n 1) vLst)
		p3 (nth (+ n 2) vLst)
	  )				;setq
	  (command "_arc" "_none" p1 "_none" p2 "_none" p3)
	  (setq vLst (cddr vLst))
	)				;while
      )					;foreach
    )					;progn
  )					;if
  (command "ucs" "name" "restore" "temp")
  (command "ucs" "name" "delete" "temp")
  (princ)
)					;defun

Bạn Bee có 1 nổ lực tuyệt vời đáng trân trọng!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tham gia 1 cái (có vẻ góc cong ổn hơn)

*** Nếu muốn để pline thì xóa dòng Explode pline->Arc

(defun c:tt (/ vertices-pl lsp lst pl)

(defun vertices-pl (e)

(if (setq e (member (assoc 10 e) e))

(cons (cdr (assoc 10 e)) (vertices-pl (cdr e)))))

(if (setq pl (car (entsel "\Pick PL")))

(progn (setq lsp (mapcar '(lambda (p) (trans p 0 1)) (vertices-pl (entget pl)))

lst (cdddr lsp))

(command "_.pline" "_none" (car lsp) "a" "s" "_none" (cadr lsp) "_none" (caddr lsp))

(while lst (command "_none" (car lst)) (setq lst (cdr lst)))

(command "")

(command "_.explode" (ssget "L")) ;Explode Pline->Arc

))

(princ))

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Bạn Bee có 1 nổ lực tuyệt vời đáng trân trọng!

Cám ơn bác, thời gian rảnh vào thư giãn tí thôi. ^_^ Mà có thêm cách nào convert tiếp những cái arc nhỏ thành những cái arc lớn không nhỉ ? Giả dụ mình gán một cái khoảng cách nào đấy mà những cái arc nhỏ hơn sẽ convert thành cái lớn :D

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Cám ơn bác, thời gian rảnh vào thư giãn tí thôi. ^_^ Mà có thêm cách nào convert tiếp những cái arc nhỏ thành những cái arc lớn không nhỉ ? Giả dụ mình gán một cái khoảng cách nào đấy mà những cái arc nhỏ hơn sẽ convert thành cái lớn :D

Chào Bee buổi sáng nhé!

Tức là ý Bee muốn vì nhiều cái arc nhỏ tuy mềm mại nhưng sẽ "nặng" hơn nên muốn làm cứng hóa chỉ còn ít arc thôi, như trong Poly nhiều đỉnh mà mình làm ít đỉnh lại nhưng vẫn cố bám sát đường Poly đó.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tham gia 1 cái (có vẻ góc cong ổn hơn)

*** Nếu muốn để pline thì xóa dòng Explode pline->Arc

(defun c:tt (/ vertices-pl lsp lst pl)

(defun vertices-pl (e)

(if (setq e (member (assoc 10 e) e))

(cons (cdr (assoc 10 e)) (vertices-pl (cdr e)))))

(if (setq pl (car (entsel "\Pick PL")))

(progn (setq lsp (mapcar '(lambda (p) (trans p 0 1)) (vertices-pl (entget pl)))

lst (cdddr lsp))

(command "_.pline" "_none" (car lsp) "a" "s" "_none" (cadr lsp) "_none" (caddr lsp))

(while lst (command "_none" (car lst)) (setq lst (cdr lst)))

(command "")

(command "_.explode" (ssget "L")) ;Explode Pline->Arc

))

(princ))

Chào quocmanh04tt.

Trong này bạn có dùng hàm (Trans p 0 1) bạn có thể nói ngắn hàm này làm gì không? hình như chuyển đổi hệ tọa độ hở? ý nghĩa các tham số p, 0 , 1

Cám ơn!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Vẫn làm đc ^_^ nhưng sẽ không chính xác 1 số góc cong. Thử cái này xem nhé.

(defun c:test (/ ss pLlst vLst n p1 p2 p3)
  (command "ucs" "name" "save" "temp")
  (command "ucs" "w")
  (if (not (setq ss (ssget '((0 . "LWPOLYLINE")))))
    (print "Ban da khong chon pline.")
    (progn
      (setq pLlst (vl-remove-if
		    'listp
		    (mapcar 'cadr (ssnamex ss))
		  )
      )
      
      (foreach pl pLlst
	(setq vLst   (mapcar 'cdr
			     (vl-remove-if-not
			       '(lambda (x) (= 10 (car x)))
			       (entget pl)
			     )
		     )
	)				;setq
	(setq n 0)
	(while (< 1 (length vLst))
	  (setq	p1 (nth n vLst)
		p2 (nth (+ n 1) vLst)
		p3 (nth (+ n 2) vLst)
	  )				;setq
	  (command "_arc" "_none" p1 "_none" p2 "_none" p3)
	  (setq vLst (cddr vLst))
	)				;while
      )					;foreach
    )					;progn
  )					;if
  (command "ucs" "name" "restore" "temp")
  (command "ucs" "name" "delete" "temp")
  (princ)
)					;defun

Bác Bee ơi. 

Cảm ơn bác đã viết code mới.

Nhưng em chạy nó báo lỗi bác ạ " error: bad argument type: fixnump: nil"

 

Em cảm ơn bác quocmanh04tt

Code của bác hoạt động hiệu quả đối với em.

Nếu thêm được tính năng như bác Bee nói thì tốt quá ạ. 

 

Theo em nghĩ có thể tùy chọn cấp độ chi tiết của đường cong, lúc này cho người dùng nhập vào cấp độ (VD:1 hoặc 2) được không bác.

Thật sự là em chưa nghĩ được ý tưởng nào để có thể đơn giản hóa theo cách của bác. 

Hoặc nếu như thuật toán như bác @DuongTrungHuy đề cập thì có thể căn cứ vào khoảng cách (X,Y) của các điểm neo polyline để xác định có vẽ cung đó hay không và lấy thông tin các điểm không vẽ đó để tính toán vẽ arc lớn hơn.

Hoặc nữa là căn cứ theo các arc có bán kính cong xấp xỉ nhau để merge.

 

Em xin lỗi bác Bee và Bác Quocmanh04tt vì chưa thể đóng góp ý kiến cho code vì mới đang học để đọc hiểu code các bác viết, đọc còn chưa thấu nên chưa đủ khả năng.

 

Lần nữa cảm ơn các bác rất nhiều cho vấn đề của em.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Thêm 1 bước làm mịn Pline (còn vấn đề kia thì tính toán phức tạp):

(defun c:tt (/ vertices-pl lsp lst pl lastEnt ss)

(defun vertices-pl (e)

(if (setq e (member (assoc 10 e) e))

(cons (cdr (assoc 10 e)) (vertices-pl (cdr e)))))

(if (and (setq pl (car (entsel "\nPick PLine"))) (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE"))

(progn (setq lsp (mapcar '(lambda (p) (trans p 0 1)) (vertices-pl (entget pl)))

lst (cdddr lsp))

(setvar 'CMDECHO 0)

(entdel pl) ;Xoa Pline goc

(command "_.pline" "_none" (car lsp) "a" "s" "_none" (cadr lsp) "_none" (caddr lsp))

(while lst (command "_none" (car lst)) (setq lst (cdr lst)))

(command "")

(initget "Y N")

(if (eq (getkword "\nLam min Pline [Y/N]? <N>:") "Y")

(progn (command "_.pedit" (ssget "L") "f" "")

(setq pl (ssget "L"))

(setq lastEnt (entlast)

ss (ssadd))

(command "_.explode" pl)

(while (setq lastEnt (entnext lastEnt)) (ssadd lastEnt ss))

(command "_.pedit" "m" ss "" "j" "" "")))))

(princ))

@Bác DuongTrungHuy: Là quy đổi điểm từ hệ tọa độ này sang hệ tọa độ kia, hàm (trans p 0 1) nằm trong mapcar như vậy thì bác biết p là gì rồi. UCS world: 0, UCS User (current ucs): 1

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Thêm 1 bước làm mịn Pline (còn vấn đề kia thì tính toán phức tạp):

(defun c:tt (/ vertices-pl lsp lst pl lastEnt ss)

(defun vertices-pl (e)

(if (setq e (member (assoc 10 e) e))

(cons (cdr (assoc 10 e)) (vertices-pl (cdr e)))))

(if (and (setq pl (car (entsel "\nPick PLine"))) (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE"))

(progn (setq lsp (mapcar '(lambda (p) (trans p 0 1)) (vertices-pl (entget pl)))

lst (cdddr lsp))

(setvar 'CMDECHO 0)

(entdel pl) ;Xoa Pline goc

(command "_.pline" "_none" (car lsp) "a" "s" "_none" (cadr lsp) "_none" (caddr lsp))

(while lst (command "_none" (car lst)) (setq lst (cdr lst)))

(command "")

(initget "Y N")

(if (eq (getkword "\nLam min Pline [Y/N]? <N>:") "Y")

(progn (command "_.pedit" (ssget "L") "f" "")

(setq pl (ssget "L"))

(setq lastEnt (entlast)

ss (ssadd))

(command "_.explode" pl)

(while (setq lastEnt (entnext lastEnt)) (ssadd lastEnt ss))

(command "_.pedit" "m" ss "" "j" "" "")))))

(princ))

@Bác DuongTrungHuy: Là quy đổi điểm từ hệ tọa độ này sang hệ tọa độ kia, hàm (trans p 0 1) nằm trong mapcar như vậy thì bác biết p là gì rồi. UCS world: 0, UCS User (current ucs): 1

Bác quocmanh04tt ơi!

 

Thay vì làm mịn thì có thể làm đơn giản hóa(kỷ hà) đoạn polyline được không ạ?

 

Em cảm ơn bác đã sửa code và giải thích trans ( em cũng đang tìm trans là gì)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Lisp của quocmanh04tt chỉ thay 81 đoạn gấp khúc thành 80 đoạn arc, dùng làm trơn pline thì được nếu dùng để Dimradius thì không hiệu quả.

Trong trường hợp có 1 đỉnh có hướng thay đổi nhiều, các đoạn arc sau đỉnh đó lệch pline rất nhiều.

 

Lisp của Bee chỉ đổi 2 đoạn liền nhau thành 1 arc, nếu số đoạn lẻ thì mất đoạn cuối.

Search gg thấy trang này có thuật toán, nhưng chưa có thời gian đọc xem có đúng y/c của bài này không

http://web.mit.edu/hyperbook/Patrikalakis-Maekawa-Cho/node203.html

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Lisp của quocmanh04tt chỉ thay 81 đoạn gấp khúc thành 80 đoạn arc, dùng làm trơn pline thì được nếu dùng để Dimradius thì không hiệu quả.

Trong trường hợp có 1 đỉnh có hướng thay đổi nhiều, các đoạn arc sau đỉnh đó lệch pline rất nhiều.

 

Lisp của Bee chỉ đổi 2 đoạn liền nhau thành 1 arc, nếu số đoạn lẻ thì mất đoạn cuối.

Search gg thấy trang này có thuật toán, nhưng chưa có thời gian đọc xem có đúng y/c của bài này không

http://web.mit.edu/hyperbook/Patrikalakis-Maekawa-Cho/node203.html

Cám ơn Bạn ndtnv đã chỉ dẫn. Hôm qua mình cũng gặp bài toán này, đó là chuyển tọa độ từ trong 1 khối đã chèn với hệ số thu phóng tại 1 vị trí hiện tại thành tọa độ thực hiện chèn. Loay hoay mãi tuy đã giải quyết nhưng hơi nhức đầu. Đã lâu có đọc về hàm này, nay thấy bạn trên nhắc lại mình hỏi xem chắc là sẽ gọn hơn nhờ hàm của thằng Cad đã có. Cảm ơn lần nữa vậy nhé!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Chào Bee buổi sáng nhé!

Tức là ý Bee muốn vì nhiều cái arc nhỏ tuy mềm mại nhưng sẽ "nặng" hơn nên muốn làm cứng hóa chỉ còn ít arc thôi, như trong Poly nhiều đỉnh mà mình làm ít đỉnh lại nhưng vẫn cố bám sát đường Poly đó.

Chào Huy

 

Vấn đề là mịn pline nhưng sẽ định vị nhiều điểm để xác định cung tròn nhỏ trong 1 số trường hợp cần dùng. Mà nghĩ lại thì chỉ convert được với 1 đỉnh, 2 đỉnh hoặc 3 đỉnh là hợp lý. Nói chung là chỉ nên convert như thế này là mình thấy hợp lý rồi. :D

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Chào Huy

 

Vấn đề là mịn pline nhưng sẽ định vị nhiều điểm để xác định cung tròn nhỏ trong 1 số trường hợp cần dùng. Mà nghĩ lại thì chỉ convert được với 1 đỉnh, 2 đỉnh hoặc 3 đỉnh là hợp lý. Nói chung là chỉ nên convert như thế này là mình thấy hợp lý rồi. :D

Như vậy mình có thể lưu lại các thông số của cung tròn nhỏ và gán vào thông số mở rộng của cung lớn, khi cần mình lấy ra để dùng được ko Bee. Các thông số cùng tròn cần lưu là 3 điểm trên cung là được nhỉ.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Như vậy mình có thể lưu lại các thông số của cung tròn nhỏ và gán vào thông số mở rộng của cung lớn, khi cần mình lấy ra để dùng được ko Bee. Các thông số cùng tròn cần lưu là 3 điểm trên cung là được nhỉ.

Mình nghĩ dừng ở đây thôi. Vì nếu convert thêm những cung tròn nhỏ thì tạo ra ccung lớn nhưng không bám theo được cung nhỏ đó. ^_^

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Mình nghĩ dừng ở đây thôi. Vì nếu convert thêm những cung tròn nhỏ thì tạo ra ccung lớn nhưng không bám theo được cung nhỏ đó. ^_^

Ok đúng rồi Bee.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Vẫn làm đc ^_^ nhưng sẽ không chính xác 1 số góc cong. Thử cái này xem nhé.

(defun c:test (/ ss pLlst vLst n p1 p2 p3)
  (command "ucs" "name" "save" "temp")
  (command "ucs" "w")
  (if (not (setq ss (ssget '((0 . "LWPOLYLINE")))))
    (print "Ban da khong chon pline.")
    (progn
      (setq pLlst (vl-remove-if
		    'listp
		    (mapcar 'cadr (ssnamex ss))
		  )
      )
      
      (foreach pl pLlst
	(setq vLst   (mapcar 'cdr
			     (vl-remove-if-not
			       '(lambda (x) (= 10 (car x)))
			       (entget pl)
			     )
		     )
	)				;setq
	(setq n 0)
	(while (< 1 (length vLst))
	  (setq	p1 (nth n vLst)
		p2 (nth (+ n 1) vLst)
		p3 (nth (+ n 2) vLst)
	  )				;setq
	  (command "_arc" "_none" p1 "_none" p2 "_none" p3)
	  (setq vLst (cddr vLst))
	)				;while
      )					;foreach
    )					;progn
  )					;if
  (command "ucs" "name" "restore" "temp")
  (command "ucs" "name" "delete" "temp")
  (princ)
)					;defun

 

Bác Bee ơi.

 

Cho em hỏi chút. Em chạy Lisp này của bác nhưng bị lỗi sau khi vẽ được 1 cung đầu tiên.

; error: bad argument type: fixnump: nil

Theo em hiểu thì nó báo sai định dạng.

Em thử atof để chuyển nó về Float cũng không được bác nhỉ. Bác giúp em với. 

Em dùng ( autocad 2009 mechanical)

Thanks bác.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Bác Bee ơi.

 

Cho em hỏi chút. Em chạy Lisp này của bác nhưng bị lỗi sau khi vẽ được 1 cung đầu tiên.

; error: bad argument type: fixnump: nil

Theo em hiểu thì nó báo sai định dạng.

Em thử atof để chuyển nó về Float cũng không được bác nhỉ. Bác giúp em với. 

Em dùng ( autocad 2009 mechanical)

Thanks bác.

Mình test lisp chạy trên file bạn gửi vẫn ok. ACAD2017. Bạn chạy file lỗi thì up lên mình xem rồi mới sửa lisp của mình được.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×