nhờ viết giúp lips vẽ ống

[lehongvinh 1]

chào mọi người !

 

mình muốn vẽ một đường ống, ví dụ : gõ lệnh "pipe" chọn điểm đầu điểm cuối nhập size ống để vẽ đường ống, mình cũng dùng lệnh mline nhưng chỉ muốn gọn hơn xíu nữa.

sau khi vẽ đường ống và gõ lệnh ghi kích thước, vi dụ : gõ lệnh "ghi_kt" thì sẽ cho mình chọn tâm của đường tâm ống và gi kích thước "L=??" theo chìu của ống.

 

mong được sự giúp đỡ từ các anh chị em.

 

[nhoclangbat 392]

_ ^^, vế sau nhoc ko hỉu chọn tâm ống làm gì, và bạn mún ghi kt thước = text hay dim

- nhoc quỡn viết đại đc vậy thui ^^

(defun c:dkk (/ w pt1 pt2)
(setvar "cmdecho" 0)
(setq w (getreal "\ndo rong ong:"))
(setq pt1 (getpoint "\nchon diem dau ong:") pt2 (getpoint pt1 "\nchon diem cuoi ong:"))
(princ "\n")
(command ".Mline" "s" w pt1 pt2 "")
(princ)
(setvar "cmdecho" 1)
)

[haanh 1.590]

Anh Nhoc thử lang bạt làm cái lisp vẽ đường ống Ba đê đê ! :) :) :)

 

 

Em đang vẽ một số hình trong 3D, nhưng gặp khá nhiều khó khăn vì em biết ít lệnh trong môi trường này quá. Vì thế khi có vấn đề là em đè ra viết lisp để rút ngắn thời gian.
Em gửi mấy cái lisp mà em viết lên đây, chúng dùng để thực hiện những thao tác mà em cần, nhưng có thể trong CAD đã có những lệnh để thực hiện chúng, nên em mong mọi người ghóp ý cho em, ví dụ như: lisp này có thể thay bằng lệnh abc gì đó của CAD, hoặc đoạn trong lisp này có thể thay đổi lại như sau… vv.
Em cảm ơn cả nhà rất nhiều!
Sau đây, em xin đi vào chi tiết:
1. Đo khoảng cách 2 điểm và hiện ra thông báo như sau:

Lisp:

;; Do khoang cach 2 diem trong 3D, dua ra do chenh toa do trong he toa do hien hanh
;; By pdle
(defun c:dis(/ pt1 pt2 dx dy dz u)
    (setq
        pt1 (getpoint "\nDiem thu nhat: ")
        pt2 (getpoint "\nDiem thu hai: ")
        dx (- (nth 0 pt2) (nth 0 pt1))
        dy (- (nth 1 pt2) (nth 1 pt1))
        dz (- (nth 2 pt2) (nth 2 pt1))
        u (distance pt1 pt2)
    )
    (alert (strcat "dx= " (rtos dx) " dy= " (rtos dy) " dz= " (rtos dz) " Do dai= " (rtos u)))
)
2. Vẽ một ống hình trụ, điều kiện cho trước là trục ống, bán kính ngoài và bán kính trong của ống:

Lisp:
;;; Ve ong hinh tru co truc cho truoc
;;; By pdle
(defun c:otr (/ ent pt1 pt2 ent1 ent2 Routerpre Rinnerpre)
    ;; Tat che do bat diem
    (setq OldOS (getvar "osmode"))
    (setvar "osmode" 0)
    ;; Nhap truc cua ong
    (setq ent (car (entsel "\nTruc cua ong: ")))
    (setq pt1 (acet-dxf 10 (entget ent)) pt2 (acet-dxf 11 (entget ent)))
    ;; Nhap ban kinh ngoai
    (if (= Router nil) (setq Routerpre 0.04) (setq Routerpre Router))
        (setq Router (getreal (strcat "\nBan kinh ngoai < " (rtos Routerpre) " > : ")))
        (if (= Router nil) (setq Router Routerpre))
    ;; Nhap ban kinh trong
    (if (= Rinner nil) (setq Rinnerpre 0.03) (setq Rinnerpre Rinner))
        (setq Rinner (getreal (strcat "\nBan kinh trong < " (rtos Rinnerpre) " > : ")))
        (if (= Rinner nil) (setq Rinner Rinnerpre))
    ;; Ve hinh tru va thuc hien lenh subtract
    (command "cylinder" pt1 Router "a" pt2)
    ;; Neu ban kinh trong khac 0, thi thuc hien ve hinh tru voi ban kinh trong va subtract
    (if (/= Rinner 0)
    (progn
        (setq ent1 (entlast))
        (command "cylinder" pt1 Rinner "a" pt2)
        (setq ent2 (entlast))
        (command "subtract" ent1 "" ent2 "")
    ))
    ;; Tra lai che do bat diem
    (setvar "osmode" OldOS)
)3. Vẽ một ống tiết diện vuông, điều kiện cho trước là trục ống, kích thước ngoài của ống và độ dày thành ống:

Lisp:
;; Ve ong hinh vuong co truc cho truoc, co canh vuong go voi 1 trong 3 truc toa do cua WCS
;; By pdle
(defun c:ovu(/ pt1 pt2 pt3 ct con1 con2 i j k ent ent1 ent2 pt2new OldOS Dimepre Thickpre Orenpre X1 Y1 Z1 X2 Y2 Z2 Outer Inner)
    ;; Tat che do bat diem
    (setq OldOS (getvar "osmode"))
    (setvar "osmode" 0)
    ;; Dua he truc toa do ve WCS
    (command "ucs" "w")
    ;; Nhap truc cua ong
    (setq ent (car (entsel "\nTruc cua ong: "))
        pt1 (acet-dxf 10 (entget ent))
        pt2 (acet-dxf 11 (entget ent))
        X1 (nth 0 pt1) Y1 (nth 1 pt1) Z1 (nth 2 pt1)
        X2 (nth 0 pt2) Y2 (nth 1 pt2) Z2 (nth 2 pt2)
    )
    ;; Kich thuoc ngoai cua ong vuong
    (if (= Dime nil) (setq Dimepre 0.1) (setq Dimepre Dime))
        (setq Dime (getreal (strcat "\nKich thuoc ngoai cua ong < " (rtos Dimepre) " > : ")))
        (if (= Dime nil) (setq Dime Dimepre))
    ;; Do day thanh ong
    (if (= Thick nil) (setq Thickpre 0.006) (setq Thickpre Thick))
        (setq Thick (getreal (strcat "\nDo day cua ong < " (rtos Thickpre) " > : ")))
        (if (= Thick nil) (setq Thick Thickpre))
    ;; Tinh toan kich thuoc mat ngoai va mat trong ong
    (setq Outer (* 0.5 Dime) Inner (- Outer Thick))
    ;; Xac dinh truc dinh huong cua ong
    (if (= Oren nil) (setq Orenpre "Z") (setq Orenpre Oren))
        (setq Oren (strcase (getstring (strcat "\nTruc dinh huong (X,Y,Z) < " Orenpre " >: "))))
        (if (= Oren "") (setq Oren Orenpre))
    (setq
        i (cond ((= Oren "X") 1) ((= Oren "Y") 0) ((= Oren "Z") 0))
        j (cond ((= Oren "X") 0) ((= Oren "Y") 1) ((= Oren "Z") 0))
        k (cond ((= Oren "X") 0) ((= Oren "Y") 0) ((= Oren "Z") 1))
        pt3 ( list (+ X1 (* k(- Y2 Y1)) (* j (- Z2 Z1))) (+ Y1 (* i(- Z2 Z1)) (* k (- X2 X1))) (+ Z1 (* i(- Y2 Y1)) (* j (- X2 X1))))
    )
    ;; Dua ho truc toa do ve truc cua ong
    (command "ucs" "3" pt1 pt2 pt3)
    (setq
        pt2new (trans pt2 0 1)
        ct (list (* 0.5 (nth 0 pt2new)) (* 0.5 (nth 1 pt2new)) (* 0.5 (nth 2 pt2new)))
        con1 (list 0 Outer Outer)
        con2 (list 0 Inner Inner)
    )
    ;; Ve 2 hinh hop va dung lenh subtract de tao ong
    (command "box" "c" ct con1) (setq ent1 (entlast))
    (command "box" "c" ct con2) (setq ent2 (entlast))
    (command "subtract" ent1 "" ent2 "")
    ;; Dua he truc toa do ve WCS va tra lai che do bat diem hien hanh
    (command "ucs" "w")
    (setvar "osmode" OldOS)
)

Nguồn: http://www.cadviet.com/forum/topic/43060-hoi-lisp-thao-tac-trong-3d/

[nhoclangbat 392]

@@ , chị Hà anh pit nhoc chỉ làm việc trên 2d thui, mà 2d còn chưa thông hết lấy gì qua 3d ^^, nhìn acc nhoc thì pit mà mới li lv5 :), ghẹo nhoc hoài ^^ 

[Doan Van Ha 3.201]

3D thì độ khó chỉ gấp 1.5 lần 2D thôi nhoc ơi!  :lol:  :lol:  :lol:

