Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

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


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#3201 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 18 March 2011 - 11:07 AM

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")
  • 0

#3202 hugo75

hugo75

    biết vẽ polygon

  • Members
  • PipPip
  • 72 Bài viết
Điểm đánh giá: -4 (bình thường)

Đã gửi 18 March 2011 - 01:35 PM

Bác gia_bach đã hiểu đúng ý e.Cảm ơn các bác đã quan tâm giúp đỡ.
  • 0

#3203 akita13

akita13

    biết pan

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

Đã gửi 18 March 2011 - 11:12 PM

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

#3204 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 18 March 2011 - 11:57 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3205 kamezoko

kamezoko

    biết vẽ line

  • Members
  • PipPip
  • 25 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 22 March 2011 - 03:26 PM

em kiếm được lisp nay trên diển đàn.
http://www.cadviet.c...iles/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
  • -1

#3206 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 107 (tàm tạm)

Đã gửi 22 March 2011 - 09:13 PM

em kiếm được lisp nay trên diển đàn.
http://www.cadviet.c...iles/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)
)

  • 3

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#3207 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 22 March 2011 - 10:26 PM

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)

  • 2

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#3208 kamezoko

kamezoko

    biết vẽ line

  • Members
  • PipPip
  • 25 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 23 March 2011 - 08:30 AM

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.. :(
  • 0

#3209 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 23 March 2011 - 09:26 AM

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"
  • 2

#3210 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 107 (tàm tạm)

Đã gửi 23 March 2011 - 01:04 PM

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

  • 1

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#3211 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 107 (tàm tạm)

Đã gửi 23 March 2011 - 01:08 PM

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á.
  • 0

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#3212 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 23 March 2011 - 01:33 PM

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ý.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#3213 hugo007

hugo007

    biết lệnh erase

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

Đã gửi 23 March 2011 - 01:38 PM

@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.
  • 0

#3214 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 24 March 2011 - 04:11 PM

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ề.....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3215 tvgtyb08

tvgtyb08

    biết vẽ spline

  • Members
  • PipPip
  • 92 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 27 March 2011 - 03:31 PM

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

#3216 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 28 March 2011 - 09:23 AM

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

#3217 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 March 2011 - 02:24 PM

Đú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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3218 daythung777

daythung777

    biết zoom

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

Đã gửi 28 March 2011 - 02:53 PM

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

#3219 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 28 March 2011 - 04:04 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3220 daythung777

daythung777

    biết zoom

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

Đã gửi 28 March 2011 - 04:47 PM

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:
  • 0