Đến nội dung


Hình ảnh

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


  • Please log in to reply
32 replies to this topic

#21 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 10 November 2014 - 09:44 AM

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

  • 3

#22 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2882 Bài viết
Điểm đánh giá: 1556 (rất tốt)

Đã gửi 12 November 2014 - 03:22 PM

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 © 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. ©2006\n")
(princ)
 

  • 0

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#23 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2882 Bài viết
Điểm đánh giá: 1556 (rất tốt)

Đã gửi 14 November 2014 - 03:46 PM

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


  • 0

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#24 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2882 Bài viết
Điểm đánh giá: 1556 (rất tốt)

Đã gửi 16 November 2014 - 08:44 AM


 

HA_zpse7oomhp8.gif

@ 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” ! :) :) :)


  • 0

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#25 Hoan1111

Hoan1111

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2587 Bài viết
Điểm đánh giá: 692 (tốt)

Đã gửi 17 November 2014 - 11:56 AM

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


  • 0

66 Câu Phật Học Cho Cuộc Sống : http://ngocchinh.com...-cho-cuoc-song/

Gió đưa cây cải về trời / Rau răm ở lại chịu lời đắng cay...

 

 


#26 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2882 Bài viết
Điểm đánh giá: 1556 (rất tốt)

Đã gửi 18 November 2014 - 05:05 PM

Trước khi nhờ các bác viết Em_Lisp CHÈN PHỤ KIỆN ĐƯỜNG ỐNG, em nhờ các bác thư giãn  với lisp vẽ tê thu cho các loại ống theo tiêu chuẩn Đức, có các đường kính ống theo DN:

 

11837_ha2.png

(Tê thu tự chế là loại tê phi tiêu chuẩn, giao tuyến giữa hai ống là đường cong R lượn chứ không phải là đường kẻ chỉ! Ống, cút và tê.... chỉ vẽ dạng mô phỏng lỗ đặc để giảm dung lượng cho file bản vẽ....dễ zom, pan, copy và move...)

File:   http://www.cadviet.c...11837_haanh.dwg

Cho trước 1 cái tê thu tự chế DN250_DN200, em muốn nhờ các bác viết lisp:

1 - Sau khi gõ lệnh lisp, thay đổi trị số của D lớn và d nhỏ sẽ ra được các loại tê thu có đường kính khác nhau theo tiêu chuẩn ống của Đức.

2 - Nếu phải mua các loại tê thu trên thị trường có chiều dài khác với tê thu tự chế, người dùng có thể tự sửa lại được dòng Code của Lisp công thức tính chiều dài  2d nhỏ và (D/2)+(d/4),  để ra được chiều dài mong muốn.

3 - Em không biết là viết lisp với số liệu như thế có gặp trở ngại gì không???

Em rất hân hạnh được tiếp đón các bác viết lisp trên diễn đàn ghé thăm lều quán nhà em!

Sự hiện diện của các bác sẽ mang lại niềm vui lớn cho cái Hoằn, hy vọng là khi vui, cái Hoằn sẽ ngẫu hứng hát tặng các bác bài hát EM CỦA NGÀY HÔM QUA, bằng một giọng ca hương đồng gió nội mềm mại mượt mà như lúa đang thì con gái nhưng đã nồng nàn "hương lúa chín thoang thoảng bay làm lung lay hàng cột điện làm xáo động cả hàng cây"  và ngọt ngào hơn cả mía lùi bếp gas! :) :) :)


  • 0

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#27 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2882 Bài viết
Điểm đánh giá: 1556 (rất tốt)

Đã gửi 20 November 2014 - 01:09 PM

@gù chị Hà:

3/ Viết Lisp theo công thức tính chiều dài  2d nhỏ và (D/2)+(d/4) không khả thi, bởi vậy chẳng có bác nào giả nhời chị! :) :) :)

4/ Dùng lệnh Cyl vẽ đoạn ống DN250 và đoạn ống DN200 >>> Move đoạn ốngDN200 chọn chế độ  bắt điểm M2p vào trọng tâm ống DN250 >>>3drotate xoay đoạn ống DN200 theo hướng tuỳ thích >>> Union để tạo thành một found Tê ( Thao tác chưa đến 10 giây)