[nhoclangbat 392]

gấp 0.5 lần nhoc còn chưa với đc huống chi 1.5 lần ^^

[lehongvinh 1]

cảm ơn các anh chị đã giúp.

 

nhưng mình chỉ cần gọn như thế này thôi.

vd : gõ lệnh "pipe" nhập size ống, chon điểm đầu chọn điểm cuối để vẽ ống.

[nhoclangbat 392]

nhưng mình chỉ cần gọn như thế này thôi.

vd : gõ lệnh "pipe" nhập size ống, chon điểm đầu chọn điểm cuối để vẽ ống.

- Đau lòng quá ^^, bạn tải lại lsp #2 dùng chơi :)

[vnbkt 0]

của bạn đây:

 

 (defun       c:PIPE()
   (graphscr)
   (setting)
   (prompt "\n Steel Pipe two line dwg**")
   (if (= ssize nil) (setq ssize 80))
   (setq def_size ssize)
   (initget  "15 20 25 32 40 50 65 80 100 125 150 200 250 300 350 400 450 500  550 600 650 700 750 800  850 900 950  1000 1050")
   (setq ssize (getint (strcat "\n Please enter the pipe diameter steel pipe<"(rtos ssize 2 0)">:")))
   (setq ps(entsel"\n Please select the centerline ( Press the ENTER when there is no center line)?:"))
   (if (= ps nil)
         (progn
              (setq fir(getpoint "\nspecify insert first point:"))
              (setq sec(getpoint fir "\nspecify insert second point:"))
         )
         (progn
              (setq ps1(car ps))
              (setq ps2(entget ps1))
              (setq fir(cdr (assoc 10 ps2)))
              (setq sec(cdr (assoc 11 ps2)))
         )
    )
;-------------------------------------------------------------------------------
   (if (= ssize nil) (setq ssize def_size))
   (if (= ssize 15) (setq dia "21.7"))
   (if (= ssize 20) (setq dia "27.2"))
   (if (= ssize 25) (setq dia "34.0"))
   (if (= ssize 32) (setq dia "42.7"))
   (if (= ssize 40) (setq dia "48.6"))
   (if (= ssize 50) (setq dia "60.5"))
   (if (= ssize 65) (setq dia "76.3"))
   (if (= ssize 80) (setq dia "89.1"))
   (if (= ssize 100) (setq dia "114.3"))
   (if (= ssize 125) (setq dia "139.8"))
   (if (= ssize 150) (setq dia "165.2"))
   (if (= ssize 200) (setq dia "216.3"))
   (if (= ssize 250) (setq dia "267.4"))
   (if (= ssize 300) (setq dia "318.5"))
   (if (= ssize 350) (setq dia "355.6"))
   (if (= ssize 400) (setq dia "406.4"))
   (if (= ssize 450) (setq dia "457.2"))
   (if (= ssize 500) (setq dia "508.0"))
   (if (= ssize 550) (setq dia "558.8"))
   (if (= ssize 600) (setq dia "609.6"))
   (if (= ssize 650) (setq dia "660.4"))
   (if (= ssize 700) (setq dia "711.2"))
   (if (= ssize 750) (setq dia "762"))
   (if (= ssize 800) (setq dia "812.8"))
   (if (= ssize 850) (setq dia "863.6"))
   (if (= ssize 900) (setq dia "814.4"))
   (if (= ssize 950) (setq dia "965.2"))
   (if (= ssize 1000) (setq dia "1016"))
   (if (= ssize 1050) (setq dia "1067"))
;-------------------------------------------------------------------------------
   (setq ang(angle fir sec))
   (setq d(atof dia))
   (setq rad(/ d 2))
   (setq fir1(polar fir (+ ang (dtr 90)) rad))
   (setq fir2(polar fir (- ang (dtr 90)) rad))
   (setq sec1(polar sec (+ ang (dtr 90)) rad))
   (setq sec2(polar sec (- ang (dtr 90)) rad))
;------------------------------------------------------------------------
;   (if (tblsearch "layer" "pipe") nil
;   (COMMAND "LAYER" "M" "PIPE" "LT" "CONTINUOUS" "" "CO" "4" "" "S" "PIPE" ""))
   (entmake(list (cons 0 "line") (list 10 (car fir1) (cadr fir1) (caddr fir1))
           (list 11 (car sec1) (cadr sec1) (caddr sec1))))
   (entmake(list (cons 0 "line") (list 10 (car fir2) (cadr fir2) (caddr fir2))
           (list 11 (car sec2) (cadr sec2) (caddr sec2))))
   (command "change" ps "" "p" "c" "1" "lt" "c1" "")
   (r-setting)
   (princ)
)
;----------------------------------------------------------------------------

 

