Đến nội dung


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

Viết Lisp theo yêu cầu


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

#2021 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 21 May 2009 - 08:44 PM

Chào cả nhà!
mình có cái lisp tính diện tích nhưng có hai điểm bất tiện như sau:
1. Phải klick vào vùng diện tích nào nằm trong vùng thấy của màn hình thì mới thực hiện được nếu không thì báo lỗi (giống như lệnh hatch trong cad 2004).
2. Sau khi lỗi thì nó sẽ tự động tắt tấc cả các truy bắt điểm (Object snap).
Ai biết giúp mình khắc phục lỗi này với. (cố gắng giữ lại mấy lệnh cũ giúp mình nghe, mình chưa học lisp nên mọi người làm hoanf thiện giúp mình nghe)
Cảm ơn nhiều!
Đoạn mã lệnh nè:
(defun DXF (code elist)
(cdr (assoc code elist))
);dxf

(defun c:AR(/ dtl dtcon pt1 pt2 ss et oslast vsize)
(if (= tl nil) (progn
(setq tl (getreal "\nDrawing scale : "))
; (setq ntl (/ 1000 tl))
; (setq tl2 (* ntl ntl))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 5))
(command "hatch" "SOLID" vsize "0" "l" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
; (setq dtl (/ (/ dtl tl2) 2))
; (setq dtl (/ dtl 2))
(print)
(prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
(print)
(setq pt2 (getpoint "\nPoint to write: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "2" "0" (rtos dtl 2 2))
);if
(princ)
);defun AR
;------------------------------------------------------------------------
(defun c:AR2(/ dtl dtcon pt1 pt2 ss et oslast vsize)
(if (= tl nil) (progn
(setq tl (getreal "\nDrawing scale : "))
; (setq ntl (/ 1000 tl))
; (setq tl2 (* ntl ntl))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 5))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
; (setq dtl (/ (/ dtl tl2) 2))
(setq dtl (/ dtl 2))
(print)
(prompt (strcat "\nHaft total area : " (rtos dtl 2 4)))
(print)
(setq pt2 (getpoint "\nPoint to write: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "2" "0" (rtos dtl 2 2))
);if
(princ)
);defun AR2
;-------------------------------------------------------------------------------
(defun C:vd()
(print)
(print)
(print)
(setq last (getvar "OSMODE"))
(command "setvar" "OSMODE" "33")
(command "setvar" "DIMZIN" 0 )

(if (= tl nil) (setq tl (getreal "Ty le ban ve : ")))

(setq PT1 (getpoint "Diem 1 : "))
; (setq PT2 (getpoint "Diem 2 : "))
; (setq dist1 (distance pt1 pt2))
; (setq ntl (/ 1000 tl))
; (setq dist (/ dist1 ntl))
(setq sum 0)

(while (/= pt1 nil)
(setq PT2 (getpoint "Diem 2 : "))
(print)
(setq dist1 (distance pt1 pt2))
(setq ntl (/ 1000 tl))
(setq dist (/ dist1 ntl))
(prompt (strcat "\n Chieu dai doan vua do la " (rtos dist 2 4)))
(print)
(setq sum (+ sum dist))
(setq PT1 (getpoint "Diem 1 : "))
);while

(prompt (strcat "\n Tong chieu dai la " (rtos sum 2 4)))
(print)
(command "setvar" "OSMODE" "64")
(setq pt3 (getpoint "Viet vao cho nao ? : "))
;(setq x (+ (car pt3) 2))
;(setq pt3 (list x (cadr pt3)))
(setq sum2 (/ sum 2))

(command "text" "S" "2" pt3 "0" (rtos sum2 2 2))

(command "setvar" "OSMODE" last)
(princ)
)

(prompt "\n Start with AR to calculate area by pick points method")
(prompt "\n Start with AR2 to calculate haft area by pick points method")
(prompt "\n Danh VD de tinh tong chieu dai ")
(prompt "\n This version is used for Nguyen Cong Hoan-Cienco 625 only - 25/05/2007")
(princ)
  • 0
Học học nữa học mãi.
Đúp học lại!

#2022 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 21 May 2009 - 09:13 PM

chào các bạn CADVIET, hôm nay mình nhờ các bạn viết giúp mình 1 lisp như thế này: mình có 1 lisp dùng để nối các đoạn PLINE với nhau lisp ấy đây :
bây h bản vẽ của mình bao gồm các PLINE nhưng mà nó lại bị cắt đi 1 đoạn nhỏ hoặc là bị chéo nhau 1 đoạn nhỏ. với kiểu như vậy thì lisp này nó kô nối được ( lại phải dùng lệnh PE hoặc filet ), mình mong các bạn cải tiến cái lisp này cho mình để sao cho nó có thể nối được luôn những đoạn như vậy mà kô cần phải dùng lệnh PE hoặc filet, mình gửi cùng bản vẽ. cảm ơn các bạn nhiều
http://www.2shared.c...8/Drawing1.html


Bạn thử cái này xem sao.
(defun c:nn (/ tdt ssdt sodt index)
(defun ObjName (ssdt /) (cdr (assoc '0 (entget ssdt))) )
(defun MoPL (ssdt /) (= (cdr (assoc '70 (entget ssdt))) 0))
(defun NoiPL (ssdt /)
(if (MoPL ssdt)
(COMMAND ".PEDIT" "M" tdt "" "J" "10" "")))
(defun NoiLC (ssdt /) (COMMAND ".PEDIT" "M" tdt "" "Y" "J" "10" ""))

(setq tdt (ssget)
ssdt (ssname tdt 0))
(if (or (= (Objname ssdt) "LWPOLYLINE")
(= (Objname ssdt) "POLYLINE"))
(NoiPL ssdt)
)
(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
(NoiLC ssdt)
)
(princ)
)

  • 1

#2023 oanhvang

oanhvang

    biết zoom

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

Đã gửi 23 May 2009 - 09:40 AM

Bạn thử cái này xem sao.

(defun c:nn (/ tdt ssdt sodt index)
(defun ObjName (ssdt /) (cdr (assoc '0 (entget ssdt))) )
(defun MoPL (ssdt /) (= (cdr (assoc '70 (entget ssdt))) 0))
(defun NoiPL (ssdt /)
(if (MoPL ssdt)
(COMMAND ".PEDIT" "M" tdt "" "J" "10" "")))
(defun NoiLC (ssdt /) (COMMAND ".PEDIT" "M" tdt "" "Y" "J" "10" ""))

(setq tdt (ssget)
ssdt (ssname tdt 0))
(if (or (= (Objname ssdt) "LWPOLYLINE")
(= (Objname ssdt) "POLYLINE"))
(NoiPL ssdt)
)
(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
(NoiLC ssdt)
)
(princ)
)



cảm ơn bạn nhiều, lisp này theo mình hiểu là với những đoạn cách nhau hoac chéo nhau có độ dài 10 thì nó mới đc phải kô bạn, liệu có thể cho việc chọn độ dài để nối được ấy vào 1 option của lisp đc kô bạn, cảm ơn bạn lần nữa
  • 0

#2024 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 23 May 2009 - 10:24 AM

Hic, em là 1 người mới biết trang này, sau khi đọc 3 ngày thi được 35 trang thì thấy có những Bác rất giỏi về Lisp như: Nguyen Hoang, ssq, vvdesperados, duy78206..... Hi vọng sau khi đọc được đến bài cuối thì em sẽ học hỏi được nhiều điều bổ ích. Cá mơn các Bác đã giúp đỡ mọi người rất nhiều.
  • 0

#2025 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 23 May 2009 - 10:40 AM

cảm ơn bạn nhiều, lisp này theo mình hiểu là với những đoạn cách nhau hoac chéo nhau có độ dài 10 thì nó mới đc phải kô bạn, liệu có thể cho việc chọn độ dài để nối được ấy vào 1 option của lisp đc kô bạn, cảm ơn bạn lần nữa

Bạn thử cái này xem :
(defun c:nn (/ tdt ssdt sodt index)

(defun ObjName (ssdt /) (cdr (assoc '0 (entget ssdt))) )

(defun MoPL (ssdt /) (= (cdr (assoc '70 (entget ssdt))) 0))

(defun NoiPL (ssdt kn /)
(if (MoPL ssdt)
(COMMAND ".PEDIT" "M" tdt "" "J" kn "")))

(defun NoiLC (ssdt kn /) (COMMAND ".PEDIT" "M" tdt "" "Y" "J" kn ""))

(setq tdt (ssget)
ssdt (ssname tdt 0))
(setq knoi (getreal "\n Chon khoang noi :"))

(if (or (= (Objname ssdt) "LWPOLYLINE")
(= (Objname ssdt) "POLYLINE"))
(NoiPL ssdt knoi)
)
(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
(NoiLC ssdt knoi)
)
(princ)
)

  • 1

#2026 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 23 May 2009 - 10:59 AM

Không biết có Bác nào làm bên ngành địa chính không vậy? Nếu có thì mong các Bác hồi âm. Thack các Bác nhiều. :mellow:
  • 0

#2027 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 23 May 2009 - 11:11 AM

Không biết có Bác nào làm bên ngành địa chính không vậy? Nếu có thì mong các Bác hồi âm. Thack các Bác nhiều. :mellow:

Mong bạn thông cảm. Nhưng mình khuyên bạn nên post bài đúng chủ đề. Topic này là "Viết Lisp theo yêu cầu". Nếu bạn cứ post bài không đúng chủ đề thì không những bài viết của bạn sẽ không nhận được câu trả lời mà bài viết của bạn có thể bị xóa. Mình góp ý thẳng thắn với bạn. Mong bạn đừng giận và hãy thông cảm nhé. Hãy post bài đúng chủ đề
Chúc vui.
  • 0

#2028 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 23 May 2009 - 11:22 AM

Chào cả nhà!
mình có cái lisp tính diện tích nhưng có hai điểm bất tiện như sau:
1. Phải klick vào vùng diện tích nào nằm trong vùng thấy của màn hình thì mới thực hiện được nếu không thì báo lỗi (giống như lệnh hatch trong cad 2004). cái này sữa đưọc càng tốt không thì thôi.
2. Sau khi lỗi thì nó sẽ tự động tắt tấc cả các truy bắt điểm (Object snap) và nó tự động hatch vùng chọn trước đó nên mình phải xoá bỏ các hatch đó đi.
Ai biết giúp mình khắc phục lỗi này với. (cố gắng giữ lại mấy lệnh cũ giúp mình nghe, mình chưa học lisp nên mọi người làm hoàn thiện giúp mình nghe)
Cảm ơn nhiều!
Đoạn mã lệnh nè:
(defun DXF (code elist)
(cdr (assoc code elist))
);dxf

(defun c:AR(/ dtl dtcon pt1 pt2 ss et oslast vsize)
(if (= tl nil) (progn
(setq tl (getreal "\nDrawing scale : "))
; (setq ntl (/ 1000 tl))
; (setq tl2 (* ntl ntl))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 5))
(command "hatch" "SOLID" vsize "0" "l" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
; (setq dtl (/ (/ dtl tl2) 2))
; (setq dtl (/ dtl 2))
(print)
(prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
(print)
(setq pt2 (getpoint "\nPoint to write: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "2" "0" (rtos dtl 2 2))
);if
(princ)
);defun AR
;------------------------------------------------------------------------
(defun c:AR2(/ dtl dtcon pt1 pt2 ss et oslast vsize)
(if (= tl nil) (progn
(setq tl (getreal "\nDrawing scale : "))
; (setq ntl (/ 1000 tl))
; (setq tl2 (* ntl ntl))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 5))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
; (setq dtl (/ (/ dtl tl2) 2))
(setq dtl (/ dtl 2))
(print)
(prompt (strcat "\nHaft total area : " (rtos dtl 2 4)))
(print)
(setq pt2 (getpoint "\nPoint to write: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "2" "0" (rtos dtl 2 2))
);if
(princ)
);defun AR2
;-------------------------------------------------------------------------------
(defun C:vd()
(print)
(print)
(print)
(setq last (getvar "OSMODE"))
(command "setvar" "OSMODE" "33")
(command "setvar" "DIMZIN" 0 )

(if (= tl nil) (setq tl (getreal "Ty le ban ve : ")))

(setq PT1 (getpoint "Diem 1 : "))
; (setq PT2 (getpoint "Diem 2 : "))
; (setq dist1 (distance pt1 pt2))
; (setq ntl (/ 1000 tl))
; (setq dist (/ dist1 ntl))
(setq sum 0)

(while (/= pt1 nil)
(setq PT2 (getpoint "Diem 2 : "))
(print)
(setq dist1 (distance pt1 pt2))
(setq ntl (/ 1000 tl))
(setq dist (/ dist1 ntl))
(prompt (strcat "\n Chieu dai doan vua do la " (rtos dist 2 4)))
(print)
(setq sum (+ sum dist))
(setq PT1 (getpoint "Diem 1 : "))
);while

(prompt (strcat "\n Tong chieu dai la " (rtos sum 2 4)))
(print)
(command "setvar" "OSMODE" "64")
(setq pt3 (getpoint "Viet vao cho nao ? : "))
;(setq x (+ (car pt3) 2))
;(setq pt3 (list x (cadr pt3)))
(setq sum2 (/ sum 2))

(command "text" "S" "2" pt3 "0" (rtos sum2 2 2))

(command "setvar" "OSMODE" last)
(princ)
)

(prompt "\n Start with AR to calculate area by pick points method")
(prompt "\n Start with AR2 to calculate haft area by pick points method")
(prompt "\n Danh VD de tinh tong chieu dai ")
(prompt "\n This version is used for Nguyen Cong Hoan-Cienco 625 only - 25/05/2007")
(princ)
  • 0
Học học nữa học mãi.
Đúp học lại!

#2029 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 23 May 2009 - 12:24 PM

Chào cả nhà!
mình có cái lisp tính diện tích nhưng có hai điểm bất tiện như sau:
1. Phải klick vào vùng diện tích nào nằm trong vùng thấy của màn hình thì mới thực hiện được nếu không thì báo lỗi (giống như lệnh hatch trong cad 2004). cái này sữa đưọc càng tốt không thì thôi.
2. Sau khi lỗi thì nó sẽ tự động tắt tấc cả các truy bắt điểm (Object snap) và nó tự động hatch vùng chọn trước đó nên mình phải xoá bỏ các hatch đó đi.
Ai biết giúp mình khắc phục lỗi này với. (cố gắng giữ lại mấy lệnh cũ giúp mình nghe, mình chưa học lisp nên mọi người làm hoàn thiện giúp mình nghe)
Cảm ơn nhiều!

conghoan1003 không nên đưa cả 1 đoạn Lisp dài, như vậy sẽ chiếm nhiều diện tích trang, mà nên upload và đưa đương dẫn của file thôi
  • 0

#2030 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 23 May 2009 - 01:20 PM

Chào cả nhà!
mình có cái lisp tính diện tích nhưng có hai điểm bất tiện như sau:
1. Phải klick vào vùng diện tích nào nằm trong vùng thấy của màn hình thì mới thực hiện được nếu không thì báo lỗi (giống như lệnh hatch trong cad 2004). cái này sữa đưọc càng tốt không thì thôi.
2. Sau khi lỗi thì nó sẽ tự động tắt tấc cả các truy bắt điểm (Object snap) và nó tự động hatch vùng chọn trước đó nên mình phải xoá bỏ các hatch đó đi.
Ai biết giúp mình khắc phục lỗi này với. (cố gắng giữ lại mấy lệnh cũ giúp mình nghe, mình chưa học lisp nên mọi người làm hoàn thiện giúp mình nghe)
Cảm ơn nhiều!

Code trên của bạn còn có điểm bất tiện thứ 3 là không thể tính diện tích được hình có khoét n lỗ bên trong.
Code sau của Tue_NV khắc phục 2 điểm bất tiện của bạn và có thể tính diện tích cho cả hình khoét lỗ và áp dụng đúng luôn cho cả hình không khoét lỗ.
Đây bạn : http://www.cadviet.c...amp;#entry53407
Có gì chưa được bạn hãy post lên để Tue_NV sửa lại cho hợp ý của bạn nhé.
Chào bạn
  • 1

#2031 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 23 May 2009 - 01:57 PM

Chào cả nhà!
mình có cái lisp tính diện tích nhưng có hai điểm bất tiện như sau:
1. Phải klick vào vùng diện tích nào nằm trong vùng thấy của màn hình thì mới thực hiện được nếu không thì báo lỗi (giống như lệnh hatch trong cad 2004). cái này sữa đưọc càng tốt không thì thôi.
2. Sau khi lỗi thì nó sẽ tự động tắt tấc cả các truy bắt điểm (Object snap) và nó tự động hatch vùng chọn trước đó nên mình phải xoá bỏ các hatch đó đi.
Ai biết giúp mình khắc phục lỗi này với. (cố gắng giữ lại mấy lệnh cũ giúp mình nghe, mình chưa học lisp nên mọi người làm hoàn thiện giúp mình nghe)
Cảm ơn nhiều!


Code của bạn bị lỗi về vùng nhìn, do k biết cái boundary của bạn to nhỏ thế nào nên đành phải zoom toàn bộ bản vẽ lên.
Còn về osnap thì nếu ct chạy suông sẻ osnap vẫn trở về như lúc trước khi chạy ct.
Mình sửa ct của bạn như sau: (vẫn giữ nguyên lệnh của bạn, chỉ thêm mấy dòng zoom và mấy chỗ có osmode)


(defun DXF (code elist)
(cdr (assoc code elist))
);dxf

(defun c:AR (/ dtl dtcon pt1 pt2 ss et oslast vsize)

(if (= tl nil)
(setq tl (getreal "\nDrawing scale : "))
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "zoom" "e" )
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize (/ (getvar "VIEWSIZE") 5))
(command "hatch" "SOLID" vsize "0" "l" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
(print)
(print)
(command "zoom" "o" et "")
(setq pt1 (getpoint "\nPick internal point : "))
)
(setvar "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
(print)
(prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
(print)
(setq pt2 (getpoint "\nPoint to write: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "2" "0" (rtos dtl 2 2))
) ;if
(princ)
)
;defun AR
;------------------------------------------------------------------------
(defun c:AR2 (/ dtl dtcon pt1 pt2 ss et oslast vsize)
(if (= tl nil)
(setq tl (getreal "\nDrawing scale : "))
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "zoom" "e" )
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize (/ (getvar "VIEWSIZE") 5))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
(print)
(print)
(command "zoom" "o" et "")
(setq pt1 (getpoint "\nPick internal point : "))
)
(setvar "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
(setq dtl (/ dtl 2))
(print)
(prompt (strcat "\nHaft total area : " (rtos dtl 2 4)))
(print)
(setq pt2 (getpoint "\nPoint to write: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "2" "0" (rtos dtl 2 2))
) ;if
(princ)
)
;defun AR2
;-------------------------------------------------------------------------------
(defun C:vd ()
(print)
(print)
(print)
(setq olast (getvar "OSMODE"))
(setvar "OSMODE" 33)
(setvar "DIMZIN" 0)

(if (= tl nil)
(setq tl (getreal "Ty le ban ve : "))
)

(setq PT1 (getpoint "Diem 1 : "))
(setq sum 0)

(while (/= pt1 nil)
(setq PT2 (getpoint "Diem 2 : "))
(print)
(setq dist1 (distance pt1 pt2))
(setq ntl (/ 1000 tl))
(setq dist (/ dist1 ntl))
(prompt
(strcat "\n Chieu dai doan vua do la " (rtos dist 2 4))
)
(print)
(setq sum (+ sum dist))
(setq PT1 (getpoint "Diem 1 : "))
) ;while

(prompt (strcat "\n Tong chieu dai la " (rtos sum 2 4)))
(print)
(setvar "OSMODE" 64)
(setq pt3 (getpoint "Viet vao cho nao ? : "))
(setq sum2 (/ sum 2))

(command "text" pt3 2 0 (rtos sum2 2 2))

(setvar "OSMODE" olast)
(princ)
)

(prompt
"\n Start with AR to calculate area by pick points method"
)
(prompt
"\n Start with AR2 to calculate haft area by pick points method"
)
(prompt "\n Danh VD de tinh tong chieu dai ")
(prompt
"\n This version is used for Nguyen Cong Hoan-Cienco 625 only - 25/05/2007"
)
(princ)

  • 0

#2032 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 24 May 2009 - 08:41 AM

cảm ơn bạn nhiều, lisp này theo mình hiểu là với những đoạn cách nhau hoac chéo nhau có độ dài 10 thì nó mới đc phải kô bạn, liệu có thể cho việc chọn độ dài để nối được ấy vào 1 option của lisp đc kô bạn, cảm ơn bạn lần nữa


Thật ra là cách nhau 1 đoạn <=10. Tuy nhiên nếu bạn muốn thêm option thì mình sửa lại như sau:
Chỉ cần nhập 1 lần kc khi vào lệnh, nếu k muôn đổi thì enter.
(defun c:nn (/ tdt ssdt sodt index)
(defun ObjName (ssdt /) (cdr (assoc '0 (entget ssdt))) )
(defun MoPL (ssdt /) (= (cdr (assoc '70 (entget ssdt))) 0))
(defun NoiPL (ssdt /)
(if (MoPL ssdt)
(COMMAND ".PEDIT" "M" tdt "" "J" kc "")))
(defun NoiLC (ssdt /) (COMMAND ".PEDIT" "M" tdt "" "Y" "J" kc ""))

(setq kc (getreal (strcat "Chon khoang cach toi da de noi <" (rtos (getvar "USERR1")) ">:" )))
(if (not kc) (setq kc (getvar "USERR1")) (setvar "USERR1" kc))

(setq tdt (ssget))
(while tdt
(setq ssdt (ssname tdt 0))

(if (or (= (Objname ssdt) "LWPOLYLINE")
(= (Objname ssdt) "POLYLINE"))
(NoiPL ssdt))

(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
(NoiLC ssdt))
(setq tdt (ssget))
)
(princ)
)

  • 1

#2033 thiensoncadviet

thiensoncadviet

    Chưa sử dụng CAD

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

Đã gửi 24 May 2009 - 11:01 AM

Đoạn lisp trên của bạn chẳng có vấn đề gì cả.
Vấn đề nằm ở biến hệ thống DIMZIN của AutoCAD. Bạn gõ DIMZIN tại dòng lệnh, rồi đặt về giá trị 0 là được (Hiện nay chắc chắn nó đang là 4).


  • 0

#2034 thiensoncadviet

thiensoncadviet

    Chưa sử dụng CAD

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

Đã gửi 24 May 2009 - 11:24 AM

Tạo giúp em lisp này với
-Trong bản vẽ em thường quản lý dim bằng dimflac và dimfit do đó trong bản vẽ tuy chỉ có 1 loại dim nhưng có những tỷ lệ dimflac và discale khác nhau.
-Giả sử trong bản vẽ ta có dim thứ nhất có dimflac = 1, dimscale =1 . Dim thứ 2 có dimflac = 0.5, dimscale = 0.5
-Khi vẽ em dim thứ nhất đang hiện hành bây giờ em muốn chọn dim thứ 2 làm dim hiện hành để vẽ (Ai giúp em với và nhớ đắt tên lệnh là DHH nha) . Em xin cảm ơn trước.
  • 0

#2035 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 24 May 2009 - 11:49 AM

Hix, thank Bác đã nhắc nhở, lần sau em sẽ kô phát ngôn bừa bãi nữa! :s_big:
  • 0

#2036 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 25 May 2009 - 11:07 AM

Code của bạn bị lỗi về vùng nhìn, do k biết cái boundary của bạn to nhỏ thế nào nên đành phải zoom toàn bộ bản vẽ lên.
Còn về osnap thì nếu ct chạy suông sẻ osnap vẫn trở về như lúc trước khi chạy ct.
Mình sửa ct của bạn như sau: (vẫn giữ nguyên lệnh của bạn, chỉ thêm mấy dòng zoom và mấy chỗ có osmode)

Trước tiên mình cảm ơn bạn nhiều.
nhưng lisp bạn sửa nó không đúng ý mình lắm, bạn có thể sửa lại cho mình lần nữa nghe.
1, Bạn bỏ cái lệnh zoom khi bị lỗi đi, cứ để như cũ cung được.
2, Sau khi bị lỗi nó mất hết snap, bạn có thể thêm vào để sau khi lỗi nó vẫn giữ nguyên snap ban đầu được không.
Cảm ơn nhiều!
Chúc một tuần làm việc thật tốt!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2037 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 25 May 2009 - 12:46 PM

Trước tiên mình cảm ơn bạn nhiều.
nhưng lisp bạn sửa nó không đúng ý mình lắm, bạn có thể sửa lại cho mình lần nữa nghe.
1, Bạn bỏ cái lệnh zoom khi bị lỗi đi, cứ để như cũ cung được.
2, Sau khi bị lỗi nó mất hết snap, bạn có thể thêm vào để sau khi lỗi nó vẫn giữ nguyên snap ban đầu được không.
Cảm ơn nhiều!
Chúc một tuần làm việc thật tốt!


Mình dùng lại cái lisp ban đầu của bạn và thêm cái hàm bắt lỗi, bạn thử xài xem sao và cho ý kiến.

(defun DXF (code elist)
(cdr (assoc code elist))
) ;dxf

(defun c:AR (/ dtl dtcon pt1 pt2 ss et oslast vsize)
(defun trap(e) (setvar "OSMODE" oslast) (setq *error* temperr ))
(setq temperr *error*
*error* trap)

(if (= tl nil)
(progn
(setq tl (getreal "\nDrawing scale : "))
; (setq ntl (/ 1000 tl))
; (setq tl2 (* ntl ntl))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize (/ (getvar "VIEWSIZE") 5))
(command "hatch" "SOLID" vsize "0" "l" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
; (setq dtl (/ (/ dtl tl2) 2))
; (setq dtl (/ dtl 2))
(print)
(prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
(print)
(setq pt2 (getpoint "\nPoint to write: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "2" "0" (rtos dtl 2 2))
) ;if
(princ)
) ;defun AR
;------------------------------------------------------------------------
(defun c:AR2 (/ dtl dtcon pt1 pt2 ss et oslast vsize)
(defun trap(e) (setvar "OSMODE" oslast) (setq *error* temperr ))
(setq temperr *error*
*error* trap)
(if (= tl nil)
(progn
(setq tl (getreal "\nDrawing scale : "))
; (setq ntl (/ 1000 tl))
; (setq tl2 (* ntl ntl))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize (/ (getvar "VIEWSIZE") 5))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
; (setq dtl (/ (/ dtl tl2) 2))
(setq dtl (/ dtl 2))
(print)
(prompt (strcat "\nHaft total area : " (rtos dtl 2 4)))
(print)
(setq pt2 (getpoint "\nPoint to write: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "2" "0" (rtos dtl 2 2))
) ;if
(princ)
) ;defun AR2
;-------------------------------------------------------------------------------
(defun C:vd ()
(defun trap(e) (setvar "OSMODE" oslast) (setq *error* temperr ))
(setq temperr *error*
*error* trap)
(print)
(print)
(print)
(setq oslast (getvar "OSMODE"))
(command "setvar" "OSMODE" "33")
(command "setvar" "DIMZIN" 0)

(if (= tl nil)
(setq tl (getreal "Ty le ban ve : "))
)

(setq PT1 (getpoint "Diem 1 : "))
; (setq PT2 (getpoint "Diem 2 : "))
; (setq dist1 (distance pt1 pt2))
; (setq ntl (/ 1000 tl))
; (setq dist (/ dist1 ntl))
(setq sum 0)

(while (/= pt1 nil)
(setq PT2 (getpoint "Diem 2 : "))
(print)
(setq dist1 (distance pt1 pt2))
(setq ntl (/ 1000 tl))
(setq dist (/ dist1 ntl))
(prompt
(strcat "\n Chieu dai doan vua do la " (rtos dist 2 4))
)
(print)
(setq sum (+ sum dist))
(setq PT1 (getpoint "Diem 1 : "))
) ;while

(prompt (strcat "\n Tong chieu dai la " (rtos sum 2 4)))
(print)
(command "setvar" "OSMODE" "64")
(setq pt3 (getpoint "Viet vao cho nao ? : "))
;(setq x (+ (car pt3) 2))
;(setq pt3 (list x (cadr pt3)))
(setq sum2 (/ sum 2))

(command "text" "S" "2" pt3 "0" (rtos sum2 2 2))

(command "setvar" "OSMODE" oslast)
(princ)
)

(prompt
"\n Start with AR to calculate area by pick points method"
)
(prompt
"\n Start with AR2 to calculate haft area by pick points method"
)
(prompt "\n Danh VD de tinh tong chieu dai ")
(prompt
"\n This version is used for Nguyen Cong Hoan-Cienco 625 only - 25/05/2007"
)
(princ)

  • 0

#2038 NguyenIvan

NguyenIvan

    Chưa sử dụng CAD

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

Đã gửi 25 May 2009 - 02:02 PM

Chào các bác

Mình có một gói công việc có liên quan đến LISP. Tóm tắt như sau:
1. Tự động load file autocad và lược bỏ một số layer.
2. Sửa đổi kích cỡ Font chữ tùy theo nội dung của text.
....
Đây là một dự án rất thú vị, các bác nào có thể giúp tôi, chúng ta có thể hẹn ra uống cafe để nói chuyện cụ thể hơn.
Chào các bác.
  • 0

#2039 vinhqc

vinhqc

    biết pan

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

Đã gửi 25 May 2009 - 02:08 PM

Chào mọi người!
Nhờ các bác xem giúp sao đoạn lisp này của em khi nó hông chịu kết thúc cứ phải bấm Éc thi nó mới thoát. còn không thì nó cứ sửa Text sau cùng sau mổi lần bấm enter mà không chọn điểm.


(Defun C:ct ( )
(prompt "\nChon Text mau.")
(setq DTD (car (entsel)))
(setq DT (entget DTD))
(setq NDT (cdr (assoc 1 DT)))

(Prompt "\nChon cac doi tuong chep theo...")
(Setq CDT (Ssget))

(setq a (getpoint "\nChon diem lam chuan: "))
(setq xa (car a))
(setq ya (cadr a))

(while
(luuos)
(setvar "osmode" 0)

(setq b (getpoint "\nChon diem dat moi: "))
(setq xb (car :s_big:)
(setq yb (cadr :s_big:)
(command "copy" CDT "" (list xa ya) (list xb yb))
(command "copy" DTD "" (list xa ya) (list xb yb))
(setq DTDM (entlast))

(if (and (>= (ascii NDT) 48) (<= (ascii NDT) 57))
(setq NDT (itoa (+ (atoi NDT) 1)))
(setq NDT (chr (+ (ascii NDT) 1)))
)

(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)

(traos)
)

(Princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun luuos ()
(setq
DUY_OSMODE (getvar "OSMODE")
DUY_AUTOSNAP (getvar "AUTOSNAP")
DUY_LAYERHH (getvar "CLAYER")
DUY_THANGXEOHH (getvar "ORTHO")
DUY_filletrad (getvar "FILLETRAD")
DUY_TEXTSTYLE (getvar "TEXTSTYLE")
)
)
(defun traos ()
(if DUY_OSMODE
(setvar "OSMODE" DUY_OSMODE)
)
(if DUY_LAYERHH
(setvar "CLAYER" DUY_LAYERHH)
)
(if DUY_THANGXEOHH
(setvar "ORTHO" DUY_THANGXEOHH)
)
(if DUY_AUTOSNAP
(setvar "AUTOSNAP" DUY_AUTOSNAP)
)
(if DUY_filletrad
(setvar "FILLETRAD" DUY_filletrad)
)
(if DUY_TEXTSTYLE
(setvar "TEXTSTYLE" DUY_TEXTSTYLE)
)


)

Bạn chỉ cần chuyển dòng lệnh :
(setq b (getpoint "\nChon diem dat moi: "))
lên vị trí ngay sau (while
là được.
  • 0

#2040 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 25 May 2009 - 08:37 PM

Mình dùng lại cái lisp ban đầu của bạn và thêm cái hàm bắt lỗi, bạn thử xài xem sao và cho ý kiến.

Bạn xem lại giúp mình nhé, khi bị lỗi thì nó vận bị mất hết tấc cả snap ban đầu.
Cảm ơn nhiều!
  • 0
Học học nữa học mãi.
Đúp học lại!