LISP VẼ ĐƯỜNG ỐNG 3D trên AutoCAD

Tháng 10 28, 2014

(Mục đính em lập thêm chủ đề mới này để tiện tìm kiếm và tiện theo dõi vì lisp vẽ đường ống 3D cần phải có ít nhất là 05 cái lisp, để chung với chủ đề khác e không tiện)

Hiện nay có rất nhiều phầm mềm vẽ đường ống, ưu điểm chính của nó là nhanh, vì nó tích hợp nhiều file tư liệu như Bích, Van... và các phụ kiện đường ống theo đúng Cataloge của các hãng nổi tiếng trên thế giới.

Tuy nhiên, nó chỉ là trò chơi của con nhà giàu như như dân DẦU KHÍ, THỦY ĐIỆN & ĐÓNG TẦU, họ thường nhận được hợp đồng làm các công trình lớn, có vốn đầu tư của nước ngoài. Con nhà nghèo như dân CƠ KHÍ và CẤP THOÁT NƯỚC hiện tại chưa thể đánh đu với trò chơi đó được.

Phụ kiện đường ống đang trôi nổi trên thị trường rất đa dạng dạng về kích thước, kiểu dáng và chất lượng. Làm xong công trình nào, biết công trình đó thôi, có khi tạo được file thư viện xong, chẳng bao giờ dùng lại nữa.

Cái khó của người thiết kế là không được tự do thiết kế theo ý thích của mình. Chủ đầu tư hào phóng quăng ra một cục tiền to, rất dễ lựa chọn phụ kiện, tha hồ vẽ hươu vẽ vượn.

Chủ đầu tư kẹt xỉn chỉ chi tiền nhỏ giọt, hoặc chủ đầu tư chỉ có một cục tiền nhỏ mọn ( luôn tiềm ẩn nỗi lo sợ kinh hoàng về những món nợ dai dẳng và khó đòi) vẫn đang là CHUYỆN THƯỜNG Ở HUYỆN.

Việc lựa chọn phụ kiện hợp với túi tiền của chủ đầu tư cũng đang là hệ phương trình bậc cao không có ...ẩn số. (Không thể vẽ hươu vẽ vượn được mà chỉ ngậm ngùi vẽ được con giun... chết thôi :) :) :) )

Từ hoàn cảnh nghiệt ngã và đầy... ức chế đó, là người đã từng vẽ đường ống 3D trên AutoCAD, em đã nhờ viết lisp vẽ đường ống 3D theo tiêu chuẩn:

trong chủ đề:

http://www.cadviet.com/forum/topic/43060-hoi-lisp-thao-tac-trong-3d/page-6 và anh Hiệp đã làm được 2 cái lisp thể hiện trong các bài viết số #109 và #110 .

Mục tiêu của vẽ đường ống 3D là thống kê được chính xác số lượng ống và cút cho cả công trình. Cách của em vẫn làm trên AutoCAD là sau khi vẽ xong bản tổng, sẽ thông kê tổng khối lượng của các chủng loại ống và cút có đường kính khác nhau, và phụ kiện đính kèm bằng cách tắt tất cả các layer, chỉ để lại 1 layer để thống kê. Cách này tốn khá nhiều thời gian và công sức.

Rất mong được các bác Viết lisp theo yêu cầu trên diễn đàn, cùng các bác đã từng vẽ đường ống 3D trong chủ đề này- http://www.cadviet.com/forum/topic/109825-cach-ve-bo-tri-mat-bang-duong-ong-trong-autocad/page-2 - vào đây thử lisp của anh Hiệp và cho ý kiến góp ý, em xin trân trọng cảm ơn!

P/s: Lisp của anh Hiệp tuy chưa hoàn chỉnh theo ý của em, nhưng bước đầu đã đủ để khẳng định việc viết lisp vẽ đường ống 3D trên AutoCAD là khả thi.....

Tháng 10 28, 2014

Dự định của Haanh là delete chủ đề gì đó của dân cơ khí và dân cấp thoát nước bên kia à?

Tháng 10 28, 2014

@Bác Doan Van Ha:

Không phải phải là em có ý định xóa chủ đề : "Tổng hợp các lisp thường dùng cho dân khí...." (Em lập chủ đề ấy để dễ tìm kiếm).

1/- Lisp ghi dung sai kích thước: http://www.cadviet.com/forum/topic/67159-tran-trong-kinh-moi-viet-lisp-cho-dan-co-khi/page-23

2/- Lisp vẽ đường ống 3D: http://www.cadviet.c...trong-3d/page-6

3/- ................................................................................................................................................

4/- ...............................................................................................................

5/- ................................................................................

Xin mời các bác đã và đang ứng dụng lisp trong công việc làm của mình, hãy chia sẻ lisp của mình cho mọi người!

Em xin trân trọng cám ơn nhiều!

Tự dưng cái Hoằn không hiểu ý của em đã chen ngang lisp khai triển cánh vít vào vị trí số 3. Lisp khai triển cánh vít ít dùng em tạm dừng lại, mặc dù anh Hiệp đã viết xong phần đầu là lisp xác định đường kính trung bình tính toán Dtb và dtb.

Em muốn giải quyết dứt điểm Lisp vẽ đường ống 3D trước (cần thiết hơn), sau đó sẽ trở lại nhờ các bác viết lisp khai triển cánh vít sau, bác ạ!

Tháng 10 29, 2014

cái này dùng cho dân cơ khí, dân cấp thoát nước ngoài cút, còn có chếch, y, bít xả nửa, không biết lisp này có dùng được không nhỉ?

Tháng 10 29, 2014

Mặc dù không đúng chuyên ngành nhưng cũng có vài ý kiến với chủ thớt :

- dân cơ khí chỉ dùng cút (90 độ) thôi à ? các loại nối khác qui định thế nào : co lơi (135 độ), rẽ nhánh chữ T, nối thay đổi đ/kính ông (tăng giảm) ...

- với t/chuẩn Nhật-ĐL : qui định chiều cao b/kính cút thế nào?

Tháng 10 29, 2014

mình thấy nước ngoài họ viết thành menu luôn, cứ sổ xuống là nó cho mình lựa chọn : Co 90, Chếch 135, Tê đều, Tê giảm, Y đều, Y giảm, Giảm (Côn), Vẽ tim ống (Vẽ dạng đường Xline), Bít xả. Đối với phần cấp nước thì có : Co, Co ren trong, Co ren ngoài, Tê đều, Tê giảm, Giảm, Van......

Sau khi vẽ xong chọn menu tính khối lượng, quét chọn các đoạn ống, phụ kiện nào là nó tính khối lượng ra cho mình. Rất nhanh chóng và chính xác.

Không biết ý tưởng của mình vậy có bạn nào giúp viết ra được không ạ?

Tháng 10 30, 2014

Mặc dù không đúng chuyên ngành nhưng cũng có vài ý kiến với chủ thớt :

- dân cơ khí chỉ dùng cút (90 độ) thôi à ? các loại nối khác qui định thế nào : co lơi (135 độ), rẽ nhánh chữ T, nối thay đổi đ/kính ông (tăng giảm) ...

- với t/chuẩn Nhật-ĐL : qui định chiều cao b/kính cút thế nào?

Em rất vui :) :) :) và cảm ơn bác nhiều!

1) Dân Cơ khí dùng trên 90% là cút 90°C, các loại phụ kiện như:“co lơi (135 độ), rẽ nhánh chữ T, nối thay đổi đ/kính ông (tăng giảm) ... “ đều có nhưng chỉ chiếm khoảng 10%, bác ạ!

Bác xem ảnh minh họa trong bài viết của cái Hoằn và bài của em sẽ trong chủ đề sau sẽ hiểu:

http://www.cadviet.c...-autocad/page-2

Rắc co, rẽ nhánh chữ T, côn thu có nhiều ở đầu ra của máy bơm nước, máy bơm dịch và máy nén khí. Đường ống truyền dẫn đến thiết bị thường là các đoạn ống và cút được hàn nối với nhau chứ không lắp ren.

2)- Em chỉ nhờ anh Hiệp viết lisp vẽ đường ống theo tiêu chuẩn Đức. Khi cần vẽ đường ống theo các tiêu chuẩn khác , người dùng lisp sẽ phải tự chỉnh sửa và bổ xung thêm vào dòng code của lisp.

Em nói là vẽ ống theo tiêu chuẩn Đức cho hoành tráng thôi, trong thực tế, thì chỉ có loại cút hàn mới đảm bảo đúng và đủ chiều cao tâm cút; còn loại cút uốn trên máy uốn ống tự chế thì chiều cao tâm cút sẽ thay đổi ít nhiều, tùy theo bán kính con lăn của máy uốn.

3)- Mục tiêu của việc vẽ đường ống 3D là để công nhân dễ lắp đặt và dễ thống kê chính xác được số lượng ống và cút, bởi vậy em chỉ vẽ ống đặc, vẽ ống rỗng dung lượng file sẽ tăng lên nhiều rất khó khăn cho việc zoom pan và copy move…

Nếu không có hình 3D, mà chỉ nhìn vào sơ đồ nguyên lý làm việc thì người thợ sẽ cắt nát hết ống, gây lãng phí vật tư, thời gian và công sức.

@ anh Hiepttr : Em đã thử lisp của anh trong chủ đề: http://www.cadviet.c...trong-3d/page-6

Trước tiên em phải cảm ơn và xin lỗi anh Hiệp, vì em đã ngớ ngẩn “ra đề bài” không rõ ràng, khiến công hữu ích bị tổn thất - > [Ϭưche] - vượt quá giới hạn ... ức chế cho phép!

1)- Lisp vẽ đường ống ve.lisp của anh rất hay ở chỗ là khi cần vẽ ống và cút DN50, em nhâp đường kính ống 52 , lisp tự động vẽ ra được ống và cút có layer Cut_DN50 và Ong_DN50.

Rất tiếc là khi em vẽ cần vẽ ống và cút DN20 thì lisp lại không tự động tạo ra đươc lay ống có layer Cut_DN20 và Ong_DN20

Em muốn anh chỉnh sửa lại được không??? ( không cần phải đổi màu của layer anh ạ)

2)- Lisp tko_tkc cũng chưa ổn anh ạ!

Ý của em là khi vẽ xong bản tổng mới thống kê tổng chiều dài của từng chủng loại ống và và số lượng cút.

a-) Gõ lệnh tko >>> chọn một đoạn ống DN50 bất kỳ >>>Lisp sẽ tự động Union tất cả các đoạn ống DN50 rời rạc thành một đối tượng và cho biết tổng chiều dài ống

b-) Gõ lệnh tkc >>> chọn một cái cút DN50 bất kỳ >>>Lisp sẽ tự động Union tất cả các cút DN50 rời rạc thành một đối tượng và cho biết tổng số lượng cút.

Rất mong được bác Doan Van Ha, anh Hiepttr, bác Gia_bach cùng các bác viết lisp trên diễn đàn quan tâm đến Em-Lisp vẽ đường ống 3D, em xin trân trọng cám ơn!

Tháng 10 31, 2014

@Bác Doan Van Ha:

Không phải phải là em có ý định xóa chủ đề : "Tổng hợp các lisp thường dùng cho dân khí...." (Em lập chủ đề ấy để dễ tìm kiếm).

Tự dưng cái Hoằn không hiểu ý của em đã chen ngang lisp khai triển cánh vít vào vị trí số 3. Lisp khai triển cánh vít ít dùng em tạm dừng lại, mặc dù anh Hiệp đã viết xong phần đầu là lisp xác định đường kính trung bình tính toán Dtb và dtb.

Em muốn giải quyết dứt điểm Lisp vẽ đường ống 3D trước (cần thiết hơn), sau đó sẽ trở lại nhờ các bác viết lisp khai triển cánh vít sau, bác ạ!

Em đã hiểu và xin rút kinh nghiệm, chị Hà ạ!

Dù sao thì em cũng cảm ơn anh Hiệp, đã cho ra lò Lisp xác định đường kính trung bình tính toán Dtb và dtb làm cơ sở để vẽ hình khai triển cánh vít :

http://www.cadviet.com/forum/topic/112282-tong-hop-cac-lisp-thuong-dung-cho-dan-co-khi-cap-toc-thoat-nuoc/page-2

(Em cảm ơn anh Hiệp nhiều nhiều nhé! :) :) :) )

Tháng 11 6, 2014

@ anh Hiepttr : Em đã thử lisp của anh trong chủ đề: http://www.cadviet.c...trong-3d/page-6

Trước tiên em phải cảm ơn và xin lỗi anh Hiệp, vì em đã ngớ ngẩn “ra đề bài” không rõ ràng, khiến công hữu ích bị tổn thất - > [Ϭưche] - vượt quá giới hạn ... ức chế cho phép!

1)- Lisp vẽ đường ống ve.lisp của anh rất hay ở chỗ là khi cần vẽ ống và cút DN50, em nhâp đường kính ống 52 , lisp tự động vẽ ra được ống và cút có layer Cut_DN50 và Ong_DN50.

Rất tiếc là khi em vẽ cần vẽ ống và cút DN20 thì lisp lại không tự động tạo ra đươc lay ống có layer Cut_DN20 và Ong_DN20

Em muốn anh chỉnh sửa lại được không??? ( không cần phải đổi màu của layer anh ạ)

2)- Lisp tko_tkc cũng chưa ổn anh ạ!

Ý của em là khi vẽ xong bản tổng mới thống kê tổng chiều dài của từng chủng loại ống và và số lượng cút.

a-) Gõ lệnh tko >>> chọn một đoạn ống DN50 bất kỳ >>>Lisp sẽ tự động Union tất cả các đoạn ống DN50 rời rạc thành một đối tượng và cho biết tổng chiều dài ống

b-) Gõ lệnh tkc >>> chọn một cái cút DN50 bất kỳ >>>Lisp sẽ tự động Union tất cả các cút DN50 rời rạc thành một đối tượng và cho biết tổng số lượng cút.