còn đây là bộ lisp hỗ trợ đầy đủ để vẽ ống nước ống gió.

lin download:

 

http://www.4shared.com/file/ZsKOFn2fba/HVAC154.html

 

http://www.4shared.com/file/uGvHyV5Kce/abc.html

 

[thanhlamct 70]

Hình như Lisp này của PAM phải không vnbkt?

[lanvientkh 14]

- Đau lòng quá ^^, bạn tải lại lsp #2 dùng chơi :)

nhoclangbat, lisp này có thể bổ sung thêm tâm ống (đường line ở giũa nét đứt, màu đen) nữa đi bạn

[Danh Cong 422]

nhoclangbat, lisp này có thể bổ sung thêm tâm ống (đường line ở giũa nét đứt, màu đen) nữa đi bạn

Xin nói đôi lời với bạn LanVien:

- Lisp là lisp "Free" , viết lisp nó cũng "bạc" lắm, các anh chị trên diễn đàn có được hưởng ít xu nào để viết lisp cho mọi người dùng đâu? Mọi người viết vì lòng đam mê với sự khô khan của môn kỹ thuật này thôi.

Thế nên nếu bạn dùng lisp có chỗ không hài lòng vì vài vấn đề cỏn con thì hãy tự thỏa mãn với chính mình đi. Chứ đừng có yêu cầu thêm thắt mấy thứ vào lisp trong khi bạn làm được rất dễ dàng, vừa đỡ mệt cho ai phải trả lời câu hỏi cho bạn. < Thật sự là ai đọc yêu cầu trên của bạn cũng chẳng có hứng thú giúp bạn đâu >

- Nếu có thời gian thì bạn tự học lisp. Mọi người rất quý ai đó ham học hỏi kiến thức, chứ ko ai mến người suốt ngày yêu cầu nọ kia. Thân gửi...  : )

[saigonnew 0]

Xin nói đôi lời với bạn LanVien:

- Lisp là lisp "Free" , viết lisp nó cũng "bạc" lắm, các anh chị trên diễn đàn có được hưởng ít xu nào để viết lisp cho mọi người dùng đâu? Mọi người viết vì lòng đam mê với sự khô khan của môn kỹ thuật này thôi.

Thế nên nếu bạn dùng lisp có chỗ không hài lòng vì vài vấn đề cỏn con thì hãy tự thỏa mãn với chính mình đi. Chứ đừng có yêu cầu thêm thắt mấy thứ vào lisp trong khi bạn làm được rất dễ dàng, vừa đỡ mệt cho ai phải trả lời câu hỏi cho bạn. < Thật sự là ai đọc yêu cầu trên của bạn cũng chẳng có hứng thú giúp bạn đâu >

- Nếu có thời gian thì bạn tự học lisp. Mọi người rất quý ai đó ham học hỏi kiến thức, chứ ko ai mến người suốt ngày yêu cầu nọ kia. Thân gửi...  : )

bạn ấy cần thì bạn ấy nhờ thôi, ai đam mê giúp bạn và nhiều khác nếu cần, ai chẳng muốn học nhưng sg chỗ nào dạy bạn chỉ xem

[lanvientkh 14]

Thấy cái này cũng hay, bạn xài tạm vậy

 

 

;|      DP.LSP  JD HENMAN 20090818