5/ Nếu dùng ít thì cứ thế copy đến vị trí của nó, nếu dùng nhiều thì có thể tạo block...Thực tế là số lượng Tê trong một công trình rất ít, không đáng để viết lisp, chị ạ!
 

5- Chị đã viết:

"Cho trước 1 cái tê thu tự chế DN250_DN200, em muốn nhờ các bác viết lisp:

1 - Sau khi gõ lệnh lisp, thay đổi trị số của D lớn và d nhỏ sẽ ra được các loại tê thu có đường kính khác nhau theo tiêu chuẩn ống của Đức.

2 - Nếu phải mua các loại tê thu trên thị trường có chiều dài khác với tê thu tự chế, người dùng có thể tự sửa lại được dòng Code của Lisp công thức tính chiều dài  2d nhỏ và (D/2)+(d/4),  để ra được chiều dài mong muốn".

Chị nghĩ viết lisp vẽ tê cũng đáng để anh Hiepttr mầy mò tìm đường đi tới lisp vẽ tê ngắn nhất. Biết đâu khi dò đường giữa đêm khuya thanh vắng, anh Hiepttr không dẫm phải "mìn ...của Hoằn" mà lại tình cờ đá phải bao tải tiền của ai đó đánh rơi giữa đồng không mông quạnh :) :) :)

Sao không thấy anh Hiệp có ý kiến gì nhỉ???


  • 0

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#28 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 20 November 2014 - 06:48 PM

@haanh:

Mình ko có ý kiến gì là vì "lụt", chỉ tranh thủ đc tí thời gian lên "ngó" diễn đàn thôi ! :D


  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#29 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2882 Bài viết
Điểm đánh giá: 1556 (rất tốt)

Đã gửi 22 December 2014 - 12:34 PM

Anh Hiệp, ơi , giờ miền Trung đang là mùa khô, thành cổ Quảng Trị quê anh  đã hết lũ lụt chưa??? :) :) :)


  • 0

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#30 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 25 December 2014 - 11:56 AM

khà khà :D :D :D

 

Bỏ chạy lâu ngày ko ngoảnh mặt lại, khi trở lại nước đã rút nhưng cứ tưởng rằng chẳng ai cần nên ko code :D

 

>>> Hàng đây, ném đá đi :D :D :D