Rất mong được bác Doan Van Ha, anh Hiepttr, bác Gia_bach cùng các bác viết lisp trên diễn đàn quan tâm đến Em-Lisp vẽ đường ống 3D, em xin trân trọng cám ơn!

Dạo này "hơi bị lụt" nên mình ít lên diễn đàn, bỏ bê việc học, nợ bài haanh ... :D :D :D

Mình có vài ý sau:

1. Theo cách đặt tên layer của haanh, khi người dùng nhập đường kính 52 hoặc 53 >>> đều cho ra các ống (cút) có layer tên là *_DN50 >>> Phân biệt thế nào ?! Và đặc biệt thống kê hơi bị vất vả (vì như mình đã nói từ trước là "Quá khó để moi thông tin của đối tượng là 3d solid từ bác Auto desk")

>>> Kiến nghị chủ nhiệm đồ án Haanh thay đổi cách đặt tên layer = "ống" + "đường kính" (hoặc "cút" + "đường kính" ).

>>> Sau này, việc thống kê số lượng cũng chỉ dựa vào cái tên này thôi !

Ưu điểm: đơn giản để code, rất có thể là code thống kê sẽ chạy nhanh hơn cách khác (VD: nổ ra để kiểm tra đường kính)

Nhược: Chỉ đánh giá qua tên layer, nên buộc người dùng phải thận trọng nếu là bản vẽ chắp nối mà có một vài em nằm ở layer khác thì sẽ dẫn đến thống kê sai.

2. Cách gì cũng có 2 mặt của nó:

Lisp thống kê mình viết ở trên buộc người dùng quét chọn vùng chứa đối tượng là chủ ý của mình để khỏi phải nhầm nếu có một vài bản nháp nằm rải rác đâu đó trên file. Nếu haanh chấp nhận cái "hên_xui" đó thì mình sửa !

Tháng 11 6, 2014

@ Hiepttr

Tính chiều dài Solid : Hiệp thử dùng Xdata (dữ liệu mở rộng) xem sao, anh thấy phần Xdata có trong bài học #7 không biết "nôi công" đến mức nào rồi ?

Cụ thể khi tạo Solid ta gán thêm giá trị chiều dài và đường kính vào Solid (dùng Xdata), khi truy xuất ta chỉ việc đọc giá trị này (nếu Solid không có Xdata -> thông báo gì đó ..)

Ưu : thông kê nhanh, không phụ thuộc Layer.

Nhược : nếu Solid không do Lisp này tạo ra (user tự tạo) thì sẽ không thống kê được.

- các hàm Xdata : ACET-XDATA-GET, ACET-XDATA-SET, vla-getXdata, vla-setXdata

Tháng 11 6, 2014

Xdata là gì vậy ạ?

Tháng 11 6, 2014

Bác Gia_bach:

- Xdata có lợi thế hơn là chỉ khi có chủ ý thì mới thay đổi nó được, còn layer thì có thể vô tình sẻ bị "chạy lung tung" (VD: khi dùng lệnh MA) ---> đã vote

- Bác có thể cho em xin cấu trúc các hàm mà bác đã nêu ở trên ?!

"Nội công" vẫn chưa thể dùng đc :D :D :D

Tháng 11 7, 2014

Ví dụ tham khảo :

(defun c:setX (/ ent)
  (setq XData_name "DuongOng_Xdata" dg_kinh 52 ch_dai 4500)
  (if (setq ent (entsel "\nSelect Object: "))
    (progn
      (vla-setXData
	(vlax-ename->vla-object (car ent))
	(vlax-safearray-fill (vlax-make-safearray vlax-vbInteger '(0 . 2)) (list 1001 1070 1040) )
	(vlax-safearray-fill (vlax-make-safearray vlax-vbVariant '(0 . 2))
	  (list (vlax-make-variant XData_name)
		(vlax-make-variant dg_kinh)		
		(vlax-make-variant ch_dai)) ) ) ) )
  (princ))
(defun c:getX (/ ent typ val)
  (if (setq ent (entsel "\nSelect Object: "))
    (progn
      (vla-getXData (vlax-ename->vla-object (car ent)) "" 'typ 'val)
      (if (or (not typ) (not val))
	(princ "\n** No XData Found **")
	(print (apply 'mapcar (cons 'cons (list (vlax-safearray->list typ)
						(mapcar 'vlax-variant-value
							(vlax-safearray->list val)))))))))
  (princ))

Tháng 11 7, 2014

Mr gia_bach !

Bác thật "đáng ghét" !!! :D :D :D

Trong khi em bắc loa rêu rao, kêu cứu để được biết thêm về vla, vlax ... mấy hôm liền thì bác không "vác" đống này ra,

Giờ thì bác tung 1 đống hỏa mù (đối với mình) vậy chắc em nổ não quá :D

Trong cả đám đó, em chỉ biết mỗi "thằng" vlax-ename->vla-object, còn mấy "thằng" khác chỉ lơ mơ rằng hình như là kiểu dữ liệu gì gì đó :D :D :D

p/s: Tiện thể bác truyền cho em thêm tí nội lực về món vla, vlax ... này nhé ! Thanks !

Bác có thể nối tiếp vào đây hoặc là một vị trí mà bác cho là hợp lý !

Tháng 11 8, 2014

Lại hỏi nữa :D :D :D

Mò mấy hôm vẫn chưa thể thông, chỉ hiểu sơ sơ thế này, nhờ bác chỉ thêm giùm:

- SETX:

tạo dữ liệu mảng từ dữ liệu đầu vào và đưa vào hàm vla-setXData theo kiểu các mã dxf làm 1 list, value làm 1 list

>>>> Xin được hỏi: các mã 1001 1070 1040 lấy theo quy ước nào ?

- GETX:

dùng hàm vla-getXData để "cho ra" 2 mảng TYP và VAL rồi chuyển về kiểu dữ liệu list bình thường ==> in ra.

>>>> Hỏi: cấu trúc hàm vla-getXData luôn là như thế hay có biến tấu gì khác nữa không ?

p/s: Não sắp nổ, chống gậy chờ tin của bác :D :D :D

Tháng 11 8, 2014

>>>> Xin được hỏi: các mã 1001 1070 1040 lấy theo quy ước nào ?

- 1001 khai báo tên của Xdata bắt buộc phải có và đứng đầu

- 1000 khi kiểu của dữ liệu là chuỗi (string)

- 1070 khi kiểu của dữ liệu là số nguyên (16b)

- 1071 khi kiểu của dữ liệu là số nguyên (32b)

- 1040 khi kiểu của dữ liệu là số thực

- 1003, 1042, 1010,1011 ...

>>>> Hỏi: cấu trúc hàm vla-getXData luôn là như thế hay có biến tấu gì khác nữa không ?

- không chắc là vla-getXDatacó biến tấu gì nữa không (nhưng chưa thấy ai sử dụng)

- nhưng hàm vla-setXData thì đã thấy có nhiều biến tấu ! nhưng tìm hiểu làm gì cho "hại não"

Tháng 11 9, 2014

Sửa lsp ve.lsp theo yêu cầu số 1 của haanh.

 
(defun c:VE(/ lst_va old D ss lst_TC_DUC cao_tam_cut net R path cut base_w lst_ver lst_w obj i ss_ong ss_cut n len dau cuoi)
;ham bay loi
(setq temperr *error*)
(defun errorTrap (msg)
    (mapcar 'setvar lst_va old)
(cond
((tblsearch "ucs" "save_ucs") 
(command "ucs" "na" "r" "save_ucs")
(command "ucs" "na" "d" "save_ucs")
)
)
(cond
((tblsearch "ucs" "save1_ucs") 
(command "ucs" "na" "r" "save1_ucs")
(command "ucs" "na" "d" "save1_ucs")
)
)
    (setq *error* temperr)
(princ "\n*** Da set lai bien, OK ! ***")
    (princ)
)
(setq *error* errorTrap)
;======het ham bay loi = P1 ============================
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(command ".undo" "be")
;=================
(setq lst_TC_DUC '((12 . 26.0) (18 . 35.0) (22 . 40.0) (28 . 50.0) (35 . 55.0) (40 . 60.0) (52 . 70.0) (70 . 80.0)
  (85 . 90.0) (104 . 100.0) (129 . 187.5) (154 . 225.0) (204 . 300.0) (254 . 375.0))
      lst_fi_tcduc '((12 . "DN10") (18 . "DN15") (22 . "DN20") (28 . "DN25") (35 . "DN32") (40 . "DN40")
    (52 . "DN50") (70 . "DN65") (85 . "DN80") (104 . "DN100") (129 . "DN125")
    (154 . "DN150") (204 . "DN200") (254 . "DN250"))
      D (getdist (strcat "\nNhap duong kinh ong <"
(apply 'strcat (mapcar '(lambda (x) (strcat (itoa (car x)) " ")) lst_TC_DUC)) ">:"))
      Lay (cdr (assoc D lst_fi_tcduc))
      cao_tam_cut (cdr (assoc D lst_TC_DUC))
)
;=================
(prompt "\nChon 3DPOLY: ")
(setq ss (ssget "+.:E:S" '((0 . "POLYLINE"))))
(if (and
D
(member D (mapcar 'car lst_TC_DUC))
ss)
(progn
(or #lan_ve (setq #lan_ve 0))
(setq #lan_ve (1+ #lan_ve))
;ve cut mau:
(setq net (getvar "clayer"))
(if (tblsearch "layer" (strcat "Cut_" lay)) 
(setvar "clayer" (strcat "Cut_" lay)) 
(command "layer" "m" (strcat "Cut_" lay) "c" "t" "45,159,225" "" "")
) ;if
(command "arc" "c" '(0 0 0) (list cao_tam_cut 0 0) (list 0 cao_tam_cut 0))
(setq path (entlast))
(command "circle" '(0 0 0) (setq R (/ D 2.0)))
(command "sweep" (entlast) "" path)
(setq cut (entlast))
(setq base_w (mapcar '(lambda (x) (trans x 1 0)) (list (list cao_tam_cut 0 0) (list cao_tam_cut cao_tam_cut 0) (list 0 cao_tam_cut 0))))
;== xong cut mau ==
(if (tblsearch "layer" (strcat "Ong_" lay)) 
(setvar "clayer" (strcat "Ong_" lay)) 
(command "layer" "m" (strcat "Ong_" lay) "c" "t" "133,230,244" "" "")
) ;if 
;Luu UCS:
(command "ucs" "na" "s" "save1_ucs")
;(command "-view" "s" "save_v")
;*******************************
(setq lst_ver (acet-geom-vertex-list (setq ename (ssname ss 0)))
 lst_w (mapcar '(lambda (x) (trans x 1 0)) lst_ver)
 obj (vlax-ename->vla-object ename))
(setq i 0
 ss_ong (ssadd)
 ss_cut (ssadd)
 )
(repeat (setq n (1- (length lst_w)))
(setq len (distance (setq dau (nth i lst_w)) (setq cuoi (nth (1+ i) lst_w))))
(command "UCS" "za" (trans dau 0 1) (trans cuoi 0 1))
(cond
((= i 0) (command "CYLINDER" (trans dau 0 1) R (- len cao_tam_cut)) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
(3DDD cut  
(trans (car base_w) 0 1) 
(trans (cadr base_w) 0 1) 
(trans (last base_w) 0 1) 
(trans (vlax-curve-getPointAtDist obj (- (vlax-curve-getDistAtParam obj 1) cao_tam_cut)) 0 1) 
(trans (vlax-curve-getPointAtParam obj 1) 0 1) 
(trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtParam obj 1) cao_tam_cut)) 0 1)) ;align_copy cut
(setq ss_cut (ssadd (entlast) ss_cut))
)
((= i (1- n)) (command "CYLINDER" (mapcar '+ (list 0 0 cao_tam_cut) (trans dau 0 1)) R (- len cao_tam_cut)) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
) 
(t (command "CYLINDER" (mapcar '+ (list 0 0 cao_tam_cut) (trans dau 0 1)) R (- len (* 2 cao_tam_cut))) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
(3DDD cut 
(trans (car base_w) 0 1) 
(trans (cadr base_w) 0 1) 
(trans (last base_w) 0 1) 
(trans (vlax-curve-getPointAtDist obj (- (vlax-curve-getDistAtParam obj (1+ i)) cao_tam_cut)) 0 1) 
(trans (vlax-curve-getPointAtParam obj (1+ i)) 0 1) 
(trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtParam obj (1+ i)) cao_tam_cut)) 0 1)) ;align_copy cut
(setq ss_cut (ssadd (entlast) ss_cut))
)
)
(setq i (1+ i))
) ;repeat
(command ".ERASE" cut "")
(command ".ERASE" path "")
(command ".ERASE" ss "")
(command "ucs" "na" "r" "save1_ucs")
(command "ucs" "na" "d" "save1_ucs")
(setvar "clayer" net)
)
(alert "***** Nhap du lieu chua dung ! *****")
)
(command ".undo" "end")
(setq *error* temperr) ;tra ham erorr nguyen thuy
(mapcar 'setvar lst_va old)
(princ)
)
(vl-load-com)
;*****************************************************************************************************************************
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;=============================================================================================================================
(defun 3DDD(ss pt_a pt_b pt_c pt_1 pt_2 pt_3 / lst_va old lst_point_w moc new pre
huong_12_xoy huong_13_xoy huong_ab_xoy huong_ac_xoy 
huong_12_yoz huong_13_yoz huong_ab_yoz huong_ac_yoz 
huong_12_xoz huong_13_xoz huong_ab_xoz huong_ac_xoz 
pt_phu pt_phu_w pt_phu2 pt_phu2_w base truc truc_w ang anh anh_c anh_w pt_phu2_2d pt_phu2_w_3d pt_phu_2d pt_phu_3d pt_phu_w_3d)
;Ham 3dalign khong scale Voi 3 diem chon phai "bang nhau" ve kich thuoc hinh dang
(setq lst_va '("osmode" "cmdecho" "AUNITS" "ANGDIR"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0 3 0))
(setq lst_point_w (mapcar '(lambda (x) (trans x 1 0)) (list pt_a pt_b pt_c pt_1 pt_2 pt_3)))
(command "ucs" "na" "s" "save_ucs")
;(command "-view" "s" "save_v")
(setq moc (entlast) 
 new (ssadd))
(command "_.copy" ss "" pt_a pt_1)
(while (setq pre (entnext moc))
(setq new (ssadd pre new)
 moc pre)
) ;while
;======================================================================
;Kiem tra trung phuong, chieu
(command "ucs" "za" '(0 0 0) '(2.357 1.312 4.235))
(setq huong_12_xoy (angle (nth 3 lst_point_w) (nth 4 lst_point_w))
 huong_13_xoy (angle (nth 3 lst_point_w) (nth 5 lst_point_w))
 huong_ab_xoy (angle (nth 0 lst_point_w) (nth 1 lst_point_w))
 huong_ac_xoy (angle (nth 0 lst_point_w) (nth 2 lst_point_w))
 )
(command "ucs" "za" '(0 0 0) '(1 0 0))
(setq huong_12_yoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 4 lst_point_w) 0 1))
 huong_13_yoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 5 lst_point_w) 0 1))
 huong_ab_yoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 1 lst_point_w) 0 1))
 huong_ac_yoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 2 lst_point_w) 0 1))
 )
(command "ucs" "za" '(0 0 0) '(1 0 0))
(setq huong_12_xoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 4 lst_point_w) 0 1))
 huong_13_xoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 5 lst_point_w) 0 1))
 huong_ab_xoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 1 lst_point_w) 0 1))
 huong_ac_xoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 2 lst_point_w) 0 1))
 )
