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

[Danh Cong 422]

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

[Danh Cong 422]

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

 

[quocmanh04tt 635]

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

[Danh Cong 422]

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

[Danh Cong 422]

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 ạ.  :)  :)  :)

[gia_bach 1.551]

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

[Danh Cong 422]

dùng command nhé : PEDIT -> Reverse

 

Dạ, cám ơn anh  #GiaBach  :D :D 

[nhunha_pro279 8]

Bạn #DanhCong ơi không biết lisp của bạn có thể phát triển được thành chèn block tại các điểm point đó hay không nhỉ (giống như điểm chuẩn để chèn ấy)

[Danh Cong 422]

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

 

[nhunha_pro279 8]

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.

[Danh Cong 422]

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    

[nhunha_pro279 8]

Cảm ơn bạn nhé!

[nhunha_pro279 8]

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?

[Danh Cong 422]

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

[nhunha_pro279 8]

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é!

[Danh Cong 422]

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

 

[quocmanh04tt 635]

@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?

[tutri 0]

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

[Danh Cong 422]

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

[quocmanh04tt 635]

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 

[Danh Cong 422]

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:

[quocmanh04tt 635]

Tải lại ở link cũ xem!

[Danh Cong 422]

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

[quocmanh04tt 635]

Lại nhé: https://drive.google.com/file/d/0B2LetfHDljPGQ3BtVmJ2Z3NnSjQ/view?usp=sharing

Link2: https://www.dropbox.com/s/p4xgn0pgggcu510/RBL.fas?dl=0

[Danh Cong 422]

Lại nhé: https://drive.google.com/file/d/0B2LetfHDljPGQ3BtVmJ2Z3NnSjQ/view?usp=sharing

Link2: https://www.dropbox.com/s/p4xgn0pgggcu510/RBL.fas?dl=0

 

Đã test và thấy Tuyệt vời luôn :D  :D 1 like cho bác.