;lisp ve te theo D & d nhap vao
(defun c:VET()
(setq os (getvar 'osmode)
	  lay (getvar "clayer")
	  cmd (getvar 'cmdecho))
(mapcar 'setvar (list 'osmode 'cmdecho) '(0 0))
;================================
;ham bay loi
(setq temperr *error*)
(defun errorTrap (msg)
    (and os (setvar 'osmode os))
	(and lay (setvar "clayer" lay))
	(and cmd (setvar 'cmdecho cmd))
	(cond
		((tblsearch "ucs" "save_ucs_ve_T") 
			(command "ucs" "na" "r" "save_ucs_ve_T")
			(command "ucs" "na" "d" "save_ucs_ve_T")
			)
	)
    (setq *error* temperr)
	(princ "\n*** Da set lai bien, OK ! ***")
    (princ)
)
(setq *error* errorTrap)
;======het ham bay loi = P1 ============================
;===========================================================================================
(command "ucs" "na" "s" "save_ucs_ve_T")
(setq #D_lon (NGT #D_lon 254. getdist "Nhap duong kinh ong lon (D)")
	  #d_nho (NGT #d_nho 204. getdist "Nhap duong kinh ong nho (d)")
	  bl_name (strcat "T_" (rtos #D_lon 2 0) "_" (rtos #d_nho 2 0))
)
(if (tblsearch "layer" bl_name) 
			(setvar "clayer" bl_name) 
			(command "layer" "m" bl_name "c" "t" "45,159,225" "" "")
			)	;if
;=========================================================================================
(if (not (tblsearch "block" bl_name))
	(progn
		(command "ucs" "na" "w")
		(command "CYLINDER" (list 0 0 (- #d_nho)) (/ #D_lon 2.) (* 2 #d_nho))
		(setq part_1 (entlast))
		(command "ucs" "za" "" '(1 0 0))
		(command "CYLINDER" '(0 0 0) (/ #d_nho 2.) (+ (/ #D_lon 2.) (/ #d_nho 4.)))
		(command "_.union" part_1 (entlast) "")
		(command "ucs" "za" "" '(-1 0 0))
		(command "-block" bl_name '(0 0 0) (entlast) "")
		(command "ucs" "na" "r" "save_ucs_ve_T")
	)
)	;Neu chua co _ tao block Te
;==========================================================================================
(if (and
		(setq base_pt (getpoint "\nChon diem giao tim 02 tuyen ong: "))
		(setq pt1 (getpoint "\nChon diem thuoc tim tuyen ong lon: "))
		(setq pt2 (getpoint "\nChon diem thuoc tim tuyen ong nho: "))
		(not (equal base_pt pt1 (setq fuzz (/ #d_nho 100))))
		(not (equal base_pt pt2 fuzz))
		(not (equal pt2 pt1 fuzz))
	)
	(progn
		(command "ucs" "3p" base_pt pt2 pt1)
		(command "insert" bl_name '(0 0 0) "" "" "")
	)
)
(command "ucs" "na" "r" "save_ucs_ve_T")
(command "ucs" "na" "d" "save_ucs_ve_T")
(setq *error* temperr)
(setvar 'osmode os)
(setvar "clayer" lay)
(setvar 'cmdecho cmd)
(princ "\nOK !")
(princ)
)
;===================================================================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)

  • 2

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#31 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2882 Bài viết
Điểm đánh giá: 1556 (rất tốt)

Đã gửi 10 January 2015 - 10:16 AM


HA_zpse7oomhp8.gif


Cảm ơn anh Hiệp rất nhiều nhiều nhé! Em đã trót dại nhờ cái Hoằn ném cho anh mấy tảng thịt trâu rừng hun khói, không biết anh đã nhận được chưa??? :) :) :)

Tình hình là em muốn các bác trên diễn đàn và anh Hiệp viết lisp chèn phụ kiện vào đường ống! Đầu vào là các block tê, van, rắc co, bích có điểm chèn tại điểm giữa (trùng với đường tâm ống). Đầu ra là các vị trí bất kỳ trên các đường ống với điều kiện tê, van...phải xoay được theo mọi hướng như ảnh trên.....


  • 0

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#32 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 19 June 2015 - 11:31 AM

@haanh: Ai là người "quên mật khẩu" khi mình đã thắc mắc & nhắn tin (vì sợ làm loãng topic) & đã đợi mãi chẳng thấy hồi âm ?
 

Mở hộp tin nhắn đi, nó sẽ nói lên tất cả :D :D :D


  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#33 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2882 Bài viết
Điểm đánh giá: 1556 (rất tốt)

Đã gửi 19 June 2015 - 03:31 PM

Xin lỗi anh Hiệp đúng là em bị mất...mật khẩu nên nên hôm nay mới được đọc ...công hàm của anh :) :) :)

 

Tê dùng trong đường ống công nghệ của cơ khí không lắp bằng ren như  Tê của đường ống nước mà hàn trực đối đầu trực tiếp

Tê với các kích cỡ khác nhau được tạo block để trong file tư liệu. Cần dùng loại nào thì lôi nó ra đưa vào đúng vị trí của đường ống cần chèn, có thể xoay theo vị trí mong muốn như hình ảnh minh họa ở bài viết trên.

Khi đã bấm chuột để chèn cố định vào đường ống thì đoạn ống dài đúng bằng chiều dài của Tê sẽ phải trở về với cát bụi đúng như anh đã viết: "- Khi chèn phụ kiện, (sau khi chọn loại phụ kiện cần chèn) ta chỉ cần kích chọn đoạn ống >>> lisp sẽ lấy được thông tin từ xdata để xác định đc đường kính phụ kiện ..., đồng thời vẽ lại 2 đoạn ống & xóa đoạn ống cũ đi (mục đích là tạo khoảng hở tại vị trí chèn)"

Chèn các phụ kiện khác chẳng hạn như Bích nối ống , Van chặn , Ống bù giãn nở...được hàn trực tiếp vào ống cũng tương tự như chèn Tê


  • 0

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”