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

    • Nguyen Hoanh

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

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

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

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

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.

 

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


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

_ ^^, vế 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)
)
  • Vote tăng 3

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


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

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:
3-9.jpg
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:
1-16.jpg
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:
2-12.jpg
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/

  • Vote tăng 1

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


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

@@ , chị 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 ^^ 

  • Vote tăng 1

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


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

cảm ơn 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.

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


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

như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 :)

  • Vote tăng 1

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


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

củ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:

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

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

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

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

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


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

Xin 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

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


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

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


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

bạn ấ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

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

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

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

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.

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


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

Mình 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)
)

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


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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×