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

Viết lisp theo yêu cầu [phần 2]

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

Cảm ơn sự nhiệt tình giúp đỡ của bạn,mình đã dần biết,cho mình hỏi lần cuối,ngay ô nhập vào tên block nếu mình muốn để sẵn 1 tên nào đó chỉ việc enter là nó là tên block luôn và vẫn có thể nhập tên khác vào ô này,không cần chức năng không đặt tên.

Trong code của Tue_NV, bạn thay dòng :

(while (and (tblsearch "Block" (setq ten (getstring "\n Nhap ten Block/ Enter: Khong dat ten")))

(/= ten "") )

(alert "\n Ten Block da co => dat ten khac") )

 

bằng dòng :

(setq *ten* "Hugo75")

(while (and (setq ten (getstring (strcat "\n Nhap ten Block/ Enter <" *ten* ">: ")))

(if (= ten "") (setq ten *ten*)t)

(tblsearch "Block" ten))

(alert "\n Ten Block da co => dat ten khac") )

 

Có thể đổi tên khác Hugo75 tại dòng : (setq *ten* "Hugo75")

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 các bác!Mong cac bac viet dum e lisp giai quyet bai toan sau.Em có một đa giác,ta chia luoi ngang va luon doc.Em muon lay toa do cua cac diem giao nhau.Em có một đoạn lisp khi ma ta chon một điểm nằm trong đa giác thì nó sẽ xuất file txt toạ độ của điểm đó.Em da thu tang toa do x len mot luong dx, y len toa do dy roi kiem tra tiep neu nam trong da giac thi viet tiep vao file text nhung no bao loi.Em moi hoc nen van chua nam ro dk, mong cac bac giup do.

 

đây la đoạn lisp em suu tap duoc.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun @Inside (PIQ Object / ClosestPoint

ClosestParam Sample Start End P1

P2 P a1 a2 Defl

)

 

(setq Sample 0.2)

 

(vl-load-com)

