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  
Danh Cong

Chỉnh Góc Xoay Của Block Trong Lisp.

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

Chào các anh chị trong CadViet. :)

Em có vấn đề về lisp nhờ các anh chị giúp đỡ ạ. 

 

Em đang có 1 lisp do bác #QuocManh viết.

Lisp có tác dụng / cách hoạt động như sau:  Em có 1 đường Poline , trên đường này có nhiều điểm point, lisp sẽ giúp em chèn 1 block vuông góc với Poline tại điểm point đó.

 

Tuy nhiên trong quá trình sử dụng thì có 1 số block quay vuông góc không theo ý muốn. < Em không up hình trực tiếp lên được, các anh chị xem tạm qua link sau>. 

 https://drive.google.com/open?id=0B8Wyt0hkwi0yUWF1c2x1TFJ4ZDg

Bản vẽ test: https://drive.google.com/file/d/0B8Wyt0hkwi0yUUNwb2tmaTBkczQ/view

 

+ Do em chưa đủ kiến thức để chỉnh sửa , mong các anh chị giúp sửa lisp sao cho block em quay đúng chiều theo ý muốn. < giống lệnh "MEASURE" ạ >

+ Cho em hỏi thêm:  Có cách nào để đảo ngược chiều tăng giá trị "Param" của đường Poline từ A--->Z   thành    Z--->A    không ạ.

 

Lisp chèn vuông góc: 

 

(defun c:cvg (/ MakeInsert BulgeCenter ang bul enp n name par poi pol pss stp)
 
  ;;;;;; Defun c1 : Dung de chen block
  
(defun MakeInsert (pt Name ang)
 
(entmakex (list (cons 0 "INSERT") (cons 2 Name) (cons 10 pt) (cons 50 ang)))
)
 
  ;;;;;; Defun c2 : Dung de xac dinh tam duong Curve
  
(defun BulgeCenter (p1 p2 B)
 
(polar p1 (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan B)))) (/ (* (distance p1 p2) (1+ (* b B))) 4 B))
)
  ;
 
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))    ; Ngat dong, thuc hien lenh UndoMark
  
;;;;;;; Bat Dau chuong trinh tinh toan
 