(command "ucs" "na" "r" "save_ucs")
;=====================================================================
(cond
((and 
(equal huong_12_xoy huong_ab_xoy 1e-5) 
(equal huong_12_yoz huong_ab_yoz 1e-5)
(equal huong_12_xoz huong_ab_xoz 1e-5)
)
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(princ "\nAlign = Copy ! ")
(princ)
)
(t 
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 pt_phu_w (trans pt_phu 1 0))
(command "ucs" "za" pt_1 pt_2)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 5 lst_point_w) 0 1)) (angle base (trans pt_phu_w 0 1)))
)
)
)
)
;========================================================
((and 
(or (equal (+ huong_12_xoy pi) huong_ab_xoy 1e-5) (equal (- huong_12_xoy pi) huong_ab_xoy 1e-5))
(or (equal (+ huong_12_yoz pi) huong_ab_yoz 1e-5) (equal (- huong_12_yoz pi) huong_ab_yoz 1e-5))
(or (equal (+ huong_12_xoz pi) huong_ab_xoz 1e-5) (equal (- huong_12_xoz pi) huong_ab_xoz 1e-5))
)
(setq truc (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 truc_w (trans truc 1 0))
(setq anh (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 anh_w (trans anh 1 0))
(command "ucs" "za" pt_1 truc)
(command "rotate" new "" (setq base (trans (nth 3 lst_point_w) 0 1)) pi)
(setq pt_phu2_2d
(polar 
base 
(+ pi (angle base (setq anh_c (trans anh_w 0 1)))) 
(distance base (list (car anh_c) (cadr anh_c)))
)
pt_phu2_w_3d (trans (list (car pt_phu2_2d) (cadr pt_phu2_2d) (last anh_c)) 1 0)
)
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(princ)
)
((and 
(or (equal (+ huong_13_xoy pi) huong_ac_xoy 1e-5) (equal (- huong_13_xoy pi) huong_ac_xoy 1e-5))
(or (equal (+ huong_13_yoz pi) huong_ac_yoz 1e-5) (equal (- huong_13_yoz pi) huong_ac_yoz 1e-5))
(or (equal (+ huong_13_xoz pi) huong_ac_xoz 1e-5) (equal (- huong_13_xoz pi) huong_ac_xoz 1e-5))
)
(command "ucs" "za" base (mapcar '(lambda (x) (* 0.5 x)) (mapcar '+ (trans pt_phu2_w_3d 0 1) (trans (nth 4 lst_point_w) 0 1))))
(command "rotate" new "" (trans (nth 3 lst_point_w) 0 1) pi)
)
(t 
(command "ucs" "3p" base (trans (nth 5 lst_point_w) 0 1) (trans truc_w 0 1))
(command "rotate" new ""
(setq base (trans (nth 3 lst_point_w) 0 1))
(* -1 (angle base (trans truc_w 0 1)))
)
)
)
)
;==================================================================
(t 
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 pt_phu_w (trans pt_phu 1 0))
(command "ucs" "za" pt_1 pt_3)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 4 lst_point_w) 0 1)) (angle base (trans pt_phu_w 0 1)))
)
)
((and 
(or (equal (+ huong_13_xoy pi) huong_ac_xoy 1e-5) (equal (- huong_13_xoy pi) huong_ac_xoy 1e-5))
(or (equal (+ huong_13_yoz pi) huong_ac_yoz 1e-5) (equal (- huong_13_yoz pi) huong_ac_yoz 1e-5))
(or (equal (+ huong_13_xoz pi) huong_ac_xoz 1e-5) (equal (- huong_13_xoz pi) huong_ac_xoz 1e-5))
)
(setq truc (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 truc_w (trans truc 1 0))
(setq anh (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 anh_w (trans anh 1 0))
(command "ucs" "za" pt_1 truc)
(command "rotate" new "" (setq base (trans (nth 3 lst_point_w) 0 1)) pi)
(command "ucs" "3p" base (trans (nth 4 lst_point_w) 0 1) (trans truc_w 0 1))
(command "rotate" new ""
(setq base (trans (nth 3 lst_point_w) 0 1))
(* -1 (angle base (trans truc_w 0 1)))
)
)
(t
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 pt_phu_w (trans pt_phu 1 0)
 pt_phu2 (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 pt_phu2_w (trans pt_phu2 1 0))
(command "ucs" "3p" pt_1 pt_2 pt_phu)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1)) 
(setq ang (* -1 (angle base (trans pt_phu_w 0 1))))
)
(setq pt_phu_2d 
(polar 
base 
(+ ang (angle base (setq anh_c (trans pt_phu2_w 0 1)))) 
(distance (list (car base) (cadr base)) (list (car anh_c) (cadr anh_c))))
 pt_phu_3d (list (car pt_phu_2d) (cadr pt_phu_2d) (last anh_c))
 pt_phu_w_3d (trans pt_phu_3d 1 0))
(command "ucs" "za" (trans (nth 3  lst_point_w) 0 1) (trans (nth 4  lst_point_w) 0 1))
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 5 lst_point_w) 0 1)) (angle base (trans pt_phu_w_3d 0 1)))
)
)
)
)
)
(command "ucs" "na" "r" "save_ucs")
(command "ucs" "na" "d" "save_ucs")
;(command "-view" "r" "save_v")
;(command "-view" "d" "save_v")
(mapcar 'setvar lst_va old)
(princ)
)

Tháng 11 9, 2014

Sửa lsp tko_tkc. Tôi thấy k cần group nó lại vì nếu group thì lần sau nhỡ quơ nhầm nó thì nó sẽ tính 2 lần. Vả lại bây giờ các ống cút đã nằm trong các layer khác nhau rồi, nó sẽ phân biệt theo layer.

;Lisp thong ke ong; cut trong he thong duong ong
(defun c:TKO( / lst_va old sam D ss lst tong L)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(17 0))
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
 