(or (= (type @delta) 'SUBR)

(defun @delta (a1 a2)

(cond

((> a1 (+ a2 pi))

(+ a2 pi pi (- a1))

)

((> a2 (+ a1 pi))

(- a2 a1 pi pi)

)

(1 (- a2 a1))

)

)

)

(and

(cond

((not Object)

(prompt " No object provided.")

)

((= (type Object) 'VLA-Object))

((= (type Object) 'Ename)

(setq Object (vlax-ename->vla-object Object))

)

(1 (prompt " Improper object type."))

)

(or

(and

(< 1 (vl-list-length PIQ) 4)

(vl-every 'numberp PIQ)

)

(prompt " Improper point value.")

)

(or

(not

(vl-catch-all-error-p

(setq Start

(vl-catch-all-apply

'vlax-curve-getStartPoint

(list Object)

)

)

)

)

(prompt " Object is not a curve.")

)

(or

(equal Start (vlax-curve-getendpoint Object) 1e-10)

(prompt " Curve is not closed.")

)

(setq P (trans PIQ 1 0)) ; PIQ in WCS

(setq ClosestPoint

(vlax-curve-getclosestpointto Object P) ; In WCS

)

(not (equal P ClosestPoint 1e-10)) ; in WCS

(setq ClosestParam (vlax-curve-getparamatpoint Object ClosestPoint))

(setq ClosestPoint (trans ClosestPoint 0 1)) ; convert to UCS

(setq End (vlax-curve-getEndparam Object))

(setq P1 0.0

P2 Sample

Defl 0.0

)

(setq a1 (angle PIQ (trans Start 0 1))) ; in UCS

(while (<= P2 End)

(setq P2 (min P2 End))

(if (< P1 ClosestParam P2)

(setq a2 (angle PIQ ClosestPoint)

Defl (+ Defl (@delta a1 a2))

a1 a2

)

)

 

(while (not (setq P (vlax-curve-getPointAtParam Object P2)))

(setq P2 (+ P2 Sample))

)

(setq a2 (angle PIQ (trans P 0 1)) ; in UCS

Defl (+ Defl (@delta a1 a2))

a1 a2

P1 P2

P2 (+ P2 Sample)

)

)

 

(> (abs Defl) 4)

)

)

;;;;;;*************

(defun C:ITest (/ Object P diem j x y i coc str f x1 y1)

(setq j 0)

(while (<= j 10)

(setq Object (car (entsel "\nSelect curve: ")))

(setq p (getpoint "\n chon mot diem:"))

(setq fn (getfiled "ghi toa do ra file " "toa_do_diem" "txt" 1))

(setq f (open fn "w"))

(write-line fn f)

(write-line (strcat "STT" "\t\t" "x" "\t\t" "y") f)

(setq x (car p))

(setq y (cadr p)) (setq diem (@Inside P Object))

(if (equal diem T)

(progn

(setq x1 (rtos x 2 3))

(setq y1 (rtos y 2 3))

(setq str (strcat "\t" x1 "\t" y1))

(prompt str)

(write-line str f)

)

)

 

)

(close f)

(startapp "C:\\windows\\Notepad.exe" fn)

)

(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

Hay bạn thử đi theo hướng khác cho nó máu xem sao :

- Extrim phần lưới thừa bên ngoài

- Ssget toàn bộ các đường chia lưới bên trong đa giác -> ename list

- Lấy giao nonExtend 1 đường chia với n-1 đường chia còn lại -> listpoint 1

- Xóa đường chia đó khỏi tập ename.

- Tiếp tục cho đến hết -> list tất cả các điểm giao

- Undo -> ghi listpoint ra text

* Nếu tách tập chọn ra thành 2 tập riêng biệt gồm các đường chia song song nhau thì càng nhanh nữa.

* Nếu lưới chia là các đường vuông góc thì không cần hàm tìm giao nữa, lại càng nhanh hơn ^^

  • 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

em kiếm được lisp nay trên diển đàn.

http://www.cadviet.com/upfiles/3/ad_1.lsp

các anh giúp em sao cho lisp chạy thì có thêm phần chọn chiều cao kích thước và khoảng cách các số chẳn và số lẻ được phân cách bẳng dấu ","

em cám ơn trước. :rolleyes: :D

  • Vote giảm 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

em kiếm được lisp nay trên diển đàn.

http://www.cadviet.com/upfiles/3/ad_1.lsp

các anh giúp em sao cho lisp chạy thì có thêm phần chọn chiều cao kích thước và khoảng cách các số chẳn và số lẻ được phân cách bẳng dấu ","

em cám ơn trước. :rolleyes: :D

 

 

Tôi không biết cách đặt chiều cao text của dimension trực tiếp bằng lisp.Chi biết phải đặt trong dimstyle thôi. Anh nào biết chỉ dùm với.

Làm thủ công thì dùng lênh DDEDIT hay vào property sửa. Nếu làm thủ công đc thì lisp phải làm được các anh nhỉ?

Còn yêu cầu chuyển dấu chấm thành dấu phẩy thì kamezoko có thể dùng tạm cái này.

(defun dxf (code e) (cdr (assoc code (entget e))))
(defun cham2phay(x) (vl-string-subst "," "." (rtos x 2 3)))
;;;-------------------------------------------------------------
(defun TBCong (x1 x2) (/ (+ x1 x2) 2)) ;;;Trung binh cong
;;;-------------------------------------------------------------
(defun MidP (p1 p2) ;;;Midpoint
(list (TBCong (car p1) (car p2)) (TBCong (cadr p1) (cadr p2)) (TBCong (caddr p1) (caddr p2)))
)
;;;-------------------------------------------------------------
(defun getVert (e / i L) ;;;Return list of all vertex from pline e
(setq i 0 L nil)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
;;;-------------------------------------------------------------
(defun etype (e) (cdr (assoc 0 (entget e)))) ;;;Entity type
;;;-------------------------------------------------------------
(defun dim2p (p1 p2 s / dim lst str_val) ;;;Dimaligned 2 Point
(command "dimaligned" p1 p2 (polar (MidP p1 p2) (+ (angle p1 p2) (/ pi 2)) s))
(setq dim (entlast))
(setq lst (entget dim))
(setq str_val (cham2phay (dxf 42 dim)))
(entmod (subst (cons 1 str_val) (assoc 1 lst) lst))
(entupd dim)
)
;;;-------------------------------------------------------------
(defun dimLine(e s) ;;;Dimaligned Line
(dim2p (cdr (assoc 10 (entget e))) (cdr (assoc 11 (entget e))) s)
)
;;;-------------------------------------------------------------
(defun dimPline(e s) ;;;Dimaligned PLine
(setq Lp (getvert e) i 0)
(repeat (1- (length Lp))
(dim2p (nth i Lp) (nth (1+ i) Lp) s)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------
(defun C:AD( / ss s oldos e) ;;;AutoDimaligned Line & Pline
(vl-load-com)
(if (not s0) (setq s0 10))
(setq
	ss (ssget '((0 . "LINE,LWPOLYLINE")))
	s (getdist (strcat "\nKhoang cach tu doi tuong den duong kich thuoc <" (rtos s0) ">:"))
	oldos (getvar "osmode")
)
(if (not s) (setq s s0) (setq s0 s))
(setvar "osmode" 0)
(while (setq e (ssname ss 0))
(if (= (etype e) "LINE") (dimLine e s) (dimPline e s))
(ssdel e ss)
)
(setvar "osmode" oldos)
(princ)
)

  • Vote tăng 3

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 không biết cách đặt chiều cao text của dimension trực tiếp bằng lisp.Chi biết phải đặt trong dimstyle thôi. Anh nào biết chỉ dùm với.

Làm thủ công thì dùng lênh DDEDIT hay vào property sửa. Nếu làm thủ công đc thì lisp phải làm được các anh nhỉ?

 

Bạn thử cái này nhé:

 

Với Dim có entname là Obj:

 (vlax-put-property (vlax-ename->vla-object Obj) 'textheight chieucaotext)

  • 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

Cám ơn hochoaivandot và nguyentuyen6

em mong các anh giúp thêm,em không kết hợp được 2 lisp của các anh.. :(

Bạn thay hàm chính của bạn bằng code sau :

 

(defun C:AD( / ss s oldos e caotext) ;;;AutoDimaligned Line & Pline

(if (not s0) (setq s0 10))

(setq

ss (ssget '((0 . "LINE,LWPOLYLINE")))

s (getdist (strcat "\nKhoang cach tu doi tuong den duong kich thuoc <" (rtos s0) ">:"))

oldos (getvar "osmode")

)

(if (not s) (setq s s0) (setq s0 s))

(setvar "osmode" 0)

(setq caotext (getreal "\n Nhap chieu cao Text :"))

(while (setq e (ssname ss 0))

(if (= (etype e) "LINE")

(dimLine e s) (dimPline e s))

(ssdel e ss)

)

(setvar "osmode" oldos)

(princ)

)

và thay hàm con dim2p của bạn bằng code sau :

 

(defun dim2p (p1 p2 s) ;;;Dimaligned 2 Point

(command "dimaligned" p1 p2 (polar (MidP p1 p2) (+ (angle p1 p2) (/ pi 2)) s))

(command "DIMOVERRIDE" "dimtxt" caotext "" (entlast) "")

)

;; Các hàm con khác giữ như cũ

Còn yêu cầu là : khoảng cách các số chẳn và số lẻ được phân cách bẳng dấu "," nghĩa là sao bạn Kame?

 

@hochoaivandot : Có thể sử dụng command "DIMOVERRIDE"

  • 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

Cám ơn hochoaivandot và nguyentuyen6

em mong các anh giúp thêm,em không kết hợp được 2 lisp của các anh.. :(

@hochoaivandot : Có thể sử dụng command "DIMOVERRIDE"

 

@TUE_NV: không ngờ có lệnh hay thế này mà lâu ni không biết. Cảm ơn anh 1 lần nưa

@kamezoko: Cách làm của anh TUE_NV có thể giải quyết được 2 yêu cầu của bạn

Mình hoàn chỉnh cho bạn rồi nè.

;;;-------------------------------------------------------------
(defun TBCong (x1 x2) (/ (+ x1 x2) 2)) ;;;Trung binh cong
;;;-------------------------------------------------------------
(defun MidP (p1 p2) ;;;Midpoint
(list (TBCong (car p1) (car p2)) (TBCong (cadr p1) (cadr p2)) (TBCong (caddr p1) (caddr p2)))
)
;;;-------------------------------------------------------------
(defun getVert (e / i L) ;;;Return list of all vertex from pline e
(setq i 0 L nil)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
;;;-------------------------------------------------------------
(defun etype (e) (cdr (assoc 0 (entget e)))) ;;;Entity type
;;;-------------------------------------------------------------
(defun dim2p (p1 p2 s h) ;;;Dimaligned 2 Point
(command "dimaligned" p1 p2 (polar (MidP p1 p2) (+ (angle p1 p2) (/ pi 2)) s))
(command "DIMOVERRIDE" "dimtxt" h "DIMDSEP" "," "" (entlast) "")
)
;;;-------------------------------------------------------------
(defun dimLine(e s h) ;;;Dimaligned Line
(dim2p (cdr (assoc 10 (entget e))) (cdr (assoc 11 (entget e))) s h)
)
;;;-------------------------------------------------------------
(defun dimPline(e s h) ;;;Dimaligned PLine
(setq Lp (getvert e) i 0)
(repeat (1- (length Lp))
(dim2p (nth i Lp) (nth (1+ i) Lp) s h)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------
(defun C:AD( / ss s oldos e) ;;;AutoDimaligned Line & Pline
(vl-load-com)
(if (not s0) (setq s0 10))
(setq
	ss (ssget '((0 . "LINE,LWPOLYLINE")))
	s (getdist (strcat "\nKhoang cach tu doi tuong den duong kich thuoc <" (rtos s0) ">:"))
	oldos (getvar "osmode")
)
(if (not s) (setq s s0) (setq s0 s))
(if (not caotext1) (setq caotext1 2.00))
(setq caotext (getreal (strcat "\n Nhap chieu cao Text <" (rtos caotext1 2 2) ">:")))
(if (not caotext) (setq caotext caotext1)  (setq caotext1 caotext))	
(setvar "osmode" 0)
(while (setq e (ssname ss 0))
(if (= (etype e) "LINE") (dimLine e s caotext) (dimPline e s caotext))
(ssdel e ss)
)
(setvar "osmode" oldos)
(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

Không biết diễn đàn chúng ta có chức năng thành viên tự xoá bài của mình đã post không nhỉ.

Em post nhầm 2 lần không biết làm sao để xoá.

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

Không biết diễn đàn chúng ta có chức năng thành viên tự xoá bài của mình đã post không nhỉ.

Em post nhầm 2 lần không biết làm sao để xoá.

Chỉ xóa được nội dung: Bạn vào bài viết của Bạn và chọn mục "Sửa" để chỉnh, xóa... Nhưng không xóa được Topic, cái này phải nhờ người quản lý.

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

@TUE_NV: không ngờ có lệnh hay thế này mà lâu ni không biết. Cảm ơn anh 1 lần nưa

@kamezoko: Cách làm của anh TUE_NV có thể giải quyết được 2 yêu cầu của bạn

Mình hoàn chỉnh cho bạn rồi nè.

;;;-------------------------------------------------------------
(defun TBCong (x1 x2) (/ (+ x1 x2) 2)) ;;;Trung binh cong
;;;-------------------------------------------------------------
(defun MidP (p1 p2) ;;;Midpoint
(list (TBCong (car p1) (car p2)) (TBCong (cadr p1) (cadr p2)) (TBCong (caddr p1) (caddr p2)))
)
;;;-------------------------------------------------------------
(defun getVert (e / i L) ;;;Return list of all vertex from pline e
(setq i 0 L nil)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
;;;-------------------------------------------------------------
(defun etype (e) (cdr (assoc 0 (entget e)))) ;;;Entity type
;;;-------------------------------------------------------------
(defun dim2p (p1 p2 s h) ;;;Dimaligned 2 Point
(command "dimaligned" p1 p2 (polar (MidP p1 p2) (+ (angle p1 p2) (/ pi 2)) s))
(command "DIMOVERRIDE" "dimtxt" h "DIMDSEP" "," "" (entlast) "")
)
;;;-------------------------------------------------------------
(defun dimLine(e s h) ;;;Dimaligned Line
(dim2p (cdr (assoc 10 (entget e))) (cdr (assoc 11 (entget e))) s h)
)
;;;-------------------------------------------------------------
(defun dimPline(e s h) ;;;Dimaligned PLine
(setq Lp (getvert e) i 0)
(repeat (1- (length Lp))
(dim2p (nth i Lp) (nth (1+ i) Lp) s h)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------
(defun C:AD( / ss s oldos e) ;;;AutoDimaligned Line & Pline
(vl-load-com)
(if (not s0) (setq s0 10))
(setq
	ss (ssget '((0 . "LINE,LWPOLYLINE")))
	s (getdist (strcat "\nKhoang cach tu doi tuong den duong kich thuoc <" (rtos s0) ">:"))
	oldos (getvar "osmode")
)
(if (not s) (setq s s0) (setq s0 s))
(if (not caotext1) (setq caotext1 2.00))
(setq caotext (getreal (strcat "\n Nhap chieu cao Text <" (rtos caotext1 2 2) ">:")))
(if (not caotext) (setq caotext caotext1)  (setq caotext1 caotext))	
(setvar "osmode" 0)
(while (setq e (ssname ss 0))
(if (= (etype e) "LINE") (dimLine e s caotext) (dimPline e s caotext))
(ssdel e ss)
)
(setvar "osmode" oldos)
(princ)
)

Có bác nào chỉ cho e biết tác dụng của lisp này dùng làm gì không vậy?Thanks.

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ó bác nào chỉ cho e biết tác dụng của lisp này dùng làm gì không vậy?Thanks.

Hề hề hề,

Tác dụng của các lisp này được ghi khá rõ ngay sau tên của mỗi lisp. Bạn chịu khó đọc kỹ sẽ thấy. Giả tỷ như cái vốn tiếng Anh còn lỏng thì hãy sử dụng từ điển google là nó dịch cho bạn sang cả tiếng căm pu chia ấy chứ.

Hề hề hề,

Chả phải tiếc chi mấy câu trả lời bạn, song có điều bạn sẽ chẳng thèm nhớ nên sẽ lại phải trả lời thêm dăm ba lần nữa cũng chả khoái.

Bạn hãy chịu khó vất vả một tí, khéo mà lại nhớ lâu đó. hề hề hề.....

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

Em chào các anh.

Em nhờ các anh dạy em viết hoặc viết giúp em File dạng *.mns để khi Load nó lên nó sẽ tự động load các Líp có đường dẫn mặc định.

Là thế này: Em sưu tầm được các Lisp trên Cadviet bây giờ e muốn làm thế nào có được File *.mns để khi vào menuload load nó lên thì nó tự động load các lisp có đường dẫn mặc định kia mà không phải vào AP rồi Add trong Contens...

Em cảm ơn các anh.

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

Thank you Bác, thôi thì Bác viết giúp em 1 cái Lisp mới vậy.

Merry Christmas and Happy New Year!

 

Lisp này có thể sửa lại để select các Circles và Line rồi ghi text như bản vẽ đã upload.

;; free lisp from cadviet.com
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td (/ diem PT1 PT2 PT3 tapx tapy 
           x y xx yy h n di kc
           C PT PTX PTY PTD PTC N
           p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
  (setq om (getvar "osmode"))
  (setq tapx '()
    tapy '()
    stt '()
    k 0
    h (getreal "\nnhap chieu cao chu:"))
     
(while
  (setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
  (progn
    (setq   PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
        PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
         x (rtos(car diem) 2 4)
             y (rtos (cadr diem) 2 4)
       tapx (append tapx (list x))
       tapy (append tapy (list y))
         k (+ 1 k)
         N (strcat "P" (rtos k 2 0))
        stt (append stt (list N))
      );setq
  (setvar "osmode" 0)
  (command "text" "j" "BL" PT1 h 0 x)
  (setq TB (textbox (entget(entlast)))
    LC (car TB)
    RC (cadr TB)
    di (distance LC RC)
    PT3 (polar PT1 0 (+ di h))
    C  (polar PT3 0 (* 1.5 h))
   );setq
    (command "text" PT2 h 0 y
         "pline" diem PT1 PT3 ""
         "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
         "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )
    
    (setvar "osmode" om)
    );progn   
  );dong while
  
;tao bang thong ke
  (setq    kc (* 2 di)
        PT (getpoint"\nvi tri dat bang :")
    PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
      p1 (list (car PT) (+ (cadr PT)(* 2 h)))
      p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
          p3 (list (car p1) (+ (cadr p1)(* 2 h)))
      p4 (list (car p2) (+ (cadr p2)(* 2 h)))
    PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
    PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
    PTY (list (+ kc (car PTX)) (cadr PTX))
      p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
      p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
      p33 (list (+ kc (car p22)) (cadr p22))
      L1 (list (+ di (car p3))(cadr p3))
      L2 (list (+ kc (car L1))(cadr L1))
     n (length tapx)
     k 0
    );setq
(setvar "osmode" 0)
  (command "line" p1 p2 ""
       "text" "j" "m" p11 h 0 "" 
       "text" "j" "m" p22 h 0 "X" 
       "text" "j" "m" p33 h 0 "Y"
       "line" p3 p4 "")    

  (while (< k n) 
    (setq xx (nth k tapx)
      yy (nth k tapy)
     tstt(nth k stt))
    (command "text" "j" "m" PTD h 0 tstt 
             "text" "j" "m" PTX h 0 xx 
         "text" "j" "m" PTY h 0 yy 
         "line" PT PTC "")    
    (setq PT (list (car PT) (- (cadr PT)(* 2 h)))
         PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
     PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
     PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
     PTY (list (+ kc (car PTX)) (cadr PTX))
      k (+ 1 k));setq
  );while
  (if (= k n)
    (setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
          PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
      L11 (list (+ di (car PT))(cadr PT))
      L22 (list (+ kc (car L11))(cadr L11))
      );setq
    );if
(command "line" p3 PT ""
          "line" p4 PTC ""
      "line" L1 L11 ""
      "line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
  (command "Undo" "End")
  (princ)
);DONG toado

Đúng là lisp này rất hay. Nhưng bác có thể sửa giúp theo ý em như này được không ?

1.Đổi toạ độ của X thành Y, Y thành X (ví dụ toạ độ hiện tại (1,2) chuyển thành (2,1)

2.Lisp hỏi chọn hướng (góc)của toạ độ xuất ra; góc này có thể nhập hoặc chọn bằng cách pick điểm.

Chân thành cám ơn bác !

Thân !

  • 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

Đúng là lisp này rất hay. Nhưng bác có thể sửa giúp theo ý em như này được không ?

1.Đổi toạ độ của X thành Y, Y thành X (ví dụ toạ độ hiện tại (1,2) chuyển thành (2,1)

2.Lisp hỏi chọn hướng (góc)của toạ độ xuất ra; góc này có thể nhập hoặc chọn bằng cách pick điểm.

Chân thành cám ơn bác !

Thân !

Hề hề hề,

Chưa hiểu ý của bạn yêu cầu

2.Lisp hỏi chọn hướng (góc)của toạ độ xuất ra; góc này có thể nhập hoặc chọn bằng cách pick điểm.

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ờ các anh trên diễn đàn viết dùm em list xóa các đường polyline trùng nhau. Giống như lệnh overkill

1. Biết là giống, sao bạn không dùng overkill^^

2. Bạn chịu khó search yêu cầu của mình trước khi post :), ở link bên dưới mình thấy bác binh giải quyết khá đẹp r nè :)

Overlay

  • 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

Em đã đọc bài viết trên rồi nhưng khi sử dụng chọn đối tượng không được. Em đang nối các đường đồng mức 2d polyline nên có rất nhiều đường trùng nhau 1 phần. Sử dụng qua overkill thì quá lâu :wacko:

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

Hề hề hề,

Chưa hiểu ý của bạn yêu cầu

2.Lisp hỏi chọn hướng (góc)của toạ độ xuất ra; góc này có thể nhập hoặc chọn bằng cách pick điểm.

Rất cám ơn "phamthanhbinh" đã quan tâm. Cụ thể hoá yêu cầu trong file

Toa do

Thâ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

Rất cám ơn "phamthanhbinh" đã quan tâm. Cụ thể hoá yêu cầu trong file

Toa do

Thân !

Mạn phép tác giả mình sửa giúp bạn

 

(defun C:td (/ diem PT1 PT2 PT3 tapx tapy 
          x y xx yy h n di kc
          C PT PTX PTY PTD PTC N
          p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22 lstname)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(if (null h)(setq h 5))  
 (setq om (getvar "osmode"))
 (setq tapx '()
   tapy '()
   stt '()
   k 0
   h1 (getreal (strcat "\nNhap chieu cao chu: < " (rtos h 2 0) " >"))
ang (getangle "\nNhap goc nghieng text :")
)
(if h1 (setq h h1))    
(while
 (setq diem (getpoint "\nChon cac vi tri co toa do can ghi:"))
 (progn
 (setq EL (entlast))
   (setq   PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
       PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
        y (rtos(car diem) 2 4)
            x (rtos (cadr diem) 2 4)
      tapx (append tapx (list x))
      tapy (append tapy (list y))
        k (+ 1 k)
        N (strcat "P" (rtos k 2 0))
       stt (append stt (list N))
     );setq
 (setvar "osmode" 0)
 (command "text" "j" "BL" PT1 h 0 x)
 (setq TB (textbox (entget(entlast)))
   LC (car TB)
   RC (cadr TB)
   di (distance LC RC)
   PT3 (polar PT1 0 (+ di h))
   C  (polar PT3 0 (* 1.5 h))
  );setq
   (command "text" PT2 h 0 y
        "pline" diem PT1 PT3 ""
        "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
        "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )
  (while (setq EL (entnext EL)) (setq Listname (cons EL Listname)))
(command "_rotate" (acet-list-to-ss Listname) "" diem (polar diem ang 1))
(setq listName nil)
   (setvar "osmode" om)
   );progn   
 );dong while

;tao bang thong ke
 (setq    kc (* 2 di)
       PT (getpoint"\nvi tri dat bang :")
   PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
     p1 (list (car PT) (+ (cadr PT)(* 2 h)))
     p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
         p3 (list (car p1) (+ (cadr p1)(* 2 h)))
     p4 (list (car p2) (+ (cadr p2)(* 2 h)))
   PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
   PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
   PTY (list (+ kc (car PTX)) (cadr PTX))
     p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
     p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
     p33 (list (+ kc (car p22)) (cadr p22))
     L1 (list (+ di (car p3))(cadr p3))
     L2 (list (+ kc (car L1))(cadr L1))
    n (length tapx)
    k 0
   );setq
(setvar "osmode" 0)
 (command "line" p1 p2 ""
      "text" "j" "m" p11 h 0 "" 
      "text" "j" "m" p22 h 0 "X" 
      "text" "j" "m" p33 h 0 "Y"
      "line" p3 p4 "")    

 (while (< k n) 
   (setq xx (nth k tapx)
     yy (nth k tapy)
    tstt(nth k stt))
   (command "text" "j" "m" PTD h 0 tstt 
            "text" "j" "m" PTX h 0 xx 
        "text" "j" "m" PTY h 0 yy 
        "line" PT PTC "")    
   (setq PT (list (car PT) (- (cadr PT)(* 2 h)))
        PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
    PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
    PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
    PTY (list (+ kc (car PTX)) (cadr PTX))
     k (+ 1 k));setq
 );while
 (if (= k n)
   (setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
         PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
     L11 (list (+ di (car PT))(cadr PT))
     L22 (list (+ kc (car L11))(cadr L11))
     );setq
   );if
(command "line" p3 PT ""
         "line" p4 PTC ""
     "line" L1 L11 ""
     "line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
 (command "Undo" "End")
 (princ)
);DONG toado

 

P/S : dù sao thì mình cũng hơi buồn, vì đây không phải là yêu cầu khó, bạn cũng đang là 1 lisper, câu hỏi này bạn cũng hỏi ở topic của chính lisp này, mình cũng có đọc thấy nhưng "lờ" đi, k ngờ sau 1 tjan vẫn thế

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

P/S : dù sao thì mình cũng hơi buồn, vì đây không phải là yêu cầu khó, bạn cũng đang là 1 lisper, câu hỏi này bạn cũng hỏi ở topic của chính lisp này, mình cũng có đọc thấy nhưng "lờ" đi, k ngờ sau 1 tjan vẫn thế

Nếu vậy xin lỗi bạn, thực tế mình đã có sửa qua nhưng ko được theo ý. Vi mình mới quan tâm và học lisp nên chỉ có thể can thiệp vào những đoạn mã lisp tương đối đơn giản và do thời gian hạn chế.

Cám ơn "ketxu" !

Thâ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

Em đã đọc bài viết trên rồi nhưng khi sử dụng chọn đối tượng không được. Em đang nối các đường đồng mức 2d polyline nên có rất nhiều đường trùng nhau 1 phần. Sử dụng qua overkill thì quá lâu :wacko:

Hề hề hề,

Không rõ bạn có am tường về lisp không nhưng qua bài pót của bạn mình thấy rằng, có nhẽ bạn không sử dụng dược lisp trên là do các đường đồng mức của bạn là các 3d polyline chứ không phải LWpolyline bạn ạ.

Vì thế nếu bạn muốn có được cái bạn cần thì có nhẽ bạn nên post một bản vẽ của bạn có chứa các đường như vậy để mọi người ngâm cứu thử và cũng nên nói rõ khi nào thì cần xóa. Khái niệm trùng ở đây của bạn là thế nào, trùng các hình chiếu trên mặt phẳng vẽ hay trùng hoàn toàn cả về các vertex của nó. Theo mình nghĩ thì có nhẽ bạn muốn xóa các phần hình chiếu trùng nhau của các đường đồng múc mà như vậy thì có ổn không vì bản thân mỗi đường đồng mức là một polyline riêng biệt có cao độ đồng nhất. khi xóa một phần nào đó của cái đường đồng mức này đi thì liệu nó có còn là cái đường đồng mức bạn cần hay không???

Rất mong bạn nói rõ mới có thể giúp bạn được. Tốt nhất bạn nên gửi file bản vẽ trước khi xử lý và file bản vẽ kết quả sau xử lý để mọi người hiểu và dễ dàng giúp bạn.

Nếu bạn có thể thì dựa vào cái thuật toán mình đã sử dụng trong cái lisp bạn đã đọc, bạn thử áp dụng vào các 3dpolyline của bạn xem sao. Như vậy có nhẽ sẽ được đúng với yêu cầu của bạn hơn, vì có thể mọi người chưa hiểu đúng ý bạn.

Hề hề hề,

Chúc bạn vui.

  • 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

Nếu vậy xin lỗi bạn, thực tế mình đã có sửa qua nhưng ko được theo ý. Vi mình mới quan tâm và học lisp nên chỉ có thể can thiệp vào những đoạn mã lisp tương đối đơn giản và do thời gian hạn chế.

Cám ơn "ketxu" !

Thân !

Có lẽ do lisp này dài dài vậy nên bạn nghĩ nó khó, thực chất cũng không đến nỗi khó lắm đâu. Cái bạn cần là 1 tờ giấy để ghi lại "diem" nó ở chỗ nào, lệnh này nó sẽ ghi text ở đâu, lệnh này nó làm cái j... và 1 chút kiên nhẫn, đọc từ trên xuống dưới.Tất cả đều là các lệnh rõ ràng và dễ hiểu.

Mình gọi là sửa cho nó oai, nhưng thực chất chỉ sửa 2 từ (x thành y và ngược lại), thêm 4 dòng nữa thôi (Nhập góc, lấy ename tất cả từ khi bắt đầu vẽ, quay tập ename đó), nên mình nghĩ nếu bạn tâm huyết với vấn đề của mình, chắc chắn bạn sẽ làm được.

Chúc bạn thành công và thổi nhiệt huyết sang các CADman khá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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×