(if
  ; Dieu kien AND
  (and (setq pol (car (entsel "\nPick Pline: "))) ; Chon Polyline
 
(eq (cdr (assoc 0 (entget pol))) "LWPOLYLINE") ; Thuoc loai duong LWPOLYLINE
 
(setq name (getstring "\nBlock Name:")) ; Chon BLock chen
 
(tblsearch "block" name) ; Tim Block trong danh sach Block trong ban ve
 
(princ "\nChon cac Point: ")
 
(setq pss (ssget '((0 . "POINT"))))
   ) ; Chon Point de chen
  ; Ket thuc dieu kien AND
 
 
  ;; Bat Dau Progn
(progn
(or #xoaydoituong# (setq #xoaydoituong# "Yes"))
 
(initget "Yes No")
 
(setq #xoaydoituong# (cond ((getkword (strcat "\nXoay Block theo Pline ? <" #xoaydoituong# ">: ")))
 
(#xoaydoituong#)))
 
(repeat (setq n (sslength pss))
 
(setq poi (cdr (assoc 10 (entget (ssname pss (setq n (1- n)))))))
 
(and (vlax-curve-getParamAtPoint pol poi)
 
(setq par (fix (vlax-curve-getParamAtPoint pol poi))
 
 
     stp (vlax-curve-getPointAtParam pol par)
 
     enp (vlax-curve-getPointAtParam pol (1+ par))
 
     bul (vla-getbulge (vlax-ename->vla-object pol) par))
 
(if (zerop bul)
 
(setq ang (angle stp enp))
 
(setq ang (- (angle (BulgeCenter stp enp bul) poi) (* 0.5 pi)))
)
 
(cond ((eq (strcase #xoaydoituong#) "YES") (MakeInsert poi name ang))
 
((eq (strcase #xoaydoituong#) "NO") (MakeInsert poi name 0))
)
)
)
  )
  ; Ket Thuc Progn
  )
  ; Ket Thuc iF
 
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 
(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

Lisp chèn vuông góc.


 

(defun c:cvg (/ MakeInsert BulgeCenter ang bul enp n name par poi pol pss stp)
 
  ;;;;;; Defun c1 : Dung de chen block
  
(defun MakeInsert (pt Name ang)
 
(entmakex (list (cons 0 "INSERT") (cons 2 Name) (cons 10 pt) (cons 50 ang)))
)
 
  ;;;;;; Defun c2 : Dung de xac dinh tam duong Curve
  
(defun BulgeCenter (p1 p2 B )
 
(polar p1 (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan B )))) (/ (* (distance p1 p2) (1+ (* b B ))) 4 B ))
)
  ;
 
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))    ; Ngat dong, thuc hien lenh UndoMark
  
;;;;;;; Bat Dau chuong trinh tinh toan
 
(if
  ; Dieu kien AND
  (and (setq pol (car (entsel "\nPick Pline: "))) ; Chon Polyline
 
(eq (cdr (assoc 0 (entget pol))) "LWPOLYLINE") ; Thuoc loai duong LWPOLYLINE
 
(setq name (getstring "\nBlock Name:")) ; Chon BLock chen
 
(tblsearch "block" name) ; Tim Block trong danh sach Block trong ban ve
 
(princ "\nChon cac Point: ")
 
(setq pss (ssget '((0 . "POINT"))))
   ) ; Chon Point de chen
  ; Ket thuc dieu kien AND
 
 
  ;; Bat Dau Progn
(progn
(or #xoaydoituong# (setq #xoaydoituong# "Yes"))
 
(initget "Yes No")
 
(setq #xoaydoituong# (cond ((getkword (strcat "\nXoay Block theo Pline ? <" #xoaydoituong# ">: ")))
 
(#xoaydoituong#)))
 
(repeat (setq n (sslength pss))
 
(setq poi (cdr (assoc 10 (entget (ssname pss (setq n (1- n)))))))
 
(and (vlax-curve-getParamAtPoint pol poi)
 
(setq par (fix (vlax-curve-getParamAtPoint pol poi))
 
 
     stp (vlax-curve-getPointAtParam pol par)
 
     enp (vlax-curve-getPointAtParam pol (1+ par))
 
     bul (vla-getbulge (vlax-ename->vla-object pol) par))
 
(if (zerop bul)
 
(setq ang (angle stp enp))
 
(setq ang (- (angle (BulgeCenter stp enp bul) poi) (* 0.5 pi)))
)
 
(cond ((eq (strcase #xoaydoituong#) "YES") (MakeInsert poi name ang))
 
((eq (strcase #xoaydoituong#) "NO") (MakeInsert poi name 0))
)
)
)
  )
  ; Ket Thuc Progn
  )
  ; Ket Thuc iF
 
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 
(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

Thử cái này xem:

(defun c:cvg (/ doc msp n name par poi pol pss)

(setq doc (vla-get-activedocument (vlax-get-acad-object))

msp (vla-get-modelspace doc))

(vla-startundomark doc)

(if (and (setq pol (car (entsel "\nPick Pline: ")))

(eq (cdr (assoc 0 (entget pol))) "LWPOLYLINE")

(setq name (getstring "\nBlock Name:"))

(tblsearch "block" name)

(princ "\nChon cac Point: ")

(setq pss (ssget '((0 . "POINT")))))

(progn (or #xoaydoituong# (setq #xoaydoituong# "Yes"))

(initget "Yes No")

(setq #xoaydoituong# (cond ((getkword (strcat "\nXoay Block theo Pline? <" #xoaydoituong# ">: ")))

(#xoaydoituong#)))

(repeat (setq n (sslength pss))

(setq poi (cdr (assoc 10 (entget (ssname pss (setq n (1- n)))))))

(and (vlax-curve-getParamAtPoint pol poi)

(setq par (vlax-curve-getparamAtpoint pol (vlax-curve-getclosestpointto pol poi)))

(cond ((eq (strcase #xoaydoituong#) "YES")

(vla-insertblock msp

(vlax-3D-point poi)

name

1.0

1.0

1.0

(angle '(0.0 0.0 0.0)

(trans (vlax-curve-getfirstderiv pol par) 0 (cdr (assoc 210 (entget pol)))))))

((eq (strcase #xoaydoituong#) "NO")

(vla-insertblock msp (vlax-3D-point poi) name 1.0 1.0 1.0 0)))))))

(vla-endundomark doc)

(princ))

  • 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ử cái này xem:

(defun c:cvg (/ doc msp n name par poi pol pss)

(setq doc (vla-get-activedocument (vlax-get-acad-object))

msp (vla-get-modelspace doc))

(vla-startundomark doc)

(if (and (setq pol (car (entsel "\nPick Pline: ")))

(eq (cdr (assoc 0 (entget pol))) "LWPOLYLINE")

(setq name (getstring "\nBlock Name:"))

(tblsearch "block" name)

(princ "\nChon cac Point: ")

(setq pss (ssget '((0 . "POINT")))))

(progn (or #xoaydoituong# (setq #xoaydoituong# "Yes"))

(initget "Yes No")

(setq #xoaydoituong# (cond ((getkword (strcat "\nXoay Block theo Pline? <" #xoaydoituong# ">: ")))

(#xoaydoituong#)))

(repeat (setq n (sslength pss))

(setq poi (cdr (assoc 10 (entget (ssname pss (setq n (1- n)))))))

(and (vlax-curve-getParamAtPoint pol poi)

(setq par (vlax-curve-getparamAtpoint pol (vlax-curve-getclosestpointto pol poi)))

(cond ((eq (strcase #xoaydoituong#) "YES")

(vla-insertblock msp

(vlax-3D-point poi)

name

1.0

1.0

1.0

(angle '(0.0 0.0 0.0)

(trans (vlax-curve-getfirstderiv pol par) 0 (cdr (assoc 210 (entget pol)))))))

((eq (strcase #xoaydoituong#) "NO")

(vla-insertblock msp (vlax-3D-point poi) name 1.0 1.0 1.0 0)))))))

(vla-endundomark doc)

(princ))

 

 

Ok anh #QuocManh Ok anh, lisp dùng ổn anh ạ :) .

Mong anh mà mọi người trên diễn đàn mạnh khỏe - viết nhiều lisp cho em học mót :)   :)  :)  :)

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

Anh #Quocmanh và mọi người cho em hỏi thêm:

 

Giả sử đường Poline đang có giá trị "Param" chạy từ phần tử  A= 1 , B=2..... G=7, H=8..... ; Vậy giờ em muốn đảo ngược  giá trị thuộc tính của đường Poline đó lại theo thứ tự : A=8 , B=7...... G=2, H=1....  Thì có cách nào khô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

Anh #Quocmanh và mọi người cho em hỏi thêm:

 

Giả sử đường Poline đang có giá trị "Param" chạy từ phần tử  A= 1 , B=2..... G=7, H=8..... ; Vậy giờ em muốn đảo ngược  giá trị thuộc tính của đường Poline đó lại theo thứ tự : A=8 , B=7...... G=2, H=1....  Thì có cách nào không ạ.  :)  :)  :)

dùng command nhé : PEDIT -> Reverse

  • 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

Bạn thử xài lisp này coi sao: Test

(defun c:Test (/ makeinsert number block)

 
(defun makeinsert (name pt)
  (command "-insert" name pt "" "" ""))
  
(and
  (setq spt (ssget '((0 . "point")))
block (getstring "Nhap ten block: \n"))
(TBLSEARCH "block" block))
  (setq number 0)
  (repeat (SSLENGTH spt)
    (progn 
    (setq pt1 (cdr (assoc 10 (entget (ssname spt number))))
 number (+ number 1))
    (makeinsert block pt1)))
  (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

Bạn #Danh Cong ơi mình đánh lisp của bạn load được nhưng không chạy được bạn ah. Bạn có thể gửi code lại cho mình được không.

 

Mình kiểm tra, copy nguyên đoạn code để chạy. Lisp vẫn ngon lành.

 

Gửi bạn đường link Driver < Nếu bạn chưa biết cách tạo file .LSP >:

https://drive.google.com/open?id=0B8Wyt0hkwi0ya1RvelVHM2ZzSEU    

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 # DanhCong ơi cho mình hỏi thêm tí, với dòng lệnh như của bạn đã viết (car (entsel "\nPick Pline: ")) thì mình có thể thay thế thành chọn nhiều đối tượng polyline cùng lúc được khô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

Có thể:

Thay đoạn code bằng (ssget...) đi. 

Sau đó thì sử dụng vòng lặp repeat duyệt từng phần tử .

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

Nói thật là ý tưởng của mình là như thế nhưng về ngôn ngữ autolisp và thuật toán thì mình còn gà mờ lắm. Nếu được bạn có thể viết lại code giúp mình để mình tham khảo được không. Cảm ơn bạn trướ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

Bạn nên cảm ơn người viết lisp #QuocManh ở trên kia kìa  :D Tui có viết ra lisp đâu.

Mạn phép anh  #QuocManh chỉnh sửa lại lisp cho bạn . 

 

Mà cảm ơn thì nên đi cùng với hành động chứ nhỉ : ) 

 

 

Nói thật là ý tưởng của mình là như thế nhưng về ngôn ngữ autolisp và thuật toán thì mình còn gà mờ lắm. Nếu được bạn có thể viết lại code giúp mình để mình tham khảo được không. Cảm ơn bạn trước nhé!

 

 

(defun c:cvg (/ doc msp n name par poi pol pss num spoil)
 
(setq doc (vla-get-activedocument (vlax-get-acad-object))
 
msp (vla-get-modelspace doc))
(vla-startundomark doc)
 
(and
 
(princ "\nChon cac Polyline: \n")
  
(setq spol (ssget '((0 . "LWPOLYLINE")))
      num 0)
 
(setq name (getstring "\nBlock Name:"))
 
(tblsearch "block" name)
 
(princ "\nChon cac Point: ")
 
(setq pss (ssget '((0 . "POINT")))))
   
(or #xoaydoituong# (setq #xoaydoituong# "Yes"))
 
(initget "Yes No")
 
(setq #xoaydoituong# (cond ((getkword (strcat "\nXoay Block theo Pline? <" #xoaydoituong# ">: ")))
 
(#xoaydoituong#)))
 
   
 
(repeat (sslength spol)
   (progn 
   (setq pol (ssname spol num)
num (+ 1 num))
 
(if (= T T)
 
(progn 
 
(repeat (setq n (sslength pss))
 
(setq poi (cdr (assoc 10 (entget (ssname pss (setq n (1- n)))))))
 
(and (vlax-curve-getParamAtPoint pol poi)
 
(setq par (vlax-curve-getparamAtpoint pol (vlax-curve-getclosestpointto pol poi)))
 
(cond ((eq (strcase #xoaydoituong#) "YES")
 
(vla-insertblock msp
 
(vlax-3D-point poi)
 
name
 
1.0
 
1.0
 
1.0
 
(angle '(0.0 0.0 0.0)
 
(trans (vlax-curve-getfirstderiv pol par) 0 (cdr (assoc 210 (entget pol)))))))
 
((eq (strcase #xoaydoituong#) "NO")
 
(vla-insertblock msp (vlax-3D-point poi) name 1.0 1.0 1.0 0)))))))))
 
(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

@Danh Cong: (if (= T T) là sao?

​Với lisp trên chỉ cần thêm: (foreach pol  (vl-remove-if 'listp (mapcar 'cadr (ssnamex spol))) ngay phía trên (repeat (setq n (sslength pss)) là đủ, tất nhiên đóng ngoặc chỗ hợp lý cho thằng  foreach (spol thì giống như của bạn).

 

Anh #Quocmanh và mọi người cho em hỏi thêm:

 

Giả sử đường Poline đang có giá trị "Param" chạy từ phần tử  A= 1 , B=2..... G=7, H=8..... ; Vậy giờ em muốn đảo ngược  giá trị thuộc tính của đường Poline đó lại theo thứ tự : A=8 , B=7...... G=2, H=1....  Thì có cách nào không ạ.  :)  :)  :)

Mục đích là để lật block ngược trở lạ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

@Danh Cong: (if (= T T) là sao?

​Với lisp trên chỉ cần thêm: (foreach pol  (vl-remove-if 'listp (mapcar 'cadr (ssnamex spol))) ngay phía trên (repeat (setq n (sslength pss)) là đủ, tất nhiên đóng ngoặc chỗ hợp lý cho thằng  foreach (spol thì giống như của bạn).

 

Mục đích là để lật block ngược trở lại?

 

Em lười xíu, ko muốn xóa dòng  (IF....) mà anh cũng ko cho  :unsure:   :wacko:  :wacko:  Hi hi. (= T T) thì đằng nào nó vẫn chạy mà .....chứ bỏ đi vẫn được. 

Em đang học tìm hiểu mấy hàm Vlax nên chưa rành thuật toán lắm anh ạ. Mấy hôm em mới đọc hiểu lisp của anh, chứ chưa có nhiều thuật toán để sửa . 

 

Vâng, em hỏi giá trị Param là để lật ngược Block ạ. 

 

 

Có bảng nào hoàng chỉnh không vậy các anh 

 

Bảng nào cũng "hoàng" chỉnh cả. Tùy vào mục đích sử dụng của bạ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

Cho cái góc xoay của block cộng thêm pi là được.

Test thử cái này nhé (lệnh RBL): https://drive.google.com/file/d/0B2LetfHDljPGQ3BtVmJ2Z3NnSjQ/view?usp=sharing

Sau khi block được insert, chưa vội kết thúc mà di chuột về 2 đầu mút của pline để cảm nhậ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

Cho cái góc xoay của block cộng thêm pi là được.

- Vâng, em hiểu:

Nhưng muốn dùng thì chắc / hoặc:  Copy rồi thay tên sang 1 lệnh khác  /  thêm dòng code (  "Ban muon xoay nguoc Block lai khong" .: < Y N>) ... Hì, cái này thì lại gây mất thời gian bấm Enter quá, nên em hỏi cách đổi chiều Param luôn.  :D  :D

 

Link ko xài được bác ơi : https://drive.google.com/file/d/0B2LetfHDljPGQ3BtVmJ2Z3NnSjQ/view   Bác edit lại coi.  :mellow:

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ải lại ở link cũ xem!

Không được bác ạ :P

Được thì bác gửi cho em qua gmail để em xài thử với. Hồi hộp ghê:

gmail của em là : dodanhcong93@gmail.com

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

 

Đã test và thấy Tuyệt vời luôn :D  :D 1 like cho 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

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  

×