(setq sam (assoc 8 (entget (car (entsel "\nChon ong mau: "))))
      lst_fi_tcduc '((12 . "DN10") (18 . "DN15") (22 . "DN20") (28 . "DN25") (35 . "DN32") (40 . "DN40")
    (52 . "DN50") (70 . "DN65") (85 . "DN80") (104 . "DN100") (129 . "DN125")
    (154 . "DN150") (204 . "DN200") (254 . "DN250"))
      D (caar (vl-remove-if-not '(lambda (x) (vl-string-search (cdr x) (cdr sam))) lst_fi_tcduc))
)
(prompt "\Chon cac ong can thong ke chieu dai: ")
(setq ss (ssget (list '(0 . "3DSOLID") sam))
      lst (ss2lst ss)
      tong 0)
(foreach elem lst
(command ".area" "o" elem)
(setq S (getvar 'area)
     L (/ (- S (* 2 pi 0.25 D D)) (* pi D))
     tong (+ L tong))
) ;for
;;;(command "group" "c" (strcat "Ong_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_ong" ss "")
(princ (strcat "\nTong chieu dai " (cdr sam) " la: " (rtos tong 2 3) " (don vi ve)"))
(mapcar 'setvar lst_va old)
(princ)
)
;===================================================================
;Lisp thong ke cut
(defun c:TKC( / sam ss cmd)
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
(setq sam (assoc 8 (entget(car(entsel "\nChon cut mau: ")))))
(prompt "\Chon cac cut can thong ke so luong: ")
(setq ss (ssget (list '(0 . "3DSOLID") sam)))
;;;(command "group" "c" (strcat "Cut_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_cut" ss "")
(princ (strcat "\nTong so " (cdr sam) " la: " (itoa (sslength ss)) " (cai)"))
(setvar 'cmdecho cmd)
(princ)
)
;===================================================================
(defun ss2lst (ss / ename i lst)
;chuyen ss thanh list
(setq i 0)
(repeat (sslength ss)
(setq ename (ssname ss i)
 i (1+ i)
 lst (cons ename lst))
)
(reverse lst)
)

Tháng 11 9, 2014

Em rất vui và cảm ơn nhiều khi được bác Tot77 ghé thăm lều quán nhà em! :) :) :)

1- Về ve.lisp:

VE.Lisp của bác rất hoành tráng khi hiện ra hình một dãy chữ số chỉ đường kính ống trên dòng Command hiền hòa và thơ mộng!

Nhap duong kinh ong <12 18 22 28 35 40 52 70 85 104 129 154 204 254 >: 52

Hơi bị tiếc là không quét chọn nhiều đoạn 3dpoly cùng một lúc, mà chỉ bấm chọn được 1 đoạn.

Vẽ xong 1 đoạn rồi, muốn vẽ tiếp đoạn thứ 2 nó bắt phải nhập số lại, hơi bị mất thới gian...

Em muốn, sau khi nhập số có thể quét chọn được nhiều anh 3dpoly cùng một lúc có được không???

Khi đó dòng Command sẽ là: [12\ 18\ 22\ 28\ 35\ 40\ 52\ 70\ 85\ 104\129\ 154\ 204 \254] <52>:để có thể quét chọn đồng loạt nhiều anh 3dpoly và có thể dùng để vẽ đường ống 52 được nhiều lần mà không phải nhập lại đường kính ống.

2- Về tko_tkc.lisp:

Cách thống kê thủ công của em như sau, khi vẽ bản tổng, em copy thêm một bản vẽ nữa để thống kê:

- Với ống: Em tắt hết cả các layer chỉ để lại ống layer DN50 duy nhất >>>Gõ lệnh Union để liên kết thành một khối rồi tính thể tích >>> chia cho diện tích tiết diện ngang của ống sẽ ra chiều dài.

(Hiện em chỉ biết tắt từng layer một hơi mất thời gian, không biết là có lisp nào tắt đồng loạt tất cả các layer chỉ để lại 1 layer hiện hành không???)

- Với cút : em sẽ tắt layer ống DN50 rồi mở layer cút DN50 >>> Em chỉ việc nhấn phím Ctrl+A rồi gõ M là sẽ biết được số lượng cút là 325 cái

Command: _ai_selall Selecting objects...done.
Command: m
MOVE 325 found

"Ý của em là khi vẽ xong bản tổng mới thống kê tổng chiều dài của từng chủng loại ống và và số lượng cút.

a-) Gõ lệnh tko >>> chọn một đoạn ống DN50 bất kỳ >>>Lisp sẽ tự động Union tất cả các đoạn ống DN50 rời rạc thành một đối tượng và cho biết tổng chiều dài ống

b-) Gõ lệnh tkc >>> chọn một cái cút DN50 bất kỳ >>>Lisp sẽ tự động Union tất cả các cút DN50 rời rạc thành một đối tượng và cho biết tổng số lượng cút." Không biết lisp có thực hiện được không???(Em muốn Union các đối tượng rời rạc thành một khối để dễ thực hiện zoom,pan, copy,move và in ấn...vì dung lượng bản tổng thường từ 40MB-50MB)

Lều quán nhà em luôn có chè sen rượu nồng và đặc biệt là điếu cày kêu rất giòn, em rất hân hạnh được đón tiếp và hầu chuyện các bác viết lisp theo yêu cầu trên diễn đàn ghé chơi!

Dạo này "hơi bị lụt" nên mình ít lên diễn đàn, bỏ bê việc học, nợ bài haanh ... :D :D :D

Vậy mà em cứ linh cảm anh bận đi hưởng tuần trăng mật ở một hòn đảo thơ mộng nào đó rất xa xôi ...Không thấy anh hồi âm, em cứ ấm ức đến phát khóc lên được vì cứ ngỡ anh lấy vợ mà tiếc tiền không gửi cho em một lá thiếp hồng... :wub: :wub:

Em đã hiểu và xin rút kinh nghiệm, chị Hà ạ!

Chị biết, Hoằn có thời gian rảnh rổi , ẩn hiện như ma xó lê la khắp hang cùng ngõ hẻm của làng CADViet.com để buôn dưa lê bán dưa chuột. Vậy mà không thấy Hoằn lai vãng tới lều quán của chị, vì sao vậy hả Hoằn???

Tháng 11 10, 2014

(Hiện em chỉ biết tắt từng layer một hơi mất thời gian, không biết là có lisp nào tắt đồng loạt tất cả các layer chỉ để lại 1 layer hiện hành không???)

Chắc câu này là haanh đang để thử kiểm tra xem ai đang vào "lều" của mình ?!

Mình nghĩ haanh thì không thể chưa xài đến LAYISO

Tháng 11 10, 2014

1.Về ve.lsp

Nói chung hiepttr đã tạo sẵn cái khung lsp rồi, tôi chỉ có thêm mắm muối cho xôm tụ thôi. Còn tại sao có dòng ĐK dài lê thê là vì khi mới thử lsp của hiepttr, vì là dân "ngoại đạo" với các loại ông nên nó cứ báo sai số liệu đòi nhập lại hoài, ghét quá mới thêm cái đó vào cho dễ chọn thội. Chứ chắc dận "nôi đạo" như haanh thì chẳng cần, nhắm mắt cũng biết ống fi mấy rồi.

2. Về tko_tkc

haanh thích union cũng chẳng có gì, chọn hết 1 loại ống trong bản vẽ rồi union nó lại.Dĩ nhiên khi đó thống kê trên toàn bộ bản vẽ chứ không phải 1 nhóm.

3. Cadviet dạo này cũng có ma rồi sao? :o :o

 
(defun c:VE(/ lst_va old ss sss lst_TC_DUC lst_fi_tcduc D1 cao_tam_cut net R path cut base_w lst_ver lst_w obj i ss_ong ss_cut n len dau cuoi)
;ham bay loi
(setq temperr *error*)
(defun errorTrap (msg)
    (mapcar 'setvar lst_va old)
(cond
((tblsearch "ucs" "save_ucs") 
(command "ucs" "na" "r" "save_ucs")
(command "ucs" "na" "d" "save_ucs")
)
)
(cond
((tblsearch "ucs" "save1_ucs") 
(command "ucs" "na" "r" "save1_ucs")
(command "ucs" "na" "d" "save1_ucs")
)
)
    (setq *error* temperr)
(princ "\n*** Da set lai bien, OK ! ***")
    (princ)
)
(setq *error* errorTrap)
;======het ham bay loi = P1 ============================
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(command ".undo" "be")
;=================
(setq lst_TC_DUC '((12 . 26.0) (18 . 35.0) (22 . 40.0) (28 . 50.0) (35 . 55.0) (40 . 60.0) (52 . 70.0) (70 . 80.0)
  (85 . 90.0) (104 . 100.0) (129 . 187.5) (154 . 225.0) (204 . 300.0) (254 . 375.0))
      lst_fi_tcduc '((12 . "DN10") (18 . "DN15") (22 . "DN20") (28 . "DN25") (35 . "DN32") (40 . "DN40")
    (52 . "DN50") (70 . "DN65") (85 . "DN80") (104 . "DN100") (129 . "DN125")
    (154 . "DN150") (204 . "DN200") (254 . "DN250"))
      D1 (getdist (strcat "\nNhap duong kinh ong ["
  (apply 'strcat (mapcar '(lambda (x) (strcat (itoa (car x)) (if (not (equal x (last lst_TC_DUC))) "\\ " ""))) lst_TC_DUC)) "]<"
 (if D (rtos D) "") ">:"))
)
(if D1 (setq D D1))
(setq  Lay (cdr (assoc D lst_fi_tcduc))
       cao_tam_cut (cdr (assoc D lst_TC_DUC))
)
;=================
(prompt "\nChon 3DPOLY: ")
(setq sss (ssget '((0 . "POLYLINE"))))
(if (and D
(member D (mapcar 'car lst_TC_DUC))
sss)
(foreach ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex sss))) 
(or #lan_ve (setq #lan_ve 0))
(setq #lan_ve (1+ #lan_ve))
;ve cut mau:
(setq net (getvar "clayer"))
(if (tblsearch "layer" (strcat "Cut_" lay)) 
(setvar "clayer" (strcat "Cut_" lay)) 
(command "layer" "m" (strcat "Cut_" lay) "c" "t" "45,159,225" "" "")
) ;if
(command "arc" "c" '(0 0 0) (list cao_tam_cut 0 0) (list 0 cao_tam_cut 0))
(setq path (entlast))
(command "circle" '(0 0 0) (setq R (/ D 2.0)))
(command "sweep" (entlast) "" path)
(setq cut (entlast))
(setq base_w (mapcar '(lambda (x) (trans x 1 0)) (list (list cao_tam_cut 0 0) (list cao_tam_cut cao_tam_cut 0) (list 0 cao_tam_cut 0))))
;== xong cut mau ==
(if (tblsearch "layer" (strcat "Ong_" lay)) 
(setvar "clayer" (strcat "Ong_" lay)) 
(command "layer" "m" (strcat "Ong_" lay) "c" "t" "133,230,244" "" "")
) ;if 
;Luu UCS:
(command "ucs" "na" "s" "save1_ucs")
;(command "-view" "s" "save_v")
;*******************************
(setq lst_ver (acet-geom-vertex-list (setq ename ss))
 lst_w (mapcar '(lambda (x) (trans x 1 0)) lst_ver)
 obj (vlax-ename->vla-object ename))
(setq i 0
 ss_ong (ssadd)
 ss_cut (ssadd)
 )
(repeat (setq n (1- (length lst_w)))
(setq len (distance (setq dau (nth i lst_w)) (setq cuoi (nth (1+ i) lst_w))))
(command "UCS" "za" (trans dau 0 1) (trans cuoi 0 1))
(cond
((= i 0) (command "CYLINDER" (trans dau 0 1) R (- len cao_tam_cut)) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
(3DDD cut  
(trans (car base_w) 0 1) 
(trans (cadr base_w) 0 1) 
(trans (last base_w) 0 1) 
(trans (vlax-curve-getPointAtDist obj (- (vlax-curve-getDistAtParam obj 1) cao_tam_cut)) 0 1) 
(trans (vlax-curve-getPointAtParam obj 1) 0 1) 
(trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtParam obj 1) cao_tam_cut)) 0 1)) ;align_copy cut
(setq ss_cut (ssadd (entlast) ss_cut))
)
((= i (1- n)) (command "CYLINDER" (mapcar '+ (list 0 0 cao_tam_cut) (trans dau 0 1)) R (- len cao_tam_cut)) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
) 
(t (command "CYLINDER" (mapcar '+ (list 0 0 cao_tam_cut) (trans dau 0 1)) R (- len (* 2 cao_tam_cut))) ;ve ong
(setq ss_ong (ssadd (entlast) ss_ong))
(3DDD cut 
(trans (car base_w) 0 1) 
(trans (cadr base_w) 0 1) 
(trans (last base_w) 0 1) 
(trans (vlax-curve-getPointAtDist obj (- (vlax-curve-getDistAtParam obj (1+ i)) cao_tam_cut)) 0 1) 
(trans (vlax-curve-getPointAtParam obj (1+ i)) 0 1) 
(trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtParam obj (1+ i)) cao_tam_cut)) 0 1)) ;align_copy cut
(setq ss_cut (ssadd (entlast) ss_cut))
)
)
(setq i (1+ i))
) ;repeat
(command ".ERASE" cut "")
(command ".ERASE" path "")
(command ".ERASE" ss "")
(command "ucs" "na" "r" "save1_ucs")
(command "ucs" "na" "d" "save1_ucs")
(setvar "clayer" net)
)
(alert "***** Nhap du lieu chua dung ! *****")
)
(command ".undo" "end")
(setq *error* temperr) ;tra ham erorr nguyen thuy
(mapcar 'setvar lst_va old)
(princ)
)
(vl-load-com)
;*****************************************************************************************************************************
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;=============================================================================================================================
(defun 3DDD(ss pt_a pt_b pt_c pt_1 pt_2 pt_3 / lst_va old lst_point_w moc new pre
huong_12_xoy huong_13_xoy huong_ab_xoy huong_ac_xoy 
huong_12_yoz huong_13_yoz huong_ab_yoz huong_ac_yoz 
huong_12_xoz huong_13_xoz huong_ab_xoz huong_ac_xoz 
pt_phu pt_phu_w pt_phu2 pt_phu2_w base truc truc_w ang anh anh_c anh_w pt_phu2_2d pt_phu2_w_3d pt_phu_2d pt_phu_3d pt_phu_w_3d)
;Ham 3dalign khong scale Voi 3 diem chon phai "bang nhau" ve kich thuoc hinh dang
(setq lst_va '("osmode" "cmdecho" "AUNITS" "ANGDIR"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0 3 0))
(setq lst_point_w (mapcar '(lambda (x) (trans x 1 0)) (list pt_a pt_b pt_c pt_1 pt_2 pt_3)))
(command "ucs" "na" "s" "save_ucs")
;(command "-view" "s" "save_v")
(setq moc (entlast) 
 new (ssadd))
(command "_.copy" ss "" pt_a pt_1)
(while (setq pre (entnext moc))
(setq new (ssadd pre new)
 moc pre)
) ;while
;======================================================================
;Kiem tra trung phuong, chieu
(command "ucs" "za" '(0 0 0) '(2.357 1.312 4.235))
(setq huong_12_xoy (angle (nth 3 lst_point_w) (nth 4 lst_point_w))
 huong_13_xoy (angle (nth 3 lst_point_w) (nth 5 lst_point_w))
 huong_ab_xoy (angle (nth 0 lst_point_w) (nth 1 lst_point_w))
 huong_ac_xoy (angle (nth 0 lst_point_w) (nth 2 lst_point_w))
 )
(command "ucs" "za" '(0 0 0) '(1 0 0))
(setq huong_12_yoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 4 lst_point_w) 0 1))
 huong_13_yoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 5 lst_point_w) 0 1))
 huong_ab_yoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 1 lst_point_w) 0 1))
 huong_ac_yoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 2 lst_point_w) 0 1))
 )
(command "ucs" "za" '(0 0 0) '(1 0 0))
(setq huong_12_xoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 4 lst_point_w) 0 1))
 huong_13_xoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 5 lst_point_w) 0 1))
 huong_ab_xoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 1 lst_point_w) 0 1))
 huong_ac_xoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 2 lst_point_w) 0 1))
 )
(command "ucs" "na" "r" "save_ucs")
;=====================================================================
(cond
((and 
(equal huong_12_xoy huong_ab_xoy 1e-5) 
(equal huong_12_yoz huong_ab_yoz 1e-5)
(equal huong_12_xoz huong_ab_xoz 1e-5)
)
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(princ "\nAlign = Copy ! ")
(princ)
)
(t 
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 pt_phu_w (trans pt_phu 1 0))
(command "ucs" "za" pt_1 pt_2)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 5 lst_point_w) 0 1)) (angle base (trans pt_phu_w 0 1)))
)
)
)
)
;========================================================
((and 
(or (equal (+ huong_12_xoy pi) huong_ab_xoy 1e-5) (equal (- huong_12_xoy pi) huong_ab_xoy 1e-5))
(or (equal (+ huong_12_yoz pi) huong_ab_yoz 1e-5) (equal (- huong_12_yoz pi) huong_ab_yoz 1e-5))
(or (equal (+ huong_12_xoz pi) huong_ab_xoz 1e-5) (equal (- huong_12_xoz pi) huong_ab_xoz 1e-5))
)
(setq truc (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 truc_w (trans truc 1 0))
(setq anh (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 anh_w (trans anh 1 0))
(command "ucs" "za" pt_1 truc)
(command "rotate" new "" (setq base (trans (nth 3 lst_point_w) 0 1)) pi)
(setq pt_phu2_2d
(polar 
base 
(+ pi (angle base (setq anh_c (trans anh_w 0 1)))) 
(distance base (list (car anh_c) (cadr anh_c)))
)
pt_phu2_w_3d (trans (list (car pt_phu2_2d) (cadr pt_phu2_2d) (last anh_c)) 1 0)
)
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(princ)
)
((and 
(or (equal (+ huong_13_xoy pi) huong_ac_xoy 1e-5) (equal (- huong_13_xoy pi) huong_ac_xoy 1e-5))
(or (equal (+ huong_13_yoz pi) huong_ac_yoz 1e-5) (equal (- huong_13_yoz pi) huong_ac_yoz 1e-5))
(or (equal (+ huong_13_xoz pi) huong_ac_xoz 1e-5) (equal (- huong_13_xoz pi) huong_ac_xoz 1e-5))
)
(command "ucs" "za" base (mapcar '(lambda (x) (* 0.5 x)) (mapcar '+ (trans pt_phu2_w_3d 0 1) (trans (nth 4 lst_point_w) 0 1))))
(command "rotate" new "" (trans (nth 3 lst_point_w) 0 1) pi)
)
(t 
(command "ucs" "3p" base (trans (nth 5 lst_point_w) 0 1) (trans truc_w 0 1))
(command "rotate" new ""
(setq base (trans (nth 3 lst_point_w) 0 1))
(* -1 (angle base (trans truc_w 0 1)))
)
)
)
)
;==================================================================
(t 
(cond
((and 
(equal huong_13_xoy huong_ac_xoy 1e-5) 
(equal huong_13_yoz huong_ac_yoz 1e-5)
(equal huong_13_xoz huong_ac_xoz 1e-5)
)
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 pt_phu_w (trans pt_phu 1 0))
(command "ucs" "za" pt_1 pt_3)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 4 lst_point_w) 0 1)) (angle base (trans pt_phu_w 0 1)))
)
)
((and 
(or (equal (+ huong_13_xoy pi) huong_ac_xoy 1e-5) (equal (- huong_13_xoy pi) huong_ac_xoy 1e-5))
(or (equal (+ huong_13_yoz pi) huong_ac_yoz 1e-5) (equal (- huong_13_yoz pi) huong_ac_yoz 1e-5))
(or (equal (+ huong_13_xoz pi) huong_ac_xoz 1e-5) (equal (- huong_13_xoz pi) huong_ac_xoz 1e-5))
)
(setq truc (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 truc_w (trans truc 1 0))
(setq anh (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 anh_w (trans anh 1 0))
(command "ucs" "za" pt_1 truc)
(command "rotate" new "" (setq base (trans (nth 3 lst_point_w) 0 1)) pi)
(command "ucs" "3p" base (trans (nth 4 lst_point_w) 0 1) (trans truc_w 0 1))
(command "rotate" new ""
(setq base (trans (nth 3 lst_point_w) 0 1))
(* -1 (angle base (trans truc_w 0 1)))
)
)
(t
(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
 pt_phu_w (trans pt_phu 1 0)
 pt_phu2 (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
 pt_phu2_w (trans pt_phu2 1 0))
(command "ucs" "3p" pt_1 pt_2 pt_phu)
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1)) 
(setq ang (* -1 (angle base (trans pt_phu_w 0 1))))
)
(setq pt_phu_2d 
(polar 
base 
(+ ang (angle base (setq anh_c (trans pt_phu2_w 0 1)))) 
(distance (list (car base) (cadr base)) (list (car anh_c) (cadr anh_c))))
 pt_phu_3d (list (car pt_phu_2d) (cadr pt_phu_2d) (last anh_c))
 pt_phu_w_3d (trans pt_phu_3d 1 0))
(command "ucs" "za" (trans (nth 3  lst_point_w) 0 1) (trans (nth 4  lst_point_w) 0 1))
(command "rotate" new "" 
(setq base (trans (nth 3 lst_point_w) 0 1))
(- (angle base (trans (nth 5 lst_point_w) 0 1)) (angle base (trans pt_phu_w_3d 0 1)))
)
)
)
)
)
(command "ucs" "na" "r" "save_ucs")
(command "ucs" "na" "d" "save_ucs")
(mapcar 'setvar lst_va old)
(princ)
)

