Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
32 replies to this topic

#1 tuan138

tuan138

    biết zoom

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

Đã gửi 11 October 2016 - 10:25 AM

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....lyline.dwg?dl=0

 

 

 

 


  • 0

#2 Bee

Bee

    biết lệnh trim

  • Members
  • PipPipPip
  • 193 Bài viết
Điểm đánh giá: 65 (tàm tạm)

Đã gửi 11 October 2016 - 10:37 AM

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.


  • 0

#3 tuan138

tuan138

    biết zoom

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

Đã gửi 11 October 2016 - 11:42 AM

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.


  • 0

#4 Bee

Bee

    biết lệnh trim

  • Members
  • PipPipPip
  • 193 Bài viết
Điểm đánh giá: 65 (tàm tạm)

Đã gửi 11 October 2016 - 02:51 PM

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)
)

  • 0

#5 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 11 October 2016 - 04:26 PM

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....


  • 0

#6 Bee

Bee

    biết lệnh trim

  • Members
  • PipPipPip
  • 193 Bài viết
Điểm đánh giá: 65 (tàm tạm)

Đã gửi 11 October 2016 - 04:40 PM

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 ?


  • 0

#7 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 11 October 2016 - 04:47 PM

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

Xin lỗi có thể mình chwa xem hì hì.


  • 0

#8 tuan138

tuan138

    biết zoom

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

Đã gửi 13 October 2016 - 09:47 AM

 

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


  • 0

#9 Bee

Bee

    biết lệnh trim

  • Members
  • PipPipPip
  • 193 Bài viết
Điểm đánh giá: 65 (tàm tạm)

Đã gửi 13 October 2016 - 07:30 PM

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

  • 1

#10 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 13 October 2016 - 08:59 PM

 

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!


  • 0

#11 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 669 Bài viết
Điểm đánh giá: 313 (khá)

Đã gửi 13 October 2016 - 09:03 PM

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))

  • 2

#12 Bee

Bee

    biết lệnh trim

  • Members
  • PipPipPip
  • 193 Bài viết
Điểm đánh giá: 65 (tàm tạm)

Đã gửi 13 October 2016 - 10:06 PM

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


  • 0

#13 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 14 October 2016 - 06:27 AM

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 đó.


  • 0

#14 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 14 October 2016 - 06:31 AM

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!


  • 0

#15 tuan138

tuan138

    biết zoom

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

Đã gửi 14 October 2016 - 08:48 AM

 

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.


  • 0

#16 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 669 Bài viết
Điểm đánh giá: 313 (khá)

Đã gửi 14 October 2016 - 09:46 AM

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
  • 1

#17 tuan138

tuan138

    biết zoom

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

Đã gửi 14 October 2016 - 10:02 AM

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ì)


  • 0

#18 ndtnv

ndtnv

    biết lệnh minsert

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

Đã gửi 14 October 2016 - 10:33 AM

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/h...ho/node203.html


  • 1

#19 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 14 October 2016 - 11:28 AM

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/h...ho/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é!


  • 0

#20 Bee

Bee

    biết lệnh trim

  • Members
  • PipPipPip
  • 193 Bài viết
Điểm đánh giá: 65 (tàm tạm)

Đã gửi 14 October 2016 - 07:46 PM

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


  • 0