Chuyển đến nội dung
Diễn đàn CADViet
Nguyen Hoanh

Viết Lisp theo yêu cầu

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

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.

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

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

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ả 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.com/forum/index.php?sho...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

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

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

  • 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
Đ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).

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo 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.

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

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

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

 

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.

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

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Bạn 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!

 

Mình thử thấy tốt mà. Bạn trước khi vào lệnh ar,ar2 thì đánh lệnh osmode và cho nó bằng 1 số nào đó(. Sau đó đánh lệnh ar,ar2 của bạn. Giả vờ cho bị lỗi rồi nhấn esc. Thử lại lệnh osmode xem có đúng là nó vẫn là số cũ không.

lệnh vd thì do bạn đặt tên osmode khác nên mình có đổi lại tên biến. Bạn chép lại và chạy lai thử xem.

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

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
Mình thử thấy tốt mà. Bạn trước khi vào lệnh ar,ar2 thì đánh lệnh osmode và cho nó bằng 1 số nào đó(. Sau đó đánh lệnh ar,ar2 của bạn. Giả vờ cho bị lỗi rồi nhấn esc. Thử lại lệnh osmode xem có đúng là nó vẫn là số cũ không.

lệnh vd thì do bạn đặt tên osmode khác nên mình có đổi lại tên biến. Bạn chép lại và chạy lai thử xem.

Cảm ơn bạn đã nhiệt tình giúp đỡ nhưng sao mình vẫn không dùng được bạn ơi, sau khi bị lỗi nó vẫn tắc tấc cả snap ban đầu mình chọn, đánh lại osmode thì thấy giá trị là 0.

Bạn xem lại giúp mình nghe. Thank!

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
Lệnh là SD (sắp dim)

 

Chương trình sẽ yêu cầu người sử dụng chọn đường Dim chuẩn. Sau đó, yêu cầu người sử dụng chọn các đường Dim cần sắp xếp. Chương trình sẽ tự động dàn các Dim theo hàng đều.

sapdim.gif

(defun c:sd ()
 (defun ss2ent	(ss / sodt index lstent)
   (setq
     sodt  (cond
      (ss (sslength ss))
      (t 0)
    )
     index 0
   )
   (repeat sodt
     (setq ent	   (ssname ss index)
    index  (1+ index)
    lstent (cons ent lstent)
     )
   )
   (reverse lstent)
 )
 (defun hoanh_newerror	(msg)
   (if	(and (/= msg "Function cancelled")
     (/= msg "quit / exit abort")
)
     (princ (strcat "\n" msg))
   )
   (done)
 )
 ;;----------
 (defun init ()
   (setq
     HOANH_CMD	     (getvar "CMDECHO")
     HOANH_OLDERROR *error*
     *error*	     hoanh_newerror

   )
   (setvar "CMDECHO" 0)
   (command ".undo" "BE")
 )
 ;;----------
 (defun done ()
   (command ".redraw")
   (command ".undo" "E")
   (if	HOANH_CMD
     (setvar "CMDECHO" HOANH_CMD)
   )
   (if	HOANH_OLDERROR
     (setq *error* HOANH_OLDERROR)
   )
   (princ)
 )
 ;;----------

 (defun cdim (entdt	pchan	 pduong	  /	   tt	    old10
       old13	old14	 new10	  new13	   new14    p10n
       p13n	p14n	 p10o	  p13o	   p14o	    gocduong
       gocchan	pchanb	 pduongb  loaidim
      )
   (defun chanvuonggoc	(ph p1 p2 / ptemp pkq goc)
     (setq
goc   (+ (angle p1 p2) (/ pi 2.0))
ptemp (polar ph goc 1000.0)
pkq   (inters ph ptemp p1 p2 nil)
     )
     pkq
   )
   (setq
     tt       (entget entdt)
     old10    (assoc '10 tt)
     old13    (assoc '13 tt)
     old14    (assoc '14 tt)
     p10o     (cdr old10)
     p13o     (cdr old13)
     p14o     (cdr old14)
     loaidim  (logand (cdr (assoc '70 tt)) 7)
     gocduong (cond
	 ((= loaidim 1) (angle p13o p14o))
	 ((= loaidim 0) (cdr (assoc '50 tt)))
	 (t nil)
       )
     pchan    (cond
	 (pchan (list (car pchan) (cadr pchan) 0.0))
	 (t pchan)
       )
     pduong   (cond
	 (pduong (list (car pduong) (cadr pduong) 0.0))
	 (t pduong)
       )

   )
   (if	gocduong
     (progn
(if pchan
  (setq
    pchanb (polar pchan gocduong 1000.0)
    p13n   (chanvuonggoc
	     (list (car p13o) (cadr p13o) 0.0)
	     pchan
	     pchanb
	   )
    p14n   (chanvuonggoc
	     (list (car p14o) (cadr p14o) 0.0)
	     pchan
	     pchanb
	   )
    new13  (cons 13 p13n)
    new14  (cons 14 p14n)
    tt	   (subst new13 old13 tt)
    tt	   (subst new14 old14 tt)
  )
)
(if pduong
  (setq
    pduongb (polar pduong gocduong 1000.0)
    p10n    (chanvuonggoc
	      (list (car p10o) (cadr p10o) 0.0)
	      pduong
	      pduongb
	    )
    new10   (cons 10 p10n)
    tt	    (subst new10 old10 tt)
  )
)
(entmod tt)
     )
   )
   gocduong
 )

 (defun textdimheight (ent / tmp)
   (command ".copy" ent "" (list 0.0 0.0 0.0) "@")
   (command ".explode" (entlast) "")
   (setq tmp (cdr (assoc 40 (entget (entlast)))))
   (command ".erase" "p" "")
   tmp
 )
 (defun phia (p1 p2 p3 / x1 y1 z1 x2 y2 z2 x3 y3 z3)
   (setq
     x1  (car p1)
     y1  (cadr p1)
     z1  (caddr p1)
     x2  (car p2)
     y2  (cadr p2)
     z2  (caddr p2)
     x3  (car p3)
     y3  (cadr p3)
     z3  (caddr p3)
     tmp (+ (* (- x1 x2) x3)
     (* (- y1 y2) y3)
     (* (- z1 z2) z3)
  )
   )
   (cond
     ((= tmp 0.0) 0.0)
     (t (/ tmp (abs tmp)))
   )
 )
 (defun khoangcachdim (p1 ent goc / tt p2 A B D)
   (setq tt (entget ent)
  p2 (cdr (assoc 10 tt))
  B  (cdr (assoc 50 tt))
  A  (angle p1 p2)
  D  (distance p1 p2)
   )
   (* (* D (sin (- A [b]B )[/b])) (phia p1 (polar p1 goc 1.0) p2))
 )

 (defun phanloai (ent)
   (setq
     kc   (khoangcachdim pgoc ent goc)
     loai (fix (/ kc heightdimgoc 0.93))
   )
   (cons loai ent)
 )

 (init)
 (princ "\nSap xep dim © CADViet.com")
 (while (not (setq entgoc (car (entsel "\nChon duong dim goc: "))))
 )
 (setq
   ttgoc	 (entget entgoc)
   p13goc	 (cdr (assoc 13 ttgoc))
   pgoc	 (cdr (assoc 10 ttgoc))
   goc		 (cdr (assoc 50 ttgoc))
   heightdimgoc (textdimheight entgoc)
   ssd		 (ssget	(list
		  (cons 0 "DIMENSION")
		  (cons -4 "			  (cons 70 32)
		  (cons 70 64)
		  (cons 70 96)
		  (cons 70 128)
		  (cons 70 160)
		  (cons 70 196)
		  (cons 70 224)
		  (cons -4 "OR>")
		  (cons -4 "			  (cons 50 goc)
		  (cons 50 (+ goc pi))
		  (cons 50 (- goc pi))
		  (cons -4 "OR>")
		)
	 )
   lstd	 (ss2ent ssd)
   lstd	 (mapcar 'phanloai lstd)
   lstlevel	 nil
 )
 (foreach pp lstd
   (if	(not (member (car pp) lstlevel))
     (setq lstlevel (append lstlevel (list (car pp))))
   )
 )
 (setq	lstlevel    (vl-sort lstlevel '(lambda (x1 x2) (< x1 x2)))
lstam	    nil
lstduong    nil
lstamtmp    nil
lstduongtmp nil
 )
 (foreach pp lstlevel
   (if	(< pp 0.0)
     (setq lstam (append lstam (list pp)))
   )
   (if	(> pp 0.0)
     (setq lstduong (append lstduong (list pp)))
   )
 )
 (setq index 0)
 (foreach pp (reverse lstam)
   (setq
     index    (1+ index)
     lstamtmp (append lstamtmp (list (cons pp index)))
   )
 )
 (setq
   lstam lstamtmp
   index 0
 )
 (foreach pp lstduong
   (setq
     index	  (1+ index)
     lstduongtmp (append lstduongtmp (list (cons pp index)))
   )
 )
 (setq lstduong lstduongtmp)
 (setq lstlevel (append lstduong lstam (list (cons 0.0 0))))

 (setq kcdimstandard (* 3.0 heightdimgoc))
 (foreach pp lstd
   (setq plht (car pp))
   (progn
     (setq
kcdimht	   (khoangcachdim pgoc (cdr pp) goc)
duongthu   (cdr (assoc plht lstlevel))
heso	   (cond
	     ((/= 0 kcdimht)
	      (abs (* (/ kcdimstandard kcdimht) duongthu))
	     )
	     (t 0.0)
	   )
diemchenht (cdr (assoc 10 (entget (cdr pp))))
pmoi	   (polar pgoc
		  (angle pgoc diemchenht)
		  (* heso (distance pgoc diemchenht))
	   )
     )

     (cdim (cdr pp) p13goc pmoi)
   )
 )
 (done)
)
(princ "\nSap xep dim, SD - free lisp from www.cadviet.com")
(princ)

Anh Hoành xem lại giúp cái lisp này với, sao mình load xong nhung đánh lệnh sd cad vẫn không hiểu.

Thank!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Anh Hoành xem lại giúp cái lisp này với, sao mình load xong nhung đánh lệnh sd cad vẫn không hiểu.

Thank!

Lỗi do bạn đọc bài viết chưa đến nơi đến chốn mà thôi.

Lisp của bác Hoành đây bạn : http://www.cadviet.com/upfiles/sapxepdim_2.lsp

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

Xin lisp có nội dung như sau:

- Công việc giống lệnh offset trong cad nhưng mình có thể chọn nhiều đối tượng cùng một lúc.

- Sau khi offset thanh công thì các đường mới vừa được offset cùng thuộc layer hiện hành (layer current)

Các bạn giúp mình nhé!

Thank!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Thậ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)
)

 

 

thanks bạn q288 nhưng mà vẫn kô đc bạn ah, nó kô nối được những đoạn cách nhau và những đoạn chéo nhau như lisp trước bạn ạ, nó chỉ nối được những đoạn liền nhau thôi, mong bạn sửa lại dùm mình nhé, cảm ơn bạn lần nữa.

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
thanks bạn q288 nhưng mà vẫn kô đc bạn ah, nó kô nối được những đoạn cách nhau và những đoạn chéo nhau như lisp trước bạn ạ, nó chỉ nối được những đoạn liền nhau thôi, mong bạn sửa lại dùm mình nhé, cảm ơn bạn lần nữa.

 

Bạn nhập kc tối đa là bao nhiêu mà k nối đc? nếu cho = 10 thì mấy cái pline của bạn nối đc hết 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
Xin lisp có nội dung như sau:

- Công việc giống lệnh offset trong cad nhưng mình có thể chọn nhiều đối tượng cùng một lúc.

- Sau khi offset thanh công thì các đường mới vừa được offset cùng thuộc layer hiện hành (layer current)

Các bạn giúp mình nhé!

Thank!

Bạn sử dụng đoạn Code này xem :

(defun c:ofs()
(prompt "Ban chon doi tuong offset :")
(setq ss (ssget) n (sslength ss) i 0)
(setq po (getpoint "\n Pick diem phia offset :"))
(setq kc (getdist "\n Khoang cach offset :"))
(while ((setq curve (ssname ss i))
(command "offset" kc curve po "")
(setq LA (entlast))
(Command "point" po)
(command "MATCHPROP" (entlast) LA "")
(entdel (entlast))
(setq i (1+ i))
)
(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
Cảm ơn bạn đã nhiệt tình giúp đỡ nhưng sao mình vẫn không dùng được bạn ơi, sau khi bị lỗi nó vẫn tắc tấc cả snap ban đầu mình chọn, đánh lại osmode thì thấy giá trị là 0.

Bạn xem lại giúp mình nghe. Thank!

 

Lần này k xong thì mình cũng pótay.com luôn.

 

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

(defun trap(e) (setvar "OSMODE" oslast))  

(defun c:AR (/ dtl dtcon pt1 pt2 ss et vsize)
 (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 vsize)
 (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 ()
 (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)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Bạn nhập kc tối đa là bao nhiêu mà k nối đc? nếu cho = 10 thì mấy cái pline của bạn nối đc hết mà

 

 

mình thử nhập khoảng cách là 100 này, 1000 này nhưng vẫn kô được, mình chọn khoảng cách tối đa xong pick 2 đường PL xong rồi enter mà nó y chang như cũ, :s_big: liệu có phải do các đường của mình nó chéo nhau kô nhỉ

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×