DP - draws pipe the length of selected lines (centerlines)

             (use along with pull-down menu for all Std pipe sizes

|;

(defun c:DP (/ olayer lay_name A B C D E N1 N2 pnt11 pnt12 mssg dist dist2 entity count total)

 

; load the vla command set

  (vl-load-com)

 

; accessing the graphic screen as opposed to the text screen

  (graphscr)

 

; remember the current layer

  (setq olayer (getvar "clayer"))

 

; define the layers addressed in the program

   (command "layer" "m" "Center" "c" "8" "" "lt" "Center2" "" "")

   (command "layer" "m" "Hidden" "c" "5" "" "lt" "Hidden2" "" "")

   (command "layer" "m" "Object" "c" "3" "" "lt" "Continuous" "" "")

   (setvar "clayer" olayer)

 

; let user specify OD & ID

(setq P-OD (getreal "\n Enter O.D. of Pipe: "))

(setq P-ID (getreal "\n Enter I.D. of Pipe: "))

(setq P-OD_2 (/ P-OD 2))

(setq P-ID_2 (/ P-ID 2))

 

(princ "\nSelect Centerlines to Construct Pipe: ")

   (setq A (ssget))

 

;variable B knows how many objects were found in variable A

   (setq B (sslength A))

 

   (setq C 0); counter

 

; the loop ends when C = B

   (while (< C B)

 

;  command line animation to prove computer is working:

   (defun spinbar (sbar)

     (cond

          ((= sbar "\\") "|")

          ((= sbar "|") "/")

          ((= sbar "/") "-")

          (t "\\")

      );cond

   );defun

 

   (princ (strcat "\rOffsetting Pipe Entities " (setq sbar (spinbar sbar))))

 

; D is assigned the next entity found in the subset

      (setq D (ssname A C))

 

(setq N2 (entget D)

             N2 (subst (cons 8 "Center")

            (assoc 8 N2) N2)

        );setq 

        (entmod N2)

 

      (initget (+ 1 2 4 64))

      (setq odist P-OD_2); distance for offsets

      (setq idist P-ID_2); distance for offsets

 

; D is the entity but must be considered an object to be offset

      (setq D (vlax-ename->vla-object D))

 

; D is offset in both directions

      (vla-offset D idist)

        (setq entity (entlast)

              entity (entget entity)

              entity (subst (cons 8 "Hidden")

             (assoc 8 entity) entity)

         );setq

         (entmod entity)

      (vla-offset D (* idist -1))

        (setq entity (entlast)

              entity (entget entity)

              entity (subst (cons 8 "Hidden")

             (assoc 8 entity) entity)

         );setq

         (entmod entity)

      (vla-offset D odist)

        (setq entity (entlast)

              entity (entget entity)

              entity (subst (cons 8 "Object")

             (assoc 8 entity) entity)

         );setq

         (entmod entity)

      (vla-offset D (* odist -1))

        (setq entity (entlast)

              entity (entget entity)

              entity (subst (cons 8 "Object")

             (assoc 8 entity) entity)

         );setq

         (entmod entity)

(setq C (1+ C));add one to counter before testing while loop again

 ) ;while 

  (princ)

);defun DP

[Danh Cong 422]

bạn ấy cần thì bạn ấy nhờ thôi, ai đam mê giúp bạn và nhiều khác nếu cần, ai chẳng muốn học nhưng sg chỗ nào dạy bạn chỉ xem

Bạn thử Search trên diễn đàn từ " Học lập trình lisp cơ bản"  : ) Sẽ có đáp án cho bạn ngay  :D  :D

[saigonnew 0]

Học chứ có phải mò cua bắt ốc đâu, cứ mò mẫm thế khác gì người mù, giờ bạn ấy cần, đọc sách làm thầy dc thì ko ai đi học,ko thầy đố mày làm nên

[Danh Cong 422]

Nói thẳng... Bạn tìm khắp Sài Gòn - bay ra Hà Nội cũng ko tìm lấy dc 1 chỗ dạy riêng lập trình đâu.
Tất cả các anh chị bậc thầy trên diễn đàn cũng từ ng ko biết về lisp, ko qua trường lớp nào cả, nhặt nhạnh từng chút kiến thức vụn vặt mà thành công, đó là sự tích lũy kiến thức trong 1 thời gian rất dài, ko phải có người dạy là dc.
P/s: Sách là thầy. Bạn ko chịu đọc thì bỏ qua món lập trình đi.

[saigonnew 0]

Mình muốn sửa cái lisp đường kính ống này bằng cách tạo thành block mặt cắt ống, nhưng chưa làm được, nhờ cao thủ nào giúp một tay vậy

 

(DEFUN c:pipe ( / CNT DIAM INCH P1)

 

(setq P1 (entsel "\nSelect an object to create the circle in the same layer: "))

(setq CNT (getpoint "\nSelect circle center")) ;click the center of the circle

 

(initget 1 "15 20 25 32 40 50 65 80 100 125 150 200 250")

 

(setq INCH (getkword "\nSelect Diameter: [15 / 20 / 25 / 32 / 40 / 50 / 65 / 80 / 100 / 125 / 150 / 200 / 250]"))

 

(setq DIAM (cond ((= INCH "15") 21.34)

((= INCH "20") 26.67)

((= INCH "25") 33.4)

((= INCH "32") 42.16)

((= INCH "40") 48.26)

((= INCH "50") 60.33)

((= INCH "65") 73.03)

((= INCH "80") 88.9)

((= INCH "100") 114.3)

((= INCH "125") 141.3)

((= INCH "150") 168.28)

((= INCH "200") 219.08)

((= INCH "250") 273.05)

);End conditional

) ;End setq DIAM

 

(command "laymcur" P1) ; to move in other layer with a select

(command "circle" "_non" CNT "D" DIAM) ;draw the circle

(command "layerp") ; return in the original layer

 

(PRINC)

)