;Lisp thong ke ong; cut trong he thong duong ong
(defun c:TKO( / lst_va old sam D ss lst tong L)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(17 0))
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
 
(setq sam (assoc 8 (entget (car (entsel "\nChon ong mau: "))))
      lst_fi_tcduc '((12 . "DN10") (18 . "DN15") (22 . "DN20") (28 . "DN25") (35 . "DN32") (40 . "DN40")
    (52 . "DN50") (70 . "DN65") (85 . "DN80") (104 . "DN100") (129 . "DN125")
    (154 . "DN150") (204 . "DN200") (254 . "DN250"))
      D (caar (vl-remove-if-not '(lambda (x) (vl-string-search (cdr x) (cdr sam))) lst_fi_tcduc))
)
(prompt "\Chon cac ong can thong ke chieu dai: ")
(setq ss (ssget "X" (list '(0 . "3DSOLID") sam))
      lst (ss2lst ss)
      tong 0)
(foreach elem lst
(command ".area" "o" elem)
(setq S (getvar 'area)
     L (/ (- S (* 2 pi 0.25 D D)) (* pi D))
     tong (+ L tong))
) ;for
;;;(command "group" "c" (strcat "Ong_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_ong" ss "")
(command "union" ss "")
(princ (strcat "\nTong chieu dai " (cdr sam) " la: " (rtos tong 2 3) " (don vi ve)"))
(mapcar 'setvar lst_va old)
(princ)
)
;===================================================================
;Lisp thong ke cut
(defun c:TKC( / sam ss cmd)
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
(setq sam (assoc 8 (entget(car(entsel "\nChon cut mau: ")))))
(prompt "\Chon cac cut can thong ke so luong: ")
(setq ss (ssget "X" (list '(0 . "3DSOLID") sam)))
;;;(command "group" "c" (strcat "Cut_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_cut" ss "")
(command "union" ss "")
(princ (strcat "\nTong so " (cdr sam) " la: " (itoa (sslength ss)) " (cai)"))
(setvar 'cmdecho cmd)
(princ)
)
;===================================================================
(defun ss2lst (ss / ename i lst)
;chuyen ss thanh list
(setq i 0)
(repeat (sslength ss)
(setq ename (ssname ss i)
 i (1+ i)
 lst (cons ename lst))
)
(reverse lst)
)

Tháng 11 12, 2014

1.Về ve.lsp

Nói chung hiepttr đã tạo sẵn cái khung lsp rồi, tôi chỉ có thêm mắm muối cho xôm tụ thôi. Còn tại sao có dòng ĐK dài lê thê là vì khi mới thử lsp của hiepttr, vì là dân "ngoại đạo" với các loại ông nên nó cứ báo sai số liệu đòi nhập lại hoài, ghét quá mới thêm cái đó vào cho dễ chọn thội. Chứ chắc dận "nôi đạo" như haanh thì chẳng cần, nhắm mắt cũng biết ống fi mấy rồi.

2. Về tko_tkc

haanh thích union cũng chẳng có gì, chọn hết 1 loại ống trong bản vẽ rồi union nó lại.Dĩ nhiên khi đó thống kê trên toàn bộ bản vẽ chứ không phải 1 nhóm.

3. Cadviet dạo này cũng có ma rồi sao? :o :o

Mấy hôm rày bận việc quá , em không vào diễn đàn được.... Em cảm ơn bác Tot77 rất vô cùng nhiều vì bác đã viết lisp "CKC" bắn trúng yêu cầu của em! :) :) :)

Nếu ví việc vẽ đường ống trên AutoCAD giống như việc gặt lúa thì việc bác đã cho thêm gia vị mắm muối tương gừng ớt xả vào để Em_lisp của anh Hiệp trở thành máy gặt đập liên hợp chính là " niềm ao ước bấy lâu nay đã thỏa nỗi chờ mong" , bác Tot77 ạ!

Bác không phải lăn tăn gì về việc em đã viết:"VE.Lisp của bác rất hoành tráng khi hiện ra hình một dãy chữ số chỉ đường kính ống trên dòng Command hiền hòa và thơ mộng!" nhé. Vì các loại ống theo tiêu chuẩn Đức, Nhật Bản và Đài Loan có nhiều loại đường kính khác nhau, mà trí nhớ của con người có hạn....dành để nhớ nhiều cái đáng nhớ hơn là việc phải nhớ ống DN50 có đường kính là Ø bao nhiêu, bác ạ!

Em đang nghĩ cách diễn đạt rõ ràng và dễ hiểu để nhờ các bác viết giúp em ít nhất là hai Em_lip nữa, sao cho công hữu ích bị tổn thất không được vượt quá giới hạn ức chế cho phép ≤ [Ϭưche]

Đây là lisp vẽ đường ống, em mới sưu tầm được, gửi lên đây để bác nào rảnh sẽ tham khảo và tìm hiểu trước, em sẽ nhờ các bác sau:

;The contents of this file are subject to the Mozilla Public License
;Version 1.1 (the "License"); you may not use this file except in compliance
;with the License. You may obtain a copy of the License at
;http://www.mozilla.org/MPL/
;
;Software distributed under the License is distributed on an "AS IS" basis,
;WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
;the specific language governing rights and limitations under the License.
;
;The Original Code is: igneus.lsp
;This file is Copyright (c) 2006 Igneus Incorporated

;------------------------------------------------------------------------------
; The Igneus Incorporated Cad Utilities Collection
;
; History:
;     0.7.0 : April 24, 2006
;           : Initial public release
;
;     0.7.1 : October 12, 2006
;           : Metric support
;
; Commands added to CAD program
; -----------------------------
;
;           fpOptions       : set options for other commands
;           Pipedim         : draws size and length text for a line(s)
;           PipeLine        : A 'line' command with pipe dimensioning
;           TrimHeads       : Trim lines to edge of heads - don't use before
;                             ExportSHC.
;           ExportSHC       : produces a TSHC readable file from cad drawing
;           ImportSHC       : inputs a previously exported file and changes
;                           : pipe sizes accordingly
;
;------------------------------------------------------------------------------

;;;
;;;  FpOptions
;;;
;;;  Description
;;;  -----------
;;;  Sets options used by cad utilities collections and saves to
;;;  file.
;;;

(defun c:fpoptions( / s)
  ; Call initialization function
  (igneus_init)
  ; get tolerance
  (if (<= 0 (setq s (getreal (strcat "\nSet endpoint tolerance <" (rtos igneus_tolerance) ">:")))) (setq igneus_tolerance s))
  ; get branchline layer
  (setq igneus_BranchLayer (igneus_getLayName (strcat "Branchline piping layer <" igneus_BranchLayer ">:") igneus_BranchLayer))
  ; get main piping layer
  (setq igneus_MainLayer (igneus_getLayName (strcat "Main piping layer <" igneus_MainLayer ">:") igneus_MainLayer))
  ; get sprinkler head layer
  (setq igneus_HeadLayer (igneus_getLayName (strcat "Sprinkler head layer <" igneus_HeadLayer ">:") igneus_HeadLayer))
  ; get pipe dimensioning layer
  (setq igneus_PipeDimLayer (igneus_getLayName (strcat "Pipe dimensioning layer <" igneus_PipeDimLayer ">:") igneus_PipeDimLayer))
  ; get node label layer
  (setq igneus_NodeDimLayer (igneus_getLayName (strcat "Node labeling layer <" igneus_NodeDimLayer ">:") igneus_NodeDimLayer))
  ; select drawing units
  (setq igneus_BaseUnit (igneus_getintD (strcat "\nA length of 1.0 in the drawing is a - 1)Inch  2)Foot  3)Millimeter  4)Meter  <" (itoa igneus_baseUnit) ">:") igneus_baseUnit))
  ; Foot or inch base unit always results in Foot-Inch pipe length dimensioning
  (if (< igneus_BaseUnit 3)
    (progn
      ; get additional information for foot-inch dimensioning
      (setq igneus_LengthDimUnit 1)
      ; get 1/4 characters
      (setq igneus_oneQuarter (igneus_getstringD (strcat "Enter characters to use for '1/4' <" igneus_oneQuarter ">:") igneus_oneQuarter T))
      ; get 1/2 characters
      (setq igneus_oneHalf (igneus_getstringD (strcat "Enter characters to use for '1/2' <" igneus_oneHalf ">:") igneus_oneHalf T))
      ; get 3/4 characters
      (setq igneus_threeQuarter (igneus_getstringD (strcat "Enter characters to use for '3/4' <" igneus_threeQuarter ">:") igneus_threeQuarter T))
      ; get foot inch seperator
      (setq igneus_footchar (igneus_getstringD (strcat "Enter foot inch seperator character <" igneus_footchar ">:") igneus_footchar nil))
    )
    (progn
      ; select metric unit for length dimensioning
      (if (= 1 igneus_LengthDimUnit) (setq igneus_LengthDimUnit 2))
      (setq igneus_LengthDimUnit (igneus_getintD (strcat "\nDimension pipe lengths as - 2)Millimeter  3)Meter <" (itoa igneus_LengthDimUnit) ">:") igneus_LengthDimUnit))
    )
  )
  ; write options to "igneus.ini"
  (setq s (open "igneus.cfg" "w"))
  (write-line ";;; Igneus Cad Utilities configuration file" s)
  (write-line (strcat "(setq igneus_tolerance " (rtos igneus_tolerance 2 2) ")") s)
  (write-line (strcat "(setq igneus_BranchLayer \"" igneus_BranchLayer "\")") s)
  (write-line (strcat "(setq igneus_MainLayer \"" igneus_MainLayer "\")") s)
  (write-line (strcat "(setq igneus_HeadLayer \"" igneus_HeadLayer "\")") s)
  (write-line (strcat "(setq igneus_PipeDimLayer \"" igneus_PipeDimLayer "\")") s)
  (write-line (strcat "(setq igneus_NodeDimLayer \"" igneus_NodeDimLayer "\")") s)
  (write-line (strcat "(setq igneus_oneQuarter \"" igneus_oneQuarter "\")") s)
  (write-line (strcat "(setq igneus_oneHalf \"" igneus_oneHalf "\")") s)
  (write-line (strcat "(setq igneus_threeQuarter \"" igneus_threeQuarter "\")") s)
  (write-line (strcat "(setq igneus_footchar \"" igneus_footchar "\")") s)
  (write-line (strcat "(setq igneus_curPipeSize " (rtos igneus_curPipeSize 2 2) ")") s)
  (write-line (strcat "(setq igneus_BaseUnit " (itoa igneus_baseUnit) ")") s)
  (write-line (strcat "(setq igneus_LengthDimUnit " (itoa igneus_LengthDimUnit) ")") s)
  (close s)
  (igneus_end)
)

;;;
;;; PipeLine
;;;
;;; Description
;;; -----------
;;; Behaves as a LINE command but places lines in the branch line piping layer
;;; and dimensions each line using the chosen pipe size
;;;

(defun c:pipeline( / pt lastPt )
  ; Initialize
  (igneus_init)
  ; get pipe size
  (if (setq s (getreal (strcat "\nEnter pipe size <" (rtos igneus_curPipeSize 2 2) ">:")))
    (setq igneus_curPipeSize s))
  ; get starting point
  (if (setq lastPt (getpoint "\nSelect starting point of pipe:"))
    (while (setq pt (getpoint lastPt "\nselect end of pipe piece:"))
      (progn
        (if  (entmake (list (cons 0 '"LINE") (cons 8 igneus_branchLayer) (append '(10) lastPt) (append '(11) pt)))
          (pipedim_entity (entlast) igneus_curPipeSize igneus_footChar))
        (setq lastPt pt))))
  (igneus_end)
)

;;;
;;;  PipeDim
;;;
;;;  Description
;;;  -----------
;;;  PIPEDIM creates length and size dimension text for each pipe selected.
;;;

(defun c:pipedim( / pipedim_ss j)
  ; Call initialization function
  (igneus_init)
  ; get pipe size to use
  (if (null igneus_curPipeSize) (setq igneus_curPipeSize 1.0))
  (setq j igneus_curPipeSize)
  (if (null (setq igneus_curPipeSize (getReal (strcat '"Enter pipe size <" (rtos igneus_curPipeSize 2 2) '">:"))))
    (setq igneus_curPipeSize j))
  ; Let the use select the pipe to dimension
  (princ "\nSelect pipe to dimension")
  (setq pipedim_ss (ssget))

  ;;; Dimension each line in the selection set
  (setq j 0)
  (while (< j (ssLength pipedim_ss))
    (if (= '"LINE" (cdr (assoc 0 (entget (ssname pipedim_ss j)))))
      (pipedim_entity (ssname pipedim_ss j) igneus_curPipeSize igneus_footchar))
    (setq j (+ j 1)) )
  (igneus_end)
)

;;;
;;;  TrimHeads
;;;
;;;  Description
;;;  -----------
;;;  Trims all pipe in the branchline and main layers against all
;;;  blocks in the sprinkler head layer.  This is not a true trim
;;; but sets endpoints of lines within the tolerance value to a
;;; block to the radius distance away from the center of the block
;;;

(defun c:TrimHeads( / tolerance trimRadius ssHeads ssPipe iHead iPipe eHead ePipe newX newY)
  ; Call initialization function
  (igneus_init)
  ; get sprinkler head block names
  (if (= "" (setq bNames (getstring "\nEnter sprinkler head block name(s) to trim against:"))) (quit))
  ; get trimming radius
  (while (= nil (setq trimRadius (getReal "\nEnter trimming radius:"))))
  ; create sprinkler head selection set
  (if (= nil (setq ssHeads (ssget "X" (list (cons 0 "INSERT") (cons 2 bNames)))))
    (progn
      (princ "\nNo sprinkler head blocks found.")
      (quit)))
  ; creat pipe selection set
  (if (= nil (setq ssPipe (ssget "X" (list (cons 0 "LINE") (cons 8 (strcat igneus_mainLayer "," igneus_branchLayer))))))
    (progn
      (princ (strcat "\nNo pipe found in layers " igneus_mainLayer " or " igneus_branchLayer))
      (quit)))
  ; cycle through each pipe with each head and trim if necessary
  (setq iHead 0)
  (while (< iHead (ssLength ssHeads))
    (setq eHead (entget (ssName ssHeads iHead)))
    (setq iPipe 0)
    (while (< iPipe (ssLength ssPipe))
      (setq ePipe (entget (ssName ssPipe iPipe)))
      ; check for line start point within head radius
      (if (>= igneus_tolerance (distance (cdr (assoc 10 ePipe)) (cdr (assoc 10 eHead))))
        (progn
          ; trim the line from start point
          (setq pAngle (angle (cdr (assoc 10 eHead)) (cdr (assoc 11 ePipe))))
          (setq newX (+ (cadr (assoc 10 eHead)) (* trimRadius (cos pAngle))))
          (setq newY (+ (caddr (assoc 10 eHead)) (* trimRadius (sin pAngle))))
          ; modify the line
          (entmod (subst (list 10 newX newY (last (assoc 10 ePipe))) (assoc 10 ePipe) ePipe))))
      ; check for line end point within head radius
      (if (>= igneus_tolerance (distance (cdr (assoc 11 ePipe)) (cdr (assoc 10 eHead))))
        (progn
          ; trim the line from end point
          (setq pAngle (angle (cdr (assoc 10 eHead)) (cdr (assoc 10 ePipe))))
          (setq newX (+ (cadr (assoc 10 eHead)) (* trimRadius (cos pAngle))))
          (setq newY (+ (caddr (assoc 10 eHead)) (* trimRadius (sin pAngle))))
          ; modify the line
          (entmod (subst (list 11 newX newY (last (assoc 11 ePipe))) (assoc 11 ePipe) ePipe))))
      (setq iPipe (1+ iPipe)))
    (setq iHead (1+ iHead)))
  (igneus_end)
)
 
;;;
;;;  ExportSHC
;;;
;;;  Description
;;;  -----------
;;;  Exports user selected pipe and flowing heads as a compatible
;;;  file for 'The Simple Hydraulic Calculator' computer program.
;;;
;;;  Limitations
;;;  -----------
;;;  This command does not attempt to place fitting codes in the resulting
;;;  file.  Nor does this command set pipe types or define a water source
;;;  In other words - the file will nead some editing in TSHC before it will
;;;  calc.  Still - it's a good time saver.
;;;

(defun c:exportSHC( / igneus_tolerance head_ss pipe_ss pipe_list node_list label_list command_list used_list head_count head_list fName j k x y newCommand)
  (igneus_init)        ; Call initialization function
  (princ '"\nSelect pipe to export")
  (if (null (setq pipe_ss (ssget))) (progn
                                      (*error* '"No pipe was selected")
                                      (quit)))                                    
  ; get flowing heads (nil set is acceptable)
  (princ '"\nSelect flowing sprinkler heads")
  (setq head_ss (ssget))

  (setq node_list nil)
  (setq head_k -1)
  (setq head_q -1)

  ; cycle through all pipe selected
  ; for each line, add endpoints to node_list unless the endpoint already exists
  (setq j 0)
  (while (< j (sslength pipe_ss))
    (progn
      ; get entity data
      (setq k (entget (ssname pipe_ss j)))
      (setq j (+ 1 j))
      ; if its a line, add point to node_list (closer points first, farther second)
      (if (= '"LINE" (cdr (assoc 0 k)))
        (progn
          (if (> (distance '(0 0 0) (cdr (assoc 10 k))) (distance '(0 0 0) (cdr (assoc 11 k))))
            (setq x (cdr (assoc 11 k)) y (cdr (assoc 10 k)))
            (setq x (cdr (assoc 10 k)) y (cdr (assoc 11 k))))
          (if (null (member x node_list))
            (setq node_list (append node_list (list x))))
          (if (null (member y node_list))
            (setq node_list (append node_list (list y))))
  ))))
  ; search head selection set for sprinkler heads
  (setq head_count 0)
  (if (/= head_ss nil)
    (progn
      ; get minimum discharge and k-factor
      (while (<= head_k 0)
        (if (null (setq head_k (getreal '"Enter k-factor for sprinkler heads <5.6>:")))   ;;; change to 80.6 metric users
          (setq head_k 5.6)))
      (while (<= head_q 0)
        (if (null (setq head_q (getreal '"Enter minimum flow reaquired for a head <14.82>:"))) ;;; change to 57.0 metric users
          (setq head_q 14.82)))
      ;  Now add head points to node list
      (setq j 0)
      (while (< j (sslength head_ss))
        (progn
          ; get the entity data
          (setq k (entget (ssname head_ss j)))
          ; if its a block, add its point to the list
          (if (= '"INSERT" (cdr (assoc 0 k)))
            (progn
              (setq node_list (append node_list (list (cdr (assoc 10 k)))))
              (setq head_count (1+ head_count)) ))
          ; increment j
          (setq j (+ 1 j))
  ))))
  ; Now make a label list for the nodes
  ; Start numbering at 100
  (setq next_label '101)
  (setq label_list (list '100))
  (setq j 1)
  (while (< j (length node_list))
    (progn
      ; compare current point with previous points
      (setq k 0)
      (while (< k j)
        (if (< igneus_tolerance (abs (distance (nth k node_list) (nth j node_list))))
          ;then
          (setq k (1+ k))
          ;else
          (progn
            ; points fall within tolerance so represent same node
            (setq label_list (append label_list (list (nth k label_list))))
            (setq k j)
      )))
      ;; if label list is too short then a duplicate was not found - add next label to list
      (if (= j (length label_list))
        (progn
          (setq label_list (append label_list (list next_label)))
          (setq next_label (1+ next_label))
      ))
      (setq j (1+ j))
  ))

  ; create a head label list so we know when we need a head command instead of node
  (setq head_list nil)
  (setq j (- (length label_list) head_count))
  (while (< j (length label_list))
    (progn
      (setq head_list (append head_list (list (nth j label_list))))
      (setq j (1+ j)) ))

  ; make a TSHC version 1.2 file header
  (setq command_list (list '"<TSHC 1 2>" '"<BODY>" '"// Pipe generated by exportshc command" '""))
  ; Now we can make pipe commands!
  (setq command_list (append command_list (list '"Use s40 120")))
  (setq next_label 100)
  (setq j 0)
  (while (< j (sslength pipe_ss))
    (progn
      ; get entity data
      (setq k (entget (ssname pipe_ss j)))
      ; if its a line, add pipe command to command list
      (if (= '"LINE" (cdr (assoc 0 k)))
        (progn
          ; get pipe size and length from dimension text if it exists
          (setq y (igneus_getPipeSizeLength (ssname pipe_ss j)))
          (setq x (car y))
          (if (= nil x)
            (if (= 1 igneus_LengthDimUnit) (setq x "1.00") (setq x "25")))
          (setq y (cadr y))
          (if (= nil y)
            (progn            
              (setq y (igneus_rtos (distance (cdr (assoc 10 k)) (cdr (assoc 11 k))) '"'"))
              ; convert fraction characters to decimals for TSHC
              (setq y (igneus_subststr ".25" igneus_onequarter y))
              (setq y (igneus_subststr ".5" igneus_onehalf y))
              (setq y (igneus_subststr ".75" igneus_threequarter y))
              ; convert mm length to m for TSHC
              (if (= 2 igneus_lengthDimUnit) (setq y (rtos (/ (atof y) 1000.0) 2 3)))))
          (setq newCommand
            (strcat '"Pipe "
                      (itoa next_label)     ; pipe name
                    '" "                ; start node
                    (itoa (nth (- (length node_list) (length (member (cdr (assoc 10 k)) node_list))) label_list))
                    '" "                ; end node
                    (itoa (nth (- (length node_list) (length (member (cdr (assoc 11 k)) node_list))) label_list))
                    '" " y))            ; length
          ; extra spaces        
          (while (> 26 (strlen newCommand)) (setq newCommand (strcat newCommand " ")))
          ; pipe size
          (setq newCommand (strcat newCommand '" " x '" "))
          ; extra spaces
          (while (> 45 (strlen newCommand)) (setq newCommand (strcat newCommand " ")))
          ; entity name in comment
          (setq newCommand (strcat newCommand "// $" (cdr (assoc 5 k))))
          (setq command_list (append command_list (list newCommand)))
          (setq next_label (1+ next_label))))
      (setq j (+ 1 j))

  ))
  ;  Now for the node commands
  (setq command_list (append command_list (list '"" '"// Nodes generated by exportshc command" '"")))
  (setq j 0)
  (setq used_list nil)
  (while (< j (length node_list))
    (progn
      (if (not (member (nth j label_list) used_list))
        (progn
          ; First label node in drawing
          (entmake (list
                     (cons 0 '"TEXT")
                     (cons 1 (strcat '"<" (itoa (nth j label_list)) '">"))
                     (cons 7 (getvar "TEXTSTYLE"))
                     (cons 8 igneus_nodeDimLayer) ;(getvar "CLAYER"))
                     (list 10 (car (nth j node_list))
                              (cadr (nth j node_list))
                              (caddr (nth j node_list)))
                     (list 11 (car (nth j node_list))
                              (cadr (nth j node_list))
                              (caddr (nth j node_list)))
                     (cons 40 (* (getvar "DIMSCALE") (getvar "DIMTXT")))
                     (cons 41 0.75)
                     (cons 50 0.0)
                     (cons 72 4)))
          ; now the command
          (setq used_list (append used_list (list (nth j label_list))))
          (if (member (nth j label_list) head_list)
              ; make a head command
            (setq command_list (append command_list (list (strcat '"Head "
                                                                  (itoa (nth j label_list)) '" "
                                                                  (igneus_rtos (caddr (nth j node_list)) '"'") '" "
                                                                  (rtos head_q 2 2) '" "
                                                                  (rtos head_k 2 2)))))
            ; make a node command
            (setq command_list (append command_list (list (strcat '"Node "
                                                                  (itoa (nth j label_list)) '" "
                                                                  (igneus_rtos (caddr (nth j node_list)) '"'")))))
      )))
      (setq j (1+ j))
  ))
  ; Get the filename
  (setq fName '"")
  (while (= fName '"") (setq fName (getfiled "Save As ..." "export.shc" "SHC" 1)))
  ; Open the file and write it
  (setq k (open fName "w"))
  (setq j 0)
  (while (< j (length command_list))
    (progn
      (write-line (nth j command_list) k)
      (setq j (1+ j))))
  (setq k (close k))
  (igneus_end)
)

;;;
;;; ImportSHC
;;;
;;; Reads a previously exported .shc file and dims the
;;; pipe in the drawing according to the size values in
;;; the .shc file.
;;;

(defun c:importSHC( / fName s comList )
  (igneus_init)
  ; Get the filename
  (setq fName '"")
  (setq s '"")
  (if (setq fName (getfiled "Import file ..." "" "SHC" 2))
  ; Open the file and read it
    (if (setq k (open fName "r"))
      (progn
        ; get to command section of file : <BODY> tag
        (while (and (/= nil s) (/= s "<BODY>")) (setq s (read-line k)))
        ; read until eof
        (while (/= nil s)
          (progn
            ; check for Pipe command
            (setq comList nil)
            (if (setq s (read-line k))            
              (setq comList (igneus_strToTokens s)))
            (if (/= nil comList)
              (if (= (strcase (car comList)) "PIPE")
                (progn
                      ; found a pipe, get size
                  (setq pSize (atof (nth 5 comList)))
                  ; entity handle should be last token
                  (setq hPipe (car (reverse comList)))
                  ; if first char is not $ then this is not a linked pipe
                  (if (= (substr hPipe 1 1) "$")
                    (progn
                      (setq hPipe (substr hPipe 2 20))
                      ;get pipe entity
                      (if (setq pList (handent hPipe))
                        (progn
                          (setq pList (entget pList '("IGNEUSINCUTILS")))
                           ; retrieve size handle from extended data
                          (setq hSize (cdr (assoc 1005 (cdr (assoc "IGNEUSINCUTILS" (cdr (assoc -3 pList)))))))
                          ; retrieve size text entity list
                          (if (/= hSize nil) (setq sList (entget (handent hSize))) (setq sList nil))
                          (if (and (/= hSize nil) (/= sList nil))
                            ; modify existing text
                            (entmod (subst (cons 1 (igneus_rtos pSize nil)) (assoc 1 sList) sList))
                            ; no existing text, dim this pipe
                            (pipedim_entity (handent hPipe) pSize "-"))))))))))))))
  (igneus_end)
)

;;;
;;; Utility Functions used by commands.
;;; These should not be called directly.
;;;

;;; Error handler
(defun igneus_error (s)
  (princ (strcat "\nError: " s))
  (igneus_end)
)

;;; Initialization function for Igneus Inc. Utilities
(defun igneus_init ()
  ; Set new error handler
  (setq olderr *error*
        *error* igneus_error)
  ; Save system variables
  (setq curLayer (getvar "CLAYER"))
  (setq curBlip (getvar "BLIPMODE"))
  (setq curGrid (getvar "GRIDMODE"))
  (setq curHL (getvar "HIGHLIGHT"))
  (setq curCMD (getvar "CMDECHO"))
  ; Set system variables
  (setvar "CMDECHO" 0)
  (setvar "GRIDMODE" 0)
  (setvar "HIGHLIGHT" 1)
  ; Set beginning of an UNDO group
  (command "._UNDO" "_GROUP")
)

;;; Uninitialization function for Igneus Inc. Utilities
(defun igneus_end()
  ; Restore system variables
  (setvar "CLAYER" curLayer)
  (setvar "BLIPMODE" curBlip)
  (setvar "GRIDMODE" curGrid)
  (setvar "HIGHLIGHT" curHL)
  (command "._UNDO" "_E")
  (setvar "CMDECHO" curCMD)
  ; Restore original error handler
  (setq *error* olderr)
  (princ)
)

;;; This function takes a real number in igneus_baseunit units and converts
;;; it to a string formatted in accordance with igneus_lengthdimunit value.
;;;
;;; formatted as: "<feet>'<inches>"
;;; The real number is treated as inches. And is rounded
;;; to the nearest quarter
(defun igneus_rtos(rlength footchar / rlength feet inches fraction fraction_string)
  (cond
    ;;; metric units always use mm pipe sizes - footchar is the flag
    ( (and (> igneus_lengthDimUnit 1) (= nil footchar)) (rtos rlength 2 0))
    ;;; meter
    ( (= igneus_lengthDimUnit 3)
      (progn
        ; Convert base unit to meters
        (cond ((= igneus_baseunit 1) (setq rlength (* rlength 0.0254)))
              ((= igneus_baseunit 2) (setq rlength (* rlength 0.3048)))
              ((= igneus_baseunit 3) (setq rlength (* rlength 0.001))))
        (rtos rlength 2 3))) ; 3 decimal places for m
    ;;; millimeter
    ( (= igneus_lengthDimUnit 2)
      (progn
        ; Convert base unit to millimeters
        (cond ((= igneus_baseunit 1) (setq rlength (* rlength 25.4)))
              ((= igneus_baseunit 2) (setq rlength (* rlength 304.8)))
              ((= igneus_baseunit 4) (setq rlength (* rlength 1000))))
        (rtos rlength 2 0)))  ; no decimal places for mm
    ;;; Foot-inch format
    ( (= igneus_lengthDimUnit 1)
      (progn
        ; Convert base unit to inches (for lengths)
        (if (/= nil footchar)
          (cond ((= igneus_baseunit 2) (setq rlength (* rlength 12)))
                ((= igneus_baseunit 3) (setq rlength (* rlength 0.039372)))
                ((= igneus_baseunit 4) (setq rlength (* rlength 39.372))))
        )
        (if (null footchar)
          (progn
            (setq feet 0)
            (setq inches (fix rLength))
           )
           (progn
             (setq feet (fix (/ rlength 12.0)))
             (setq inches (fix (- rlength (* feet 12))))
           )
        )
        (setq fraction (- rlength (fix rlength)))
        ; Round inches to nearest quarter (with 3/8 going to 1/2 and 7/8 going to 1)
        (setq fraction_string '"")
        (if (> fraction 0.126) (setq fraction_string igneus_onequarter))
        (if (> fraction 0.374) (setq fraction_string igneus_onehalf))
        (if (> fraction 0.626) (setq fraction_string igneus_threequarter))
        (if (> fraction 0.874) (progn
                                 (setq inches (+ inches 1))
                                 (setq fraction_string '"") ))
        (if (= inches 12)
            (progn
              (setq inches 0)
              (setq feet (+ feet 1)) ))
        ; Put feet & inches together
        (if (and (= feet 0) (null footchar))
          (strcat (itoa inches) fraction_string)
          (strcat (itoa feet) footchar (itoa inches) fraction_string)))))
)

;;;
;;; igneus_GetTextLinkHandle
;;;
;;; given a handle to text, returns handle
;;; from extended data of text intenty to line
;;;
(defun igneus_GetTextLinkHandle (hText) ; / nText
  (if (/= nil hText) (setq nText (handent hText)) (setq nText nil))
  (if (/= nil nText)
    (cdr (cadr (cadr (assoc -3 (entget nText '("IGNEUSINCUTILS"))))))))
 

;;;
;;;  Dimensioning Function ver 0.9
;;;
;;;  History
;;;  -------
;;;
;;;  Use:
;;;  ----
;;;  name: name of line entity to be dimensioned
;;;  pipesize: pipe size label text
;;;  footchar will be inserted between feet and inches on lengths
;;;  Draws text in current style on current layer
;;;

(defun pipedim_entity(eName pipeSize footchar );/
;                              pEnt          pStart     pEnd      hSize    hLength
;                              pAngle        pMid       sEntName  tempList
;                              pipedim_text  sEntList )

  ; Setup a TEXT Record
  (setq pipedim_text
    (list
      (cons  0 '"TEXT")                                     ; entity type
      ;(cons  8 (getvar "CLAYER"))                           ; layer (uses current layer)
      (cons 8 igneus_pipeDimLayer)
      (list 10 0.0 0.0 0.0)                                 ; Midpoint
      (list 11 0.0 0.0 0.0)                                 ; Midpoint
      (cons 40 (* (getvar "DIMSCALE") (getvar "DIMTXT")))   ; Height
      (cons  1 '"")                                         ; text value
      (cons 50 0.0)                                         ; text angle
      (cons 41 0.750)                                       ; Width factor
      (cons  7 (getvar "TEXTSTYLE"))                        ; text style
      (cons 72 4)                                           ; Textmode - midpoint
      (cons -3 0)
    )
  )

  (setq pEnt (entget eName '("IGNEUSINCUTILS")))
  (if (= 'LINE' (cdr (assoc 0 pEnt))) (progn
                                        (*error* '"Pipedim_entity not a line")
                                        (quit)))
  (setq pstart (cdr (assoc 10 pEnt)))
  (setq pend (cdr (assoc 11 pEnt)))
  ; Compute plan view angle of line (x and y coordinates only)
  (setq pangle (angle (reverse (cdr (reverse pstart))) (reverse (cdr (reverse pend)))))
  ; make sure angle isn't upside down
  (if (and (> pangle (/ pi 2)) (<= pangle (* 1.5 pi))) (setq pangle (- pangle pi)))
  ; Find the center point of the pipe
  (setq pmid (mapcar '/ (mapcar '+ pStart pEnd) '(2 2 2)))
  ; Create length string
  (setq pLength (distance pStart pEnd))
  ;(if (and (< pLength 11.875) (= igneus_LengthDimUnit 1) (/= nil footChar))
  ;  (setq pLength (strcat '"0" footchar (igneus_rtos pLength footchar)))
  ;  (setq pLength (igneus_rtos pLength footchar))
  ;)
  (setq pLength (igneus_rtos pLength footchar))
  ; get size and length text handles
  (setq hSize (cdr (assoc 1005 (cdr (assoc "IGNEUSINCUTILS" (cdr (assoc -3 pEnt)))))))
  (setq hLength (cdr (assoc 1005 (reverse (cdr (assoc "IGNEUSINCUTILS" (cdr (assoc -3 pEnt))))))))
  ; check for erased and improperly linked text entities (results from copying)
  (if (/= (cdr (assoc 5 pent)) (igneus_GetTextLinkHandle hSize)) (setq hSize nil))
  (if (/= (cdr (assoc 5 pent)) (igneus_GetTextLinkHandle hLength)) (setq hLength nil))
  ; See if there is an existing length text to modify
  (if (/= nil hLength)
    (progn
      ; There is a handle to a length entity - retrieve entity
      (setq sEntName (handent hLength))
      (setq sEntList (entget sEntName '("IGNEUSINCUTILS")))
      ; If this is not text, then error
      (if (/= '"TEXT" (cdr (assoc 0 sEntList))) (progn
                                                  (*error* '"pipe owns nontext - cad app/util conflict with Igneus")
                                                  (quit)))
      ; modify text to new value
      (setq sEntList (subst (cons 1 pLength) (assoc 1 sEntList) sEntList))
      (entmod sEntList))
    (progn
      ; no existing text, so make new
      ; Compute center point for text
      (setq pTxtCtr (list
                      (+ (car pMid) (* (sin pAngle) (* (getvar "DIMSCALE") (getvar "DIMTXT"))))
                      (- (cadr pMid) (* (cos pAngle) (* (getvar "DIMSCALE") (getvar "DIMTXT"))))
                      (caddr pMid)))
      ; Create the text entity
      (setq pipedim_text (subst (cons 1 pLength) (assoc 1 pipedim_text) pipedim_text))
      (setq pipedim_text
        (subst (append '(10) pTxtCtr) (assoc 10 pipedim_text) pipedim_text))
      (setq pipedim_text
        (subst (append '(11) pTxtCtr) (assoc 11 pipedim_text) pipedim_text))
      (setq pipedim_text (subst (cons 50 pAngle) (assoc 50 pipedim_text) pipedim_text))
      ; link this text back to the pipe line entity
      (setq pipedim_text (subst (cons -3 (list (list "IGNEUSINCUTILS" (cons 1005 (cdr (assoc 5 pent))))))
                                (assoc -3 pipedim_text)
                                pipedim_text))
      ; make the text and retrieve it
      (setq sEntList (entget (entmakex pipedim_text) '("IGNEUSINCUTILS")))
      ; store handle to text for later
      (setq hLength (cdr (assoc 5 sEntList)))
    )
  )

  ; See if there is an existing size entity to modify
  (if (/= nil hSize)
    (progn
      ; There is a handle to a size entity - retrieve entity
      (setq sEntName (handent hSize))
      (setq sEntList (entget sEntName '("IGNEUSINCUTILS")))
      ; If this is not text, then error
      (if (/= '"TEXT" (cdr (assoc 0 sEntList))) (progn
                                                  (*error* '"pipe owns nontext - cad app/util conflict with Igneus Utils")
                                                  (quit)))
      ; modify text to new value
      (setq sEntList (subst (cons 1 (igneus_rtos pipeSize nil)) (assoc 1 sEntList) sEntList))
      ; set pointer to length text entity
      (entmod sEntList))
    (progn
      ; Compute center point for text
      (setq pTxtCtr (list
                      (- (car pMid) (* (sin pAngle) (* (getvar "DIMSCALE") (getvar "DIMTXT"))))
                      (+ (cadr pMid) (* (cos pAngle) (* (getvar "DIMSCALE") (getvar "DIMTXT"))))
                      (caddr pMid)))
      ;;; Create the text entity
      (setq pipedim_text
        (subst (cons 1 (igneus_rtos pipeSize nil)) (assoc 1 pipedim_text) pipedim_text))
      (setq pipedim_text
        (subst (append '(10) pTxtCtr) (assoc 10 pipedim_text) pipedim_text))
      (setq pipedim_text
        (subst (append '(11) pTxtCtr) (assoc 11 pipedim_text) pipedim_text))
      (setq pipedim_text (subst (cons 50 pAngle) (assoc 50 pipedim_text) pipedim_text))
      ; link this text back to the pipe line entity
      (setq pipedim_text (subst (cons -3 (list (list "IGNEUSINCUTILS" (cons 1005 (cdr (assoc 5 pent))))))
                                (assoc -3 pipedim_text)
                                pipedim_text))
      ; make the text and retrieve it
      (setq sEntList (entget (entmakex pipedim_text) '("IGNEUSINCUTILS")))
      ; store handle to text for later
      (setq hSize (cdr (assoc 5 sEntList)))
    )
  )
  ; Now store the handles for size and length text in line's extended data
  (if (setq tempList (cdr (assoc -3 pent)))
    ; line already has extended data
    (progn
      (if (assoc "IGNEUSINCUTILS" tempList)
        (setq tempList (subst (cons "IGNEUSINCUTILS" (list (cons 1005 hSize) (cons 1005 hLength)))
                              (assoc "IGNEUSINCUTILS" tempList)
                              tempList))
        (setq tempList (append tempList (list
                                          (cons "IGNEUSINCUTILS" (list
                                                                   (cons 1005 hSize)
                                                                   (cons 1005 hLength)))))))
      (setq pEnt (subst (cons -3 tempList) (assoc -3 pent) pent)))
    ; Line does not have extended data
    (progn
      (setq tempList (list (cons -3 (list (cons "IGNEUSINCUTILS" (list (cons 1005 hSize) (cons 1005 hLength)))))))
      (setq pEnt (append pEnt tempList))))
  ; modify the line entity
  (entmod pent)
)

;;;
;;; Seperates string into tokens and returns as list
;;;
(defun igneus_strToTokens(s );/ tokens charList i j)
  ; find tokens
  (setq tokens nil)
  (setq i 1)
  (setq j 0)
  (while (<= i (strlen s))
    (progn
      ; find start of token
      (while (and (<= i (strlen s)) (= (substr s i 1) " ")) (setq i (1+ i)))
      ; find end of token
      (setq j (1+ i))
      (while (and (<= j (strlen s)) (/= (substr s j 1) " ")) (setq j (1+ j)))
      (if (<= i (strlen s)) (setq tokens (append tokens (list (substr s i (- j i))))))
      (setq i (1+ j))))
  ; return list
  (setq tokens tokens)
)

(defun igneus_getStringD( p d flag / s)
  (if (= "" (setq s (getString flag p))) (setq s d))
  (setq s s))
 
(defun igneus_getintD( p d / s)
  (if (= nil (setq s (getint p))) (setq s d))
  (setq s s))

(defun igneus_getLayName( p d / s )
  (while (not (tblsearch "layer" (setq s (igneus_getstringD p d T)))))
  (setq s s)
)

;;;
;;; Sorts a list of reals/integers using the quick sort algorithm
;;;
(defun igneus_rqsort ( values / values lower_set upper_set dividor )
  ;;; If there is 1 or fewer elements in the list then just return it.  
  (if (< (length values) 2)
    values
    (progn
      ;;; User the average of the first & last values as the dividor value
      (setq dividor (/ (+ (car values) (last values)) 2.0))
      ;;; Initialize the lower & upper sets to the empty list
      (setq lower_set '())
      (setq upper_set '())
      ;;; Split the values into lower & upper ranges
      (while (> (length values) 0)
        (if (> (car values) dividor)
          (setq upper_set (append upper_set (list (car values))))
          (setq lower_set (append lower_set (list (car values)))))
        (setq values (cdr values)))
      ;;; If no split occured then first & last are equal and maximums
      ;;; Take one & put in upper_set so sorting may continue.
      (if (= 0 (length upper_set))
        (setq upper_set (list (car lower_set)) lower_set (cdr lower_set)))
      (append (igneus_rqsort lower_set) (igneus_rqsort upper_set)) ; tail recursion
    )
  )
)

;;;
;;; Sorts a list of lists of reals/integers by the indexed
;;; element in each sublist using the quick sort algorithm.
;;;
(defun igneus_rqsortn ( values index / values lower_set upper_set dividor )
  ;;; If there is 1 or fewer elements in the list then just return it.  
  (if (< (length values) 2)
    values
    (progn
      ;;; User the average of the first & last values as the dividor value
      (setq dividor (/ (+ (nth index (car values)) (nth index(last values))) 2.0))
      ;;; Initialize the lower & upper sets to the empty list
      (setq lower_set '())
      (setq upper_set '())
      ;;; Split the values into lower & upper ranges
      (while (> (length values) 0)
        (if (> (nth index (car values)) dividor)
          (setq upper_set (append upper_set (list (car values))))
          (setq lower_set (append lower_set (list (car values)))))
        (setq values (cdr values)))
      ;;; If no split occured then first & last are equal and maximums
      ;;; Take one & put in upper_set so sorting may continue.
      (if (= 0 (length upper_set))
        (setq upper_set (list (car lower_set)) lower_set (cdr lower_set)))
      (append (igneus_rqsortn lower_set index) (igneus_rqsortn upper_set index)) ; tail recursion
    )
  )
)

;;;
;;; substitutes new substring for old substring in string
;;;
(defun igneus_subststr(a b s / i j)
  (setq i 1)
  (while (<= i (1+ (- (strlen s) (strlen b))))
    (if (= b (substr s i (strlen b)))
      (setq s (strcat
                (substr s 1 (1- i))
                a
                (substr s (+ i (strlen b))))))
    (setq i (1+ i)))
  (setq s s)
)

;;;
;;; gets size and length text for a pipe if it already exists
;;;
(defun igneus_getPipeSizeLength(nPipe / nPipe lPipe hSize hLength sEntName sEntList)
  ; get pipe entity list
  (setq lPipe (entget nPipe '("IGNEUSINCUTILS")))
  ; get size and length text handles
  (setq hSize (cdr (assoc 1005 (cdr (assoc "IGNEUSINCUTILS" (cdr (assoc -3 lPipe)))))))
  (setq hLength (cdr (assoc 1005 (reverse (cdr (assoc "IGNEUSINCUTILS" (cdr (assoc -3 lPipe))))))))
  ; check for erased and improperly linked text entities (results from copying)
  (if (/= (cdr (assoc 5 lPipe)) (igneus_GetTextLinkHandle hSize)) (setq hSize nil))
  (if (/= (cdr (assoc 5 lPipe)) (igneus_GetTextLinkHandle hLength)) (setq hLength nil))
  ; Get length text if it exists
  (if (/= nil hLength)
    (progn
      ; There is a handle to a length entity - retrieve entity
      (setq sEntName (handent hLength))
      (setq sEntList (entget sEntName '("IGNEUSINCUTILS")))
      ; If this is not text, then error
      (if (/= '"TEXT" (cdr (assoc 0 sEntList))) (progn
                                                  (*error* '"pipe owns nontext - cad app/util conflict with Igneus")
                                                  (quit)))
      ; get text
      (setq hLength (cdr (assoc 1 sEntList)))
      ; substitue TSHC characters for user defined characters
      (setq hLength (igneus_subststr "'" igneus_footchar hLength))
      (setq hLength (igneus_subststr ".25" igneus_onequarter hLength))
      (setq hLength (igneus_subststr ".5" igneus_onehalf hLength))
      (setq hLength (igneus_subststr ".75" igneus_threequarter hLength))
      ; if display units are mm, convert to m for The Simple Hydraulic Calculator
      (if (= 2 igneus_lengthDimUnit) (setq hLength (rtos (/ (atof hLength) 1000.0) 2 3)))))

  ; get size text if it exists
  (if (/= nil hSize)
    (progn
      ; There is a handle to a size entity - retrieve entity
      (setq sEntName (handent hSize))
      (setq sEntList (entget sEntName '("IGNEUSINCUTILS")))
      ; If this is not text, then error
      (if (/= '"TEXT" (cdr (assoc 0 sEntList))) (progn
                                                  (*error* '"pipe owns nontext - cad app/util conflict with Igneus Utils")
                                                  (quit)))
      ; modify text to new value
      (setq hSize (cdr (assoc 1 sEntList)))
      ; substitue TSHC characters for user defined characters
      (setq hSize (igneus_subststr "'" igneus_footchar hSize))
      (setq hSize (igneus_subststr ".25" igneus_onequarter hSize))
      (setq hSize (igneus_subststr ".5" igneus_onehalf hSize))
      (setq hSize (igneus_subststr ".75" igneus_threequarter hSize))))      
  ; return list of size and length
  (list hSize hLength)
)

; default settings
(setq igneus_BranchLayer "0")
(setq igneus_MainLayer "0")
(setq igneus_HeadLayer "0")
(setq igneus_PipeDimLayer "0")
(setq igneus_NodeDimLayer "0")
(setq igneus_onequarter ".25")
(setq igneus_onehalf ".5")
(setq igneus_threequarter ".75")
(setq igneus_footchar "-")
(setq igneus_curPipeSize 1.0)    ; default pipe size of 1"
(setq igneus_tolerance 1.0)      ; default tolerance of 1"
(setq igneus_BaseUnit 1)         ; default to base unit of inch
(setq igneus_LengthDimUnit 1)    ; default to foot-inch length dimensioning

; load user settings if they exist
(load "igneus.cfg" "")

;;;---------------------------------------------------------------------------
(regapp "IGNEUSINCUTILS")
(princ "\nIgneus Inc Cad Utilities v0.7.1 Loaded. (c)2006\n")
(princ)

Tháng 11 14, 2014

Em vẫn lẻn vào lều quán của chị lúc đêm khuya thanh vắng, khi thấy mọi người đã ra về hết. Chị không nhìn thấy dấu chân của em ở dưới góc trái, sau mỗi bài viết của các tác giả sao???

CADViet chẳng bao giờ có ma như trong cuốn tiểu thuyết tâm lý xã hội MẢNH ĐẤT LẮM NGƯỜI NHIỀU MA của nhà văn Nguyễn Khắc Trường, ra đời năm 1990, chỉ có một con ma xó @cái Hoằn thôi, bác Tot77 ơi! :lol: :lol: :lol:

Bởi mọi người vào đây để học hỏi lẫn nhau, viết bài chia sẻ một cách chân thành và vô tư . Viết bài trao đổi về nghề nghiệp cũng là hình thức ôn lại kiến thức cũ bị lãng quên và rèn luyện kỹ năng làm việc để công việc ngày hôm nay tốt đẹp hơn ngày hôm qua, chứ không như những con người phải sống trên MẢNH ĐẤT LẮM NGƯỜI NHIỀU MA!

"Internet thật là kỳ diệu. Nó đã kết nối những con người xa lạ lại với nhau. Có thể em sẽ chẳng bao giờ biết hết được những con người vẫn ẩn sau màn hình máy vi tính kia: họ là ai, họ đang làm gì, họ như thế nào? Nhưng em biết rằng, họ vẫn luôn ở bên cạnh mình trên Cadviet". (Svba1608).

Nguồn:bài viết số #1: http://www.cadviet.c...-bo-va-chia-se/

Cảm ơn Hoằn đã dẫn nguồn bài viết khiến chị bùi ngùi xúc động đến nao lòng về những kỷ niệm êm dịu ngọt lành, từ một thời dĩ vãng xa xăm; khiến NHỮNG NGÀY XƯA THÂN ÁI... bỗng đột ngột trở về nghẹn ngào trong ký ức....về một thời đã qua và một thời đã xa.... :lol: :lol: :lol:

Chị thấy hơi buồn và tủi thân vì em đấy, Hoằn ạ!

Nếu em đã thử lisp của anh Hiepttr hay lisp của bác Tot77, sao em không có phản biện hay đề xuất ý kiến gì ???

Phải chăng vì một sự hiểu lầm nào đó về chị mà tính khí của em đã thay đổi???

Hoằn ơi Hoằn....!

Sao Hoằn của ngày hôm nay khác với Hoan2182 của ngày xưa nhỉ??????

Hoằn ơi Hoằn....!

Sao em Hoằn của chị, không còn là EM CỦA NGÀY HÔM QUA .... hả Hoằn (!?!?!?)

https://www.youtube.com/https://www.youtube.com/Sơn Tùng M TP - Em của ngày hôm qua - Bài hát yêu thích tháng 2/2014

Tháng 11 16, 2014

@ Hoằn: Chị vừa trích dẫn lại bài viết và xóa bài đã trích dẫn đi để nhường chỗ cho em viết bài.

Chị đã câu giờ, chưa muốn đưa ra nội dung cần viết lisp tiếp theo. Chị muốn nhờ em đề xuất nội dung viết lisp chèn phụ kiện (Tê thu, côn thu, bích nối, rắc-co….) vào đường ống 3D, như em đã từng đề xuất khi còn ở chủ đề Lisp thao tác trong 3D. Chị sẽ tổng hợp đề xuất của em vào ý kiến của chị để gửi bài mới vào ngày mai, không thể Trần Văn Trừ để anh Hiepttr phải gõ trống nữa rồi!

Nếu bác bác nào có đề xuất gì về nội dung cần viết lisp chèn phụ kiện đường ống, hãy viết bài chia sẻ.

Em xin được cảm ơn các bác đã bớt chút thời gian vào lều quán nhà em và thành thật xin lỗi các bác về việc em đã nói chuyện riêng với cái Hoằn trong giờ... “buôn chuyện” ! :) :) :)

Tháng 11 17, 2014

Cảm ơn Hoằn đã dẫn nguồn bài viết khiến chị bùi ngùi xúc động đến nao lòng về những kỷ niệm êm dịu ngọt lành, từ một thời dĩ vãng xa xăm; khiến NHỮNG NGÀY XƯA THÂN ÁI... bỗng đột ngột trở về nghẹn ngào trong ký ức....về một thời đã qua và một thời đã xa.... :lol: :lol: :lol:

Chị thấy hơi buồn và tủi thân vì em đấy, Hoằn ạ!

Nếu em đã thử lisp của anh Hiepttr hay lisp của bác Tot77, sao em không có phản biện hay đề xuất ý kiến gì ???

Phải chăng vì một sự hiểu lầm nào đó về chị mà tính khí của em đã thay đổi???

Hoằn ơi Hoằn....!

Sao Hoằn của ngày hôm nay khác với Hoan2182 của ngày xưa nhỉ??????

Hoằn ơi Hoằn....!

Sao em Hoằn của chị, không còn là EM CỦA NGÀY HÔM QUA .... hả Hoằn (!?!?!?)

https://www.youtube.com/https://www.youtube.com/Sơn Tùng M TP - Em của ngày hôm qua - Bài hát yêu thích tháng 2/2014

:lol: :lol: :lol:

@còng chị Hà:

Em không viết bài phản biện là do ...lỗi của bác Tot77! Bác ấy đã sửa lisp theo lời nhờ của chị nhanh quá, khiến em không thể ứng xử kịp, chị ạ!

Nội dung cần nhờ viết lisp đã có trong video và ảnh động minh họa của chị, nói hộ em rồi.

Thiện ý của em là không chơi kiểu viết bài kiểu nhắc lại ý của người khác hoặc từa tựa ý của người khác đã nói rồi, sẽ vừa tốn đất của diễn đàn vừa gây nhiễu loạn thông tin; làm mất thời gian và tiền bạc của người truy cập internet, mong chị hiểu và thông cảm!

Chị Hà ơi!

Em không là của hôm qua

Nhưng em vẫn là.............................................. em chị Hà Anh....

Đăng nhập

LISP VẼ ĐƯỜNG ỐNG 3D trên AutoCAD

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

haanh 1590

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

Doan Van Ha 3202

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

haanh 1590

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

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

gia_bach 1554

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

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

haanh 1590

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

Hoan1111 695

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

hiepttr 540

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

gia_bach 1554

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

hunghv63 0

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

hiepttr 540

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

gia_bach 1554

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

hiepttr 540

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

hiepttr 540

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

gia_bach 1554

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

Tot77 508

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

Tot77 508

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

haanh 1590

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

hiepttr 540