Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Nguyen Hoanh

Viết Lisp theo yêu cầu

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

Chào các bạn !

Mình xin nhờ các bạn một chuơng trình sau:

Cho hai đường polyline song song cánh nhau một khoảng cho trước. (D=10)

Yêu cầu:

Vẽ một đường POLYLINE nằm giữa hai đường thẳng cho trước đó. Chiều dài của MIN của mỗi đọan của đuờng POLYLINE đó lớn hơn một giá trị cho trước (ví dụ là 70m).

Rất mong các bạn giúp đỡ.

File bản vẽ gửi kèm.

http://www.cadviet.com/upfiles/duongthang.zip

 

Ko thấy bạn trả lời nên mình làm "đại" cái lisp này, bạn dùng thử xem.


(defun laydinh(obj diem dai)
 (if (setq pt (vlax-curve-getPointAtDist obj (+ dai (vlax-curve-getDistAtPoint obj diem))))
       (vlax-curve-getPointAtParam obj
          (1+ (fix (vlax-curve-getParamAtPoint obj pt))))
   nil)
)

(defun c:dt()
 (vl-load-com)
 (setq ss (ssget '((0 . "*POLYLINE"))))
 (while (and ss (/= (sslength ss) 2))
   (alert "Chi duoc chon 2 pline")
   (setq ss (ssget '((0 . "*POLYLINE")))))
 (setq obj1 (vlax-ename->vla-object (ssname ss 0))
pt1 (vlax-curve-getStartPoint obj1)
obj2 (vlax-ename->vla-object (ssname ss 1))
pt21 (vlax-curve-getStartPoint obj2)
pt22 (vlax-curve-getEndPoint obj2))
 (if (< (distance pt1 pt21) (distance pt1 pt22))
   (setq pt2 pt21)
   (setq pt2 pt22))
 (vla-Copy obj1)
 (setq obj3 (vlax-ename->vla-object (setq ent (entlast))))	
 (vla-Move obj3 (vlax-3d-Point pt1)
         (vlax-3d-Point (setq pt3 (polar pt1 (angle pt1 pt2) (* 0.5 (distance pt1 pt2))))))

 (setq Ld1 (list pt3)
pt4 (laydinh obj3 pt3 70))
 (while pt4
   (setq Ld1 (append Ld1  (list pt4))
         pt4 (laydinh obj3 pt4 70))
 )  
 (setq Ld1 (append Ld1  (list (last Ld)))
Ld2 nil)
 (entdel ent)
 (foreach d Ld1 (setq Ld2 (append Ld2 (list (cons 10 d)  (cons 42 0)))))
 (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length Ld1)))
	 Ld2))
)

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ỉ cần nằm bên trong 2 biên thôi sao, k co qui định gì khác hả?

nếu 2 đg biên gấp khúc quá thì làm sao đủ 70?

Buổi chiều về nhà lên không kịp kiểm tra mạng. Mục tiêu của bài toán là kỉe một đường thảng cố gắng (tối ưu nhất) là nằm trong phạm vi hai đường polyline sơng song. Những vị trí bất khả kháng thì mình phải chấp nhận. Thực chất đây là bài toán kẻ đưòng đỏ của tuyến đường nâng cấp. Đường đỏ được kẻ ra phải đảm bảo về mặt cao độ sao cho không cao quá cũng không thấp quá so với đường thiên nhiên. Đường đỏ nằm tròng khoảng hai đường song song đó là tối ưu nhât.

Rất chân thành cảm ơn bạn đã giúp. Minhd sẽ test lại và có phản hồi ngay.

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
Buổi chiều về nhà lên không kịp kiểm tra mạng. Mục tiêu của bài toán là kỉe một đường thảng cố gắng (tối ưu nhất) là nằm trong phạm vi hai đường polyline sơng song. Những vị trí bất khả kháng thì mình phải chấp nhận. Thực chất đây là bài toán kẻ đưòng đỏ của tuyến đường nâng cấp. Đường đỏ được kẻ ra phải đảm bảo về mặt cao độ sao cho không cao quá cũng không thấp quá so với đường thiên nhiên. Đường đỏ nằm tròng khoảng hai đường song song đó là tối ưu nhât.

Rất chân thành cảm ơn bạn đã giúp. Minhd sẽ test lại và có phản hồi ngay.

 

Mình test thì chương trình báo lỗi sau:

Select objects: ; error: bad DXF group: (10)

Bạn xem lại giúp mình nhé.

Nếu được thì bạn chỉnh lại chương trình cho mình một chút:

- Từ một đường polyline vẽ một đường polyline có khoảng cách giữa các đỉnh lớn hơn một giá trị A (ví dụ trong bài là A=70m) , nằm phía trên (hay dưới) đường polyline đã cho và cách đường Polyline đã cho một khoảng nhỏ hơn D ( trong ví dụ là 10). Hai giá tri A và D cho phép nhập vào từ chương trình.

Nếu đường thẳng đã cho quá gấp khúc không đảm bảo được khoảng cách giữa hai đỉnh của polyline là A thì cho phép kẻ tại vị trí đó đường Polyline kẻ nẳm cách đường thẳng đã cho một khoảng lớn hơn D. Nhưng thống nhất là cách đương Polyline kẻ ra nằm ở một phía và không giao cắt với đường đã cho. Hết vị trí gấp khúc thì lại đường polyline kẻ lại phỉa đảm bảo đề bà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
Mình test thì chương trình báo lỗi sau:

Select objects: ; error: bad DXF group: (10)

Bạn xem lại giúp mình nhé.

Nếu được thì bạn chỉnh lại chương trình cho mình một chút:

- Từ một đường polyline vẽ một đường polyline có khoảng cách giữa các đỉnh lớn hơn một giá trị A (ví dụ trong bài là A=70m) , nằm phía trên (hay dưới) đường polyline đã cho và cách đường Polyline đã cho một khoảng nhỏ hơn D ( trong ví dụ là 10). Hai giá tri A và D cho phép nhập vào từ chương trình.

 

Bạn thử cái này, có điều là chỉ hỏi giá trị A thôi còn D thì nó đo khoảng cách giữa 2 pline rồi, ko cần hỏi nữa.

(defun laydinh(obj diem dai)
 (if (setq pt (vlax-curve-getPointAtDist obj (+ dai (vlax-curve-getDistAtPoint obj diem))))
       (vlax-curve-getPointAtParam obj
          (1+ (fix (vlax-curve-getParamAtPoint obj pt))))
   nil)
)

(defun c:dt()
 (vl-load-com)
 (setq kctt (getreal "\nKhoang cach toi thieu:")
ss (ssget '((0 . "*POLYLINE"))))
 (while (and ss (/= (sslength ss) 2))
   (alert "Chi duoc chon 2 pline")
   (setq ss (ssget '((0 . "*POLYLINE")))))
 (setq obj1 (vlax-ename->vla-object (ssname ss 0))
pt1 (vlax-curve-getStartPoint obj1)
obj2 (vlax-ename->vla-object (ssname ss 1))
pt21 (vlax-curve-getStartPoint obj2)
pt22 (vlax-curve-getEndPoint obj2))
 (if (< (distance pt1 pt21) (distance pt1 pt22))
   (setq pt2 pt21)
   (setq pt2 pt22))
 (vla-Copy obj1)
 (setq obj3 (vlax-ename->vla-object (setq ent (entlast))))	
 (vla-Move obj3 (vlax-3d-Point pt1)
         (vlax-3d-Point (setq pt3 (polar pt1 (angle pt1 pt2) (* 0.5 (distance pt1 pt2))))))

 (setq Ld1 (list pt3)
Ld2 nil
pt4 (laydinh obj3 pt3 kctt))
 (while pt4
   (setq Ld1 (append Ld1  (list pt4))
         pt4 (laydinh obj3 pt4 kctt))
 )
 (entdel ent)
 (foreach d Ld1 (setq Ld2 (append Ld2 (list (cons 10 d)  (cons 42 0)))))
 (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length Ld1)))
	 Ld2))
)

  • 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 bạn thai_nguyen

Chưa hiểu ý của bạn. Bạn nói hai biến thôi là tên lô và diện tích. có phải là bạn đang nói tới Attribute

Nếu bạn đang nói tới Attribute thì đấy không phải là biến bạn à.

Bạn có thể upload cái file mà bạn cần lên và nói rõ điều bạn muốn nhé.

Bạn nói rõ cách thức tính diện tích luôn nhé. (tính diện tích bằng cách pick điểm hay là tính diện tích bằng cách khác)

 

Dạ thế này ạ.

1. Em gõ lệnh

2. Chọn object - 1 polyline

3. Nhập tên lô

4. Chọn vòng tròn ký hiệu hay hình chữ nhật ký hiệu (em sẽ chọn 1 trong hai)

5. Chọn điểm chèn.

Và cuối cùng ra vòng tròn hoặc hình chữ nhật gồm tên lô và diện tích của object tại vị trí điểm chèn đã chọn.

 

Bước 3, 4,5 có thể thay đổi thứ tự. Không biết em giải thích như thế đã rõ chưa. Em thấy cũng giống lisp tính diện tích và chèn giá trị vào vòng tròn ký hiệu (gõ lệnh SA, DSA) trong phần Download của CadViet, chỉ khác là không có phần dân số thôi.

 

Em gửi hình ví dụ đính kèm. Trong hình là hai kiểu vòng tròn ký hiệu của tên lô lớn và diện tích, hình chữ nhật ký hiệu gồm tên lô nhỏ và diện tích. Em vẫn phải làm rất thủ công là đo từng diện tích rồi edit chữ và số.

 

Cảm ơn nhiều ạ!!!

vidu_1.jpg

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 thử cái này, có điều là chỉ hỏi giá trị A thôi còn D thì nó đo khoảng cách giữa 2 pline rồi, ko cần hỏi nữa.

Mình đã test Lisp chạy tốt rồi. Bạn bổ sung giúp mình thêm chút nữa nhé: Trong những vị trí hai đường song song có gấp khúc lớn tại những vị trí đó Bạn có thể giúp mình nối tiếp đường thẳng bằng đường cong tròn có bán kính lớn hơn Rmin (nhập vào khi chạy chương trình) sao cho đường cong và đường polyline luôn tạo ra luôn nằm trọn ở giữa hai đường song song đó và phải đảm bảo tổng chiều dài của của đường thẳng và cánh tang của đường cong lớn hơn giá trị A.

Thân !

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


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

Hiện nay mình đang dùng phần mền NOVA để thiết kế đường. Bạn nào trong diễn đàn đã dùng phần mềm đó xin cho mình hỏi có thể viết chương trình để áp thiết kế kết cấu áo đường bằng Lisp được không?. Mục đích của em là làm thế nào để nó không hiện ra cái hộp thoại áp thiết kế nữa mà hạy luôn.

Mong các bạn chỉ giúp cho !

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

Lisp này em đang cần, mong các Bác bỏ chút thời gian viết dùm em cái, em đang cần gấp. :s_dead:

Nhờ các Bác viết dùng em 1 lisp dùng để chạy kích thước và ghi text khoảng cách song song và nằm giữa với đường line hoặc pline được chọn. Lisp sẽ tạo layer kthuoc nếu bản vẽ chưa có layer kthuoc.

1: nhập tỷ lệ bản vẽ ( do em làm bên trắc địa nên tỷ lệ bản vẽ thường là 1/200 = tỷ lệ 5/2, 1/500 = tỷ lệ 1/1, 1/1000 = 5/10)

2: có vẽ mũi tên hay không(c/k)

3: chọn các đối tượng cần ghi kích thước.

Dưới đây là file mẫu em thể hiện ở 2 tỷ lệ 1/500 và 1/200

http://www.cadviet.com/upfiles/mau_7.dwg

Thank các Bác nhiều. :s_dead:

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
Lisp này em đang cần, mong các Bác bỏ chút thời gian viết dùm em cái, em đang cần gấp. :s_dead:

Nhờ các Bác viết dùng em 1 lisp dùng để chạy kích thước và ghi text khoảng cách song song và nằm giữa với đường line hoặc pline được chọn. Lisp sẽ tạo layer kthuoc nếu bản vẽ chưa có layer kthuoc.

1: nhập tỷ lệ bản vẽ ( do em làm bên trắc địa nên tỷ lệ bản vẽ thường là 1/200 = tỷ lệ 5/2, 1/500 = tỷ lệ 1/1, 1/1000 = 5/10)

2: có vẽ mũi tên hay không(c/k)

3: chọn các đối tượng cần ghi kích thước.

Dưới đây là file mẫu em thể hiện ở 2 tỷ lệ 1/500 và 1/200

http://www.cadviet.com/upfiles/mau_7.dwg

Thank các Bác nhiều. :s_dead:

 

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

Khi nó hỏi "Co ve mui ten khong? (C/K) :" nếu có vẽ thì enter, ko vẽ thì gõ k

Khi nó hỏi "Ty le <1/500>: 1/" nếu là 1/500 thì enter, khác thì gõ 200 hay 1000...

Sau đó chọn line, mình chưa làm với pline, bạn nên chuyển hết sang line thì hay hơn.

(defun c:kt()
 (vl-load-com)

 (if (not tl) (setq tl 500))
 (initget "C K")
 (setq ck (getkword "\nCo ve mui ten khong? (C/K)  :")
tl1 (getint (strcat "\nTy le <1/" (itoa tl) ">: 1/"))
ss (ssget '((0 . "LINE"))))  
 (if (not ck) (setq ck "C"))
 (if tl1 (setq tl tl1))

 (setq	tln (/ tl 500.)
caoc 0.85
       os (getvar "OSMODE"))
 (setvar "OSMODE" 0)

 (command "-layer" "n" "Kthuoc" "c" 4 "Kthuoc" "l" "continuous" "Kthuoc" "lw" "default" "Kthuoc" "")
 (setvar "clayer" "Kthuoc")

 (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (setq obj  (vlax-ename->vla-object ent)
  ndai (/ (setq dai (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))) 2)
  p1   (vlax-curve-getStartPoint obj)
  p2   (vlax-curve-getEndPoint obj)	  
  ang  (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
  p1   (polar p1 (+ ang (* 0.5 pi)) 0.5)
  p2   (polar p2 (+ ang (* 0.5 pi)) 0.5)
  pm   (polar (vlax-curve-getPointAtDist obj ndai) (+ ang (* 0.5 pi)) 0.3)
   )
   (command "text" "j" "BC" pm caoc (* 180 (/ ang pi)) (rtos (* tln dai) 2 2))
   (if (= ck "C")
     (progn (muiten p1 (angle p1 p2))
   	     (muiten p2 (angle p2 p1)))
   )
 )
 (setvar "OSMODE" os)
)

(defun muiten(pt an)
  (entmakex (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity")  (8 . "Kthuoc") (100 . "AcDbPolyline") (90 . 3)) 
		(list (cons 10 pt)  '(41 . 0.33) '(42 . 0.0)
	      (cons 10 (polar pt an 0.9))  '(41 . 0.0) '(42 . 0.0)
	      (cons 10 (polar pt an 1.8)))))
)

  • 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

Thank Bác q288 nhiều, em text liền, Bác cho em hỏi 1 chút là tại sao lisp này chỉ chạy được với line, còn với pline thì sao nó chạy không được vậy Bác q288?

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ác q288 ơi khi chạy lisp kt của bác thì nó báo là:

Command: kt

Co ve mui ten khong? (C/K) : ; error: bad argument type: fixnump: 500.0

Command:

Command: KT

Co ve mui ten khong? (C/K) :k ; error: bad argument type: fixnump: 500.0

Không biết do cad em bị lỗi hay cho lisp bị lỗi. Em nhờ Bác coi lại dùm em chút.

Còn cái file acad.lsp thì em dùng chương trình của Bác Hoành thì đã giải quyết được rồi.Thank Bác 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ác q288 ơi khi chạy lisp kt của bác thì nó báo là:

Command: kt

Co ve mui ten khong? (C/K) : ; error: bad argument type: fixnump: 500.0

Command:

Command: KT

Co ve mui ten khong? (C/K) :k ; error: bad argument type: fixnump: 500.0

Không biết do cad em bị lỗi hay cho lisp bị lỗi. Em nhờ Bác coi lại dùm em chút.

Còn cái file acad.lsp thì em dùng chương trình của Bác Hoành thì đã giải quyết được rồi.Thank Bác nhiều.

 

Máy mình ko bị lỗi đó, đó là do có sự lẫn lộn số thực số nguyên, mình sửa lại thành số thực hết.

Còn vụ pline thì do bạn nói cần gấp thì mình viết gấp, vả lại đa số trong bản vẽ của bạn là line,

dĩ nhiên nếu gồm cả pline thì ct sẽ dài hơn.

Bây giờ thì có đủ line và pline, bạn chạy thử xem.

(defun muiten(pt an)
  (entmakex (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity")  (8 . "Kthuoc") (100 . "AcDbPolyline") (90 . 3)) 
		(list (cons 10 pt)  '(41 . 0.33) '(42 . 0.0)
	      (cons 10 (polar pt an 0.9))  '(41 . 0.0) '(42 . 0.0)
	      (cons 10 (polar pt an 1.8)))))
)

(defun laydinh(plObj / n L)
(setq 	n -1
L nil)
(repeat (fix (1+ (vlax-curve-getEndParam plObj)))
 (setq L (append L (list (vlax-curve-getPointAtParam plObj (setq n (1+ n)))))))
L
)

(defun ghikt(obj k / Ldinh n p1 p2 ndai ang pm dai)
 (if (= k 1)
   (progn 
     (setq  Ldinh (laydinh obj)
     n 0)
     (repeat (1- (length Ldinh))      
       (setq   p1 (nth n Ldinh)
  	p2 (nth (setq n (1+ n)) Ldinh)
         	ndai (/ (setq dai (distance p1 p2)) 2)	  
  	ang  (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
  	p1   (polar p1 (+ ang (* 0.5 pi)) 0.5)
  	p2   (polar p2 (+ ang (* 0.5 pi)) 0.5)
  	pm   (polar p1 (angle p1 p2)  ndai)
   	)
       (ghichu))
    )
    (progn 
      (setq    p1 (vlax-curve-getStartPoint obj)
  	p2 (vlax-curve-getEndPoint obj)
         	ndai (/ (setq dai (distance p1 p2)) 2)	  
  	ang  (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
  	p1   (polar p1 (+ ang (* 0.5 pi)) 0.5)
  	p2   (polar p2 (+ ang (* 0.5 pi)) 0.5)
  	pm   (polar p1 (angle p1 p2)  ndai)
   	)
      (ghichu)
    ))
)

(defun ghichu()
 (entmakex (list '(0 . "TEXT") (cons 11 pm) (cons 10 pm) (cons 40 caoc) (cons 50 ang)
	    '(7 . "style1") '(72 . 1) '(73 . 1) (cons 1 (rtos (* tln dai) 2 2))))
   (if (= ck "C")
     (progn (muiten p1 (angle p1 p2))
   	     (muiten p2 (angle p2 p1)))
   )
)

(defun c:kt()
 (vl-load-com)

 (if (not tl) (setq tl 500))
 (initget "C K")
 (setq ck (getkword "\nCo ve mui ten khong? (C/K):")
tl1 (getreal (strcat "\nTy le <1/" (rtos tl 2 0) ">: 1/"))
ss (ssget '((0 . "LINE,*POLYLINE"))))

 (if (not ck) (setq ck "C"))
 (if tl1 (setq tl tl1))  
 (setq	tln (/ tl 500)
caoc 0.85 )  

 (command "-layer" "n" "Kthuoc" "c" 4 "Kthuoc" "l" "continuous" "Kthuoc" "lw" "default" "Kthuoc" "")
 (setvar "clayer" "Kthuoc")

 (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (setq obj  (vlax-ename->vla-object ent))
   (if (= (cdr (assoc 0 (entget ent))) "LINE")
     (ghikt obj 0)
     (ghikt obj 1))	  
 )
 (princ)
)

  • Vote tăng 2

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Mình đã test Lisp chạy tốt rồi. Bạn bổ sung giúp mình thêm chút nữa nhé: Trong những vị trí hai đường song song có gấp khúc lớn tại những vị trí đó Bạn có thể giúp mình nối tiếp đường thẳng bằng đường cong tròn có bán kính lớn hơn Rmin (nhập vào khi chạy chương trình) sao cho đường cong và đường polyline luôn tạo ra luôn nằm trọn ở giữa hai đường song song đó và phải đảm bảo tổng chiều dài của của đường thẳng và cánh tang của đường cong lớn hơn giá trị A.

Thân !

 

Vì bạn bổ sung thêm yêu cầu mà yêu cầu này hơi khó nên mình cần thời gian, bạn chịu khó chờ nhé.

  • Vote tăng 2

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Vì bạn bổ sung thêm yêu cầu mà yêu cầu này hơi khó nên mình cần thời gian, bạn chịu khó chờ nhé.

MÌnh cảm ơn nhiều nhé! Thân!

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


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

Cái này mình cũng đã thử rồi nhưng vẫn không có tác dụng gì. Mình đang dùng cad 2007 liệu có ảnh hưởng gì không Tuê_NV. Hình như Tuê_NV dùng lệnh trim để nối nó lại với nhau à? Tuệ_NV có thể chuyển sang dùng lệnh fillet (với R=0) được không? phải thử giải pháp này thế nào chứ Tuê_NV "bó tay" thì mình cũng "bó chân" luôn. Thấy cái này hay thế mà chưa sử dụng được thấy tiết quá. Tuệ cố gắng giúp mình lần nữa nhé. Thank a lot!

Có ai test thử lisp vet bùn không vậy? sao Tuê_NV test duợc mầ mình không làm được, bác nào test xong cho ý kiến nhé,và biết cái lỗi mà mình gặp chỉ giúp mình với. Thank!

Tue_NV ơi! chẳng lẽ bó tay thật sao!

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 nhờ các bạn trên diễn đàn viết hộ cho một Lisp, chả là cũng lục đục viết mà kém quá nên chịu.

Mình thường "ngồi" in các bản vẽ của người khác, khi in thì phải chọn nét in: chọn theo màu hoặc độ dày đối tượng. Nhưng kẹt nỗi nhiều bản vẽ bố trí layer lộn xộn, màu hỗn loạn, in xong một bản vẽ cho có hồn muốn lòi con mắt.

Mình nhờ các bạn viết 1 lisp chọn cả bản vẽ, nó sẽ tự lọc màu và đưa vào layer tương ứng, ví dụ như màu đỏ cho vào layer "Color1", vàng vào layer "color2"........., những màu có chỉ số >=10 thì cho vào một layer riêng. Các nét đứt, nét tâm cũng vậy cho vào layer riêng. Còn các ngoại lệ thì mình cố gắng căng mắt vậy (ẩn layer để chỉnh) sợ yêu cầu nhiều mất thời gian của các anh chị em. Mình cảm ơn trước. Đang rất cần cái này........trước mắt là một khối bản vẽ phải in của các "tác gia" không chuyên....Thanks

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


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

Chào các bác, em đang cần lish làm tròn Dim, sao cho khi đo luôn được bội của 0 va 5. ví dụ giá trị thực là 411 nhưng khi đo thì được 410, giá trị thực là 444 khi do dim được giá trị 445. Em tim từ sáng tới h không có kết quả. Các bác giúp em nhé!!! thank :s_dead: :s_dead: :s_dead:

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 thử đọc bài này xem:

 

Lisp làm tròn số ( là Text) trong CAD ???????

http://www.cadviet.com/forum/index.php?showtopic=8183

mình đọc rùi!!! nhưng đề bài ra là khác nhau mà!!! mình muốn làm tròn dim, không phải text!!! :s_dead:

Mình đang gặp phải trường hợp có bản vẽ các giá trị cứ bị lẻ: ví dụ: 4501, 18003, 9001.... lí do là khi đo để chế độ bắt điểm không tốt, nếu sửa lại bằng tay thì nông dân quá!!! Cũng có trường hợp khi scale đối tượng, các giá trị cũng bị lẽ như thế này. nên mình mới muốn hỏi mọi người có cách nào để giá trị dim khi đo luôn là bội số của 0 và 5 không?

Các cao thủ lish giúp cái nào!!! :s_dead: :s_dead: :s_dead:

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


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

Nhờ Bác Q288 coi lại dùm em 1 chút về lisp KT. Khi chạy lisp kt trên máy em thì xảy ra trường hợp như sau:

- Trên máy em thì có lisp này dùng để thể hiện tỷ lệ bản vẽ, và hệ số làm tròn. Khi em chạy lisp nà trước thì lisp KT của Bác nó không chạy được nữa. Nhờ Bác ngâm cứu dùm em coi vì sao nó không chạy được. Dưới đây là lisp trong máy em:

- Và em có 1 bản vẽ khi chạy lisp Kt của Bác thì nó không ra như file mẫu em đã úp lên mà nó ra rất kỳ, nhờ Bác coi hộ dùm em vì sao nó bị như vậy. Cá mơn Bác nhiều.

http://www.cadviet.com/upfiles/mau_3_1.dwg

(setq TL (getvar "userr1"))
(if (<= (getvar "userr1") 0.0) (setvar "userr1" 500.0))
(setq lt ".")
(if (= 0 (getvar "useri1")) (setq lt " ")
   (setq lt (repeat (getvar "useri1") (setq lt (strcat lt "0")))))
(setvar "modemacro" 
 (strcat
  "TTKD-BD "
  "Ty le ban ve :  1/$(getvar,userr1)  . "
  "He so lam tron :  $(getvar,useri1)  . "
  "Font:  $(getvar,textstyle)   . "
 )
)
(princ)
;-----------------------------------------------------------
;Xac dinh ty le ban ve
;Tra ve he so ty le
(defun tyle (/ TL)
 (setq TL (getvar "USERR1"))
 (if (> TL 0.0)
   (progn
     (prompt "Ty le ban ve dang la:1/ ") (princ TL)
     (initget 6)
     (setq TL (getreal (strcat "\nNhap ty le ban ve  :   ")))
     )
   (progn
     (prompt "Ban ve chua dinh ty le.")
     (initget 7) (setq TL (getreal "\nNhap ty le ban ve:   "))
     )
   )
 (setvar "USERR1" TL)
 (load "statusbar.fas")
 TL)
;Kiem tra ty le ban ve
;tra ve he so ty le
(defun tle (/ TL) (if (<= (getvar "userr1") 0.0) (tyle) (setq TL (getvar "userr1"))))
;Xac dinh he so lam tron
(defun c:lamtron (/ Ltron)
(setq Ltron (getvar "useri1"))
(prompt "He so lam tron dang dung la : ")
(princ Ltron)
(initget 1) (setq Ltron (getint "\nNhap he so lam tron : "))
(setvar "USERI1" Ltron)
(load "statusbar.fas")
(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 đọc rùi!!! nhưng đề bài ra là khác nhau mà!!! mình muốn làm tròn dim, không phải text!!! :s_dead:

Mình đang gặp phải trường hợp có bản vẽ các giá trị cứ bị lẻ: ví dụ: 4501, 18003, 9001.... lí do là khi đo để chế độ bắt điểm không tốt, nếu sửa lại bằng tay thì nông dân quá!!! Cũng có trường hợp khi scale đối tượng, các giá trị cũng bị lẽ như thế này. nên mình mới muốn hỏi mọi người có cách nào để giá trị dim khi đo luôn là bội số của 0 và 5 không?

Các cao thủ lish giúp cái nào!!! :s_dead: :s_dead: :s_dead:

Vậy là độ chế dim rồi.

Bạn thử cái Lisp này Tue_NV viết xem sao :

(defun c:Rdim()
(prompt "\n Moi ban chon cac dim can lam tron :")
(setq ss (ssget '((0 . "DIMENSION")))
i 0)
(while ((setq ent (entget(ssname ss i)))
(setq content (cdr(assoc 42 ent)))
(setq du (rem content 5))
(if (= du 0) (setq content content))
(if (and (> du 0) ((if (>= du 2.5) (setq content (rtos (+ content (- 5 du)) 2 0)))
(setq ent (entmod(subst(cons 1 content) (assoc 1 ent) ent)))
(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
Xin nhờ các bạn trên diễn đàn viết hộ cho một Lisp, chả là cũng lục đục viết mà kém quá nên chịu.

Mình thường "ngồi" in các bản vẽ của người khác, khi in thì phải chọn nét in: chọn theo màu hoặc độ dày đối tượng. Nhưng kẹt nỗi nhiều bản vẽ bố trí layer lộn xộn, màu hỗn loạn, in xong một bản vẽ cho có hồn muốn lòi con mắt.

Mình nhờ các bạn viết 1 lisp chọn cả bản vẽ, nó sẽ tự lọc màu và đưa vào layer tương ứng, ví dụ như màu đỏ cho vào layer "Color1", vàng vào layer "color2"........., những màu có chỉ số >=10 thì cho vào một layer riêng. Các nét đứt, nét tâm cũng vậy cho vào layer riêng. Còn các ngoại lệ thì mình cố gắng căng mắt vậy (ẩn layer để chỉnh) sợ yêu cầu nhiều mất thời gian của các anh chị em. Mình cảm ơn trước. Đang rất cần cái này........trước mắt là một khối bản vẽ phải in của các "tác gia" không chuyên....Thanks

Bạn thử dùng Lisp này xem sao ?

chuyển các đối tuợng về Layer mới có tên LINETYLE+COLOR

  • Vote tăng 3

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


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

Em cần một lisp để phân trang in trên bản vẽ lớn.

Yêu cầu là để xác định phạm vi in theo tỷ lệ và khổ giấy và xuất sang trang in.

với thao tác sau:

1. Chọn khu vực in : góc trái trên và góc phải dưới.

2. Nhập tỷ lệ in

3. Khập khổ giấy : ngang và dài.

4. Đánh số trang đã phân theo chiều từ trái sang phải.

thể hiện lưới hình chử nhật của bản vẽ.

5. Xuất sang trang in, khi chọn từng khung của lưới hình chử nhật.

Rất mong được các anh giúp

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


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Nhờ Bác Q288 coi lại dùm em 1 chút về lisp KT. Khi chạy lisp kt trên máy em thì xảy ra trường hợp như sau:

- Trên máy em thì có lisp này dùng để thể hiện tỷ lệ bản vẽ, và hệ số làm tròn. Khi em chạy lisp nà trước thì lisp KT của Bác nó không chạy được nữa. Nhờ Bác ngâm cứu dùm em coi vì sao nó không chạy được. Dưới đây là lisp trong máy em:

- Và em có 1 bản vẽ khi chạy lisp Kt của Bác thì nó không ra như file mẫu em đã úp lên mà nó ra rất kỳ, nhờ Bác coi hộ dùm em vì sao nó bị như vậy. Cá mơn Bác nhiều.

 

Do trùng tên biến thôi, mình sửa lại tên biến của lệnh kt rồi (vì ko muốn sửa file lamtron của bạn).

Còn file kia sở dĩ ko ra đúng là do trong đó ko có kiểu chữ style1 như file mẫu trước, bây giờ mình cho nó lấy kiểu chữ hiện hành để khỏi nhầm.

Bạn chạy thử xem còn vấn đề gì nữa ko.

(defun muiten(pt an)
  (entmakex (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity")  (8 . "Kthuoc") (100 . "AcDbPolyline") (90 . 3)) 
		(list (cons 10 pt)  '(41 . 0.33) '(42 . 0.0)
	      (cons 10 (polar pt an 0.9))  '(41 . 0.0) '(42 . 0.0)
	      (cons 10 (polar pt an 1.8)))))
)

(defun laydinh(plObj / n L)
(setq 	n -1
L nil)
(repeat (fix (1+ (vlax-curve-getEndParam plObj)))
 (setq L (append L (list (vlax-curve-getPointAtParam plObj (setq n (1+ n)))))))
L
)

(defun ghikt(obj k / Ldinh n p1 p2 ndai ang pm dai)
 (if (= k 1)
   (progn 
     (setq  Ldinh (laydinh obj)
     n 0)
     (repeat (1- (length Ldinh))      
       (setq   p1 (nth n Ldinh)
  	p2 (nth (setq n (1+ n)) Ldinh)
         	ndai (/ (setq dai (distance p1 p2)) 2)	  
  	ang  (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
  	p1   (polar p1 (+ ang (* 0.5 pi)) 0.5)
  	p2   (polar p2 (+ ang (* 0.5 pi)) 0.5)
  	pm   (polar p1 (angle p1 p2)  ndai)
   	)
       (ghichu))
    )
    (progn 
      (setq    p1 (vlax-curve-getStartPoint obj)
  	p2 (vlax-curve-getEndPoint obj)
         	ndai (/ (setq dai (distance p1 p2)) 2)	  
  	ang  (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
  	p1   (polar p1 (+ ang (* 0.5 pi)) 0.5)
  	p2   (polar p2 (+ ang (* 0.5 pi)) 0.5)
  	pm   (polar p1 (angle p1 p2)  ndai)
   	)
      (ghichu)
    ))
)

(defun ghichu()
 (entmakex (list '(0 . "TEXT") (cons 11 pm) (cons 10 pm) (cons 40 caoc) (cons 50 ang)
	  '(72 . 1) '(73 . 1) (cons 1 (rtos (* scalen dai) 2 2))))
   (if (= ck "C")
     (progn (muiten p1 (angle p1 p2))
   	     (muiten p2 (angle p2 p1)))
   )
)

(defun c:kt(/ ck scale1 ss caoc scalen obj)
 (vl-load-com)

 (if (not scale) (setq scale 500))
 (initget "C K")
 (setq ck (getkword "\nCo ve mui ten khong? (C/K):")
scale1 (getreal (strcat "\nTy le <1/" (rtos scale 2 0) ">: 1/"))
ss (ssget '((0 . "LINE,*POLYLINE"))))

 (if (not ck) (setq ck "C"))
 (if scale1 (setq scale scale1))  
 (setq	scalen (/ scale 500)
caoc 0.85 )  

 (command "-layer" "n" "Kthuoc" "c" 4 "Kthuoc" "l" "continuous" "Kthuoc" "lw" "default" "Kthuoc" "")
 (setvar "clayer" "Kthuoc")

 (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (setq obj  (vlax-ename->vla-object ent))
   (if (= (cdr (assoc 0 (entget ent))) "LINE")
     (ghikt obj 0)
     (ghikt obj 1))	  
 )
 (princ)
)

  • Vote tăng 2

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


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

×