Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
phongtran86

Nhờ Chỉnh Lisp Cắt Thép Dầm Momen

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

em theo ý tưởng bản thân đã lập lisp như sau:

- có khuôn bao hình dầm, thép dầm

- gõ lệnh lisp qq

- Nhập tọa độ 2 điểm.... nhập chiều cao dầm

- vòng lặp: nhập 2 điểm.... nhập chiều cao dầm

- kết thúc enter

...

(defun c:qq(/  cd pt1 pt2 kc kc1 kc2 d1 d2 d3 d4 d5 d6 d7 d8 d9 

da)
  (setq luu (getvar "osmode"))
  (setq lay (getvar "clayer"))
(SETQ TXT (GETVAR "DIMTXT"))
(SETQ DC (GETVAR "DIMSCALE"))
(setq C (* TXT DC))
;;;nhap du lieu
  (setvar "osmode" 111)
;(COMMAND "OSNAP" "END,INT,INS,NOD,CEN,MID,QUA,PERP")
  (COMMAND "LAYER" "M" "THEPDOC" "C" "1" "" "LW" "0.4" "" "")
  (vl-cmdf "clayer" "THEPDOC")
  (INITGET 7)
(setvar "cmdecho" 1)
  (defun roundup (so)
    (* (atoi (rtos (/ so 50) 2 0)) 50))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   (while (setq pt1 (getpoint "nhap toa do diem dau duoi 

dam:"))
    (setq pt2 (getpoint pt1 "nhap toa do diem cuoi duoi dam:"))
    (or	cd (setq cd 400))
(setq cd (cond ((getdist (strcat"\nchieu cao dam <" (rtos cd 2 

2) ">:"))) (cd)))
(setq kc (distance pt1 pt2))
(SETQ kc1 (- (roundup (/ (+ kc 220) 5)) 110))
(SETQ kc2 (- (roundup (/ (+ kc 220) 3)) 110))
(SETQ d1 (POLAR pt1 (/ pi 2) 50))
(SETQ d2 (POLAR d1 0 kc1))
(SETQ d3 (POLAR d2 (/ pi 6) 50))
(SETQ d4 (POLAR d1 0 (- kc kc1)))
(SETQ d5 (POLAR d4 (* 5 (/ pi 6)) 50))
(SETQ da (POLAR pt1 (/ pi 2) (- cd 50)))
(SETQ d6 (POLAR da 0 kc2))
(SETQ d7 (POLAR d6 (* 7 (/ pi 6)) 50))
(SETQ d8 (POLAR da 0 (- kc kc2)))
(SETQ d9 (POLAR d8 (- 0 (/ pi 6)) 50))
(SETQ pt (POLAR da (/ pi 2) (* 8 c)))
(SETQ pd (POLAR d1 (* 3 (/ pi 2)) (* 8 c)))
  (setvar "osmode" 0)
		(COMMAND "LINE" d2 d3 "")
		(COMMAND "LINE" d4 d5 "")
		(COMMAND "LINE" d6 d7 "")
		(COMMAND "LINE" d8 d9 "")
(COMMAND "dimlinear" da d6 pt)
(COMMAND "DIMCONTINUE" d8 pt2 "" "")
(COMMAND "dimlinear" d1 d2 pd)
(COMMAND "DIMCONTINUE" d4 pt2 "" "")
(setvar "osmode" 111)
)
;;;;het vong lap
(setvar "osmode" luu)
(setvar "clayer" lay)
		(princ)
)

- nhờ các bác chỉnh cho em chút làm sao để trong vòng lặp (hoặc ngay cả ban đầu) không hiển thị nhập chiều cao dầm mà chỉ cần pick 2 điểm. cao dầm mặc định là 400, khi gõ lệnh thì khi hiển thị dòng pick điếm 1,2 có gợi ý :(Caodam), nhấn C để thay đổi cao dầm, ko nhấn thì bỏ qua thì nhấn 2 điểm bình thường. Phần này hơi khó, mình chưa lập được :D

  • 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

Bạn tự nghiên cứu nhé:

 

(or (and kc (or (= (type kc) 'int) (= (type kc) 'real))) (setq kc 100))
(setq kc (cond ((getdist (strcat "\nDistance <" (rtos kc 2 2) ">: "))) (kc)))

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 tự nghiên cứu nhé:

(or (and kc (or (= (type kc) 'int) (= (type kc) 'real))) (setq kc 100))
(setq kc (cond ((getdist (strcat "\nDistance <" (rtos kc 2 2) ">: "))) (kc)))

Biến kc là kc 2 điểm mà anh. chiều cao dầm là CD, em k bik đoạn code trên cho vào đoạn nào! Anh chỉ với. Vì em không muốn hiển thị gợi ý "\nDistance <" nhớ lần nhập trc luôn. mà chỉ cần nhập 2 điểm. Khi muốn thay đổi chiều cao dầm mới nhập (Caodam) chữ C rồi nhập cao dầm. giống như lệnh PL gõ L chuyển vẽ thẳng, a chuyển vẽ cong ấy. chứ dòng lệnh trên của anh cũng giống dòng dưới của em.:(

(or	cd (setq cd 400))
(setq cd (cond ((getdist ("\nchieu cao dam <" (rtos cd 2 

2) ">:"))) (cd)))

  • 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

Tiếp tục nghiên cứu hàm này he:

 

(defun c:cbs(/ p)
  (initget 1 "c") (setq p (getpoint "Pick point or Press C to say good morning :"))
  (if (= p "c") (alert "Chao buoi sang - Good morning") (alert (vl-princ-to-string p))))
  • 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

 

Tiếp tục nghiên cứu hàm này he:

(defun c:cbs(/ p)
  (initget 1 "c") (setq p (getpoint "Pick point or Press C to say good morning :"))
  (if (= p "c") (alert "Chao buoi sang - Good morning") (alert (vl-princ-to-string p))))

để em thử ng/c. k dc em lại nhờ bác.

Như vậy phải có 2 vòng lặp while đúng k bác.

while (whille ( nhập pt1: (hoặc cao dầm). nếu nhập cao dầm thì lặp, nếu nhập pick point thì thoát lặp)

nhập pt2]. Em hiểu như thế, nhưng không biết thể hiện ntn. thử cứ bị lỗi. Bác giúp em chót :)

  • 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

để em thử ng/c. k dc em lại nhờ bác.

Như vậy phải có 2 vòng lặp while đúng k bác.

while (whille ( nhập pt1: (hoặc cao dầm). nếu nhập cao dầm thì lặp, nếu nhập pick point thì thoát lặp)

nhập pt2]. Em hiểu như thế, nhưng không biết thể hiện ntn. thử cứ bị lỗi. Bác giúp em chót :)

 (while 
  (while 
(initget 1 "c") (setq p (getpoint "nhap toa do diem dau duoi dam: hoac (/Caodam) :"))
  (if (= p "c") (setq cd (cond ((getdist (strcat "\nChieu cao dam <" (rtos cd 2 2) ">: "))) (cd))) 
(setq pt1 p)))
;het vong lap 1
    (setq pt2 (getpoint pt1 "nhap toa do diem cuoi duoi dam:"))
;.............................................
;
;dong lenh khac
)
;het vong lap 2

em để như thế này nó ko chạy, k hiểu cú phap sai diem nao ma k chay

Chỉnh sửa theo phongtran86
  • 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

em theo ý tưởng bản thân đã lập lisp như sau:

- có khuôn bao hình dầm, thép dầm

- gõ lệnh lisp qq

- Nhập tọa độ 2 điểm.... nhập chiều cao dầm

- vòng lặp: nhập 2 điểm.... nhập chiều cao dầm

- kết thúc enter

13179067_1061434650546326_76187915834725

(defun c:qq(/  cd pt1 pt2 kc kc1 kc2 d1 d2 d3 d4 d5 d6 d7 d8 d9 

da)
  (setq luu (getvar "osmode"))
  (setq lay (getvar "clayer"))
(SETQ TXT (GETVAR "DIMTXT"))
(SETQ DC (GETVAR "DIMSCALE"))
(setq C (* TXT DC))
;;;nhap du lieu
  (setvar "osmode" 111)
;(COMMAND "OSNAP" "END,INT,INS,NOD,CEN,MID,QUA,PERP")
  (COMMAND "LAYER" "M" "THEPDOC" "C" "1" "" "LW" "0.4" "" "")
  (vl-cmdf "clayer" "THEPDOC")
  (INITGET 7)
(setvar "cmdecho" 1)
  (defun roundup (so)
    (* (atoi (rtos (/ so 50) 2 0)) 50))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   (while (setq pt1 (getpoint "nhap toa do diem dau duoi 

dam:"))
    (setq pt2 (getpoint pt1 "nhap toa do diem cuoi duoi dam:"))
    (or	cd (setq cd 400))
(setq cd (cond ((getdist (strcat"\nchieu cao dam <" (rtos cd 2 

2) ">:"))) (cd)))
(setq kc (distance pt1 pt2))
(SETQ kc1 (- (roundup (/ (+ kc 220) 5)) 110))
(SETQ kc2 (- (roundup (/ (+ kc 220) 3)) 110))
(SETQ d1 (POLAR pt1 (/ pi 2) 50))
(SETQ d2 (POLAR d1 0 kc1))
(SETQ d3 (POLAR d2 (/ pi 6) 50))
(SETQ d4 (POLAR d1 0 (- kc kc1)))
(SETQ d5 (POLAR d4 (* 5 (/ pi 6)) 50))
(SETQ da (POLAR pt1 (/ pi 2) (- cd 50)))
(SETQ d6 (POLAR da 0 kc2))
(SETQ d7 (POLAR d6 (* 7 (/ pi 6)) 50))
(SETQ d8 (POLAR da 0 (- kc kc2)))
(SETQ d9 (POLAR d8 (- 0 (/ pi 6)) 50))
(SETQ pt (POLAR da (/ pi 2) (* 8 c)))
(SETQ pd (POLAR d1 (* 3 (/ pi 2)) (* 8 c)))
  (setvar "osmode" 0)
		(COMMAND "LINE" d2 d3 "")
		(COMMAND "LINE" d4 d5 "")
		(COMMAND "LINE" d6 d7 "")
		(COMMAND "LINE" d8 d9 "")
(COMMAND "dimlinear" da d6 pt)
(COMMAND "DIMCONTINUE" d8 pt2 "" "")
(COMMAND "dimlinear" d1 d2 pd)
(COMMAND "DIMCONTINUE" d4 pt2 "" "")
(setvar "osmode" 111)
)
;;;;het vong lap
(setvar "osmode" luu)
(setvar "clayer" lay)
		(princ)
)

- nhờ các bác chỉnh cho em chút làm sao để trong vòng lặp (hoặc ngay cả ban đầu) không hiển thị nhập chiều cao dầm mà chỉ cần pick 2 điểm. cao dầm mặc định là 400, khi gõ lệnh thì khi hiển thị dòng pick điếm 1,2 có gợi ý :(Caodam), nhấn C để thay đổi cao dầm, ko nhấn thì bỏ qua thì nhấn 2 điểm bình thường. Phần này hơi khó, mình chưa lập được :D

Hề hề hề,

Bạn cần coi lại cú pháp của các hàm. Tỷ như hàm 

(getdist ("\nchieu cao dam <" (rtos cd 2 2) ">:")) là sai nặng đó. làm sao lisp chạy được.

Phải hiểu rõ cú pháp từng hàm rồi mới ứng dụng được.

Yêu cầu của bạn không phải quá khó. chỉ cần thêm một biến phụ yes or no trước khi nhập biến chiều cao dầm là được. 

  • Vote tăng 2

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


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

Lisp này chỉ chạy cho dầm nằm ngang, vì vậy sao không chọn điểm 2 là điểm trên cuối dầm để tính chiều cao ?

Cách khác là chọn 2 line : có thể chạy cho dầm nằm nghiêng. Cách này có thể xử lý hàng loạt dầm nếu bản vẽ được tiêu chuẩn hóa

  • 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

Hề hề hề,

Bạn cần coi lại cú pháp của các hàm. Tỷ như hàm 

(getdist ("\nchieu cao dam <" (rtos cd 2 2) ">:")) là sai nặng đó. làm sao lisp chạy được.

Phải hiểu rõ cú pháp từng hàm rồi mới ứng dụng được.

Yêu cầu của bạn không phải quá khó. chỉ cần thêm một biến phụ yes or no trước khi nhập biến chiều cao dầm là được. 

em ko bik sai chỗ nào. vì lisp vẫn chạy dc mà. anh chỉ giúp

 

Lisp này chỉ chạy cho dầm nằm ngang, vì vậy sao không chọn điểm 2 là điểm trên cuối dầm để tính chiều cao ?

Cách khác là chọn 2 line : có thể chạy cho dầm nằm nghiêng. Cách này có thể xử lý hàng loạt dầm nếu bản vẽ được tiêu chuẩn hóa

 

em chỉ bập bẹ chút nên chỉ lập theo trường hợp điển hình, k tổng quát hóa dc. Bác nhiệt tình giúp em vớ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

Lisp này chỉ chạy cho dầm nằm ngang, vì vậy sao không chọn điểm 2 là điểm trên cuối dầm để tính chiều cao ?

 

Theo gợi ý của bác ndtv thì có thể k cần nhập chiều cao. :) Việc nhập k cần thiết nữa. nhưng trong 1 cơ số trường hợp, các lisp khác việc nhập như thế này là cần nên em nhờ anh demo điển hình cho em 1 lần này để làm mẫu. khi thực hiện lệnh luôn hiện [ Caodam <giá biến hiện tại>], hoặc điển hình hơn [ Bien1 <giá biến 1 hiện tại>/ Bien2 <giá biến 2 hiện tại> ........], khong nhấn lựa chọn thay đổi giá trị biến thì lệnh vẫn thực hiện bình thường với giá trị biến này. Còn khi thực hiện lệnh thay đổi biến xong thì lại chuyển thực hiện tiếp tục lệnh với gia trị biến mớ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

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

(or cd (setq cd 400))
 (setq temp "T")
 (while (= temp "T")
  (initget 0 "Cao")
  (setq pt1 (getpoint (strcat "\nNhap toa do diem dau duoi dam/Caodam [" (rtos cd 2 0) "]:")))
  (cond ((= pt1 "Cao")
         (setq cd (cond ((getdist (strcat "\nchieu cao dam <" (rtos cd 2 2) ">:")))
                        (cd))))
        ((= pt1 nil) (setq temp nil))
        (t (tiep_theo...))))

  • 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

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

(or cd (setq cd 400))

 (setq temp "T")

 (while (= temp "T")

  (initget 0 "Cao")

  (setq pt1 (getpoint (strcat "\nNhap toa do diem dau duoi dam/Caodam [" (rtos cd 2 0) "]:")))

  (cond ((= pt1 "Cao")

         (setq cd (cond ((getdist (strcat "\nchieu cao dam <" (rtos cd 2 2) ">:")))

                        (cd))))

        ((= pt1 nil) (setq temp nil))

        (t (tiep_theo...))))

em chưa test :D. Tiện bác cho em trường hợp nhiều biến xem vớ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

em chưa test :D. Tiện bác cho em trường hợp nhiều biến xem với

Hề hề hề,

Theo mình bạn có thể làm đơn giản là.

1/- Đặt các biến: (setq b1 a1 b2 a2 .......)

 

2/- Trong vòng lặp

 Đặt bến phụ: (setq an (gesting "Ban muon thay doi gia tri cac bien da có? < Y or N>"))

đưa vào hàm điều kiện

(if (= (strcase an) "Y")

   Lặp lại việc đặt biến (setq .....)

)

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


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

em chưa test :D. Tiện bác cho em trường hợp nhiều biến xem với

òa... Viết được thì cũng đọc được chứ hả... Thêm nhiều thì cứ copy, paste và edit lại 1 tý thôi mà.

Bạn test nhé:

(defun c:test  (/ bv cd pt1 temp)
 (or (and cd (or (= (type cd) 'int) (= (type cd) 'real))) (setq cd 400))
 (or (and bv (or (= (type bv) 'int) (= (type bv) 'real))) (setq bv 20))
 (setq temp "T")
 (while (= temp "T")
  (initget 0 "Cao Bao")
  (setq pt1 (getpoint
             (strcat "\nCaodam <" (rtos cd 2 0) ">/Baove <" (rtos bv 2 0) ">. Nhap toa do diem dau duoi dam: ")))
  (cond ((= pt1 "Cao")
         (setq cd (cond ((getdist (strcat "\nChieu cao dam <" (rtos cd 2 0) ">:")))
                        (cd))))
        ((= pt1 "Bao")
         (setq bv (cond ((getdist (strcat "\nChieu day lop bao ve betong <" (rtos bv 2 0) ">:")))
                        (bv))))
        ((= pt1 nil) (setq temp nil))
        (t (alert "Thuc hien cac buoc tiep theo o day..."))))
 (princ))
  • Vote tăng 1

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


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

 

òa... Viết được thì cũng đọc được chứ hả... Thêm nhiều thì cứ copy, paste và edit lại 1 tý thôi mà.

Bạn test nhé:

(defun c:test  (/ bv cd pt1 temp)
 (or (and cd (or (= (type cd) 'int) (= (type cd) 'real))) (setq cd 400))
 (or (and bv (or (= (type bv) 'int) (= (type bv) 'real))) (setq bv 20))
 (setq temp "T")
 (while (= temp "T")
  (initget 0 "Cao Bao")
  (setq pt1 (getpoint
             (strcat "\nCaodam <" (rtos cd 2 0) ">/Baove <" (rtos bv 2 0) ">. Nhap toa do diem dau duoi dam: ")))
  (cond ((= pt1 "Cao")
         (setq cd (cond ((getdist (strcat "\nChieu cao dam <" (rtos cd 2 0) ">:")))
                        (cd))))
        ((= pt1 "Bao")
         (setq bv (cond ((getdist (strcat "\nChieu day lop bao ve betong <" (rtos bv 2 0) ">:")))
                        (bv))))
        ((= pt1 nil) (setq temp nil))
        (t (alert "Thuc hien cac buoc tiep theo o day..."))))
 (princ))

Bác viết giùm chủ thớt đoạn code hoàn chỉnh theo như yêu cầu ở bài 1 luôn với, thấy đây là ý tưởng hay dành cho dân xây dựng, chủ thới mới tập thì sợ viết dài dòng, dễ mắc lỗi. Mong các cao thủ ghi nhận ý. Chân thành cảm ơ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

Bác viết giùm chủ thớt đoạn code hoàn chỉnh theo như yêu cầu ở bài 1 luôn với, thấy đây là ý tưởng hay dành cho dân xây dựng, chủ thới mới tập thì sợ viết dài dòng, dễ mắc lỗi. Mong các cao thủ ghi nhận ý. Chân thành cảm ơn.

quan trọng nhất lisp này là cái  toán cắt thép như thế nào. 1/3, 1/4,  1/5 j đấy, người trong dân kcau mới bik. COn thuật toán là vấn đề lập trình thôi, sẽ có bác giúp.

  • 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

 

òa... Viết được thì cũng đọc được chứ hả... Thêm nhiều thì cứ copy, paste và edit lại 1 tý thôi mà.

 

Mình đọc được topic 1 số lisp bác sửa mà link die mất rồi. bác up lại dc k

http://www.cadviet.com/forum/topic/160861-yeu-c-u-nh-cac-bac-vi-t-dum-lisp-nay-cho-ae-xd-tri-n-khai-k-t-c-u/

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


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

Bác viết giùm chủ thớt đoạn code hoàn chỉnh theo như yêu cầu ở bài 1 luôn với, thấy đây là ý tưởng hay dành cho dân xây dựng, chủ thới mới tập thì sợ viết dài dòng, dễ mắc lỗi. Mong các cao thủ ghi nhận ý. Chân thành cảm ơn.

Theo bài 1:

(defun c:tt  (/ modelSpace lay bv cd pt1 temp create-layer tiep_theo_qm kcach_dau Make-Line laythep)
 (defun kcach_dau  (mm-am len fac / del l-0)
  (if (eq mm-am t)
   (progn (setq l-0 (/ len 4)
                del (rem l-0 50))
          (if (> del 0)
           (setq l-0 (- l-0 del (/ -50 fac)))))
   (progn (setq l-0 (/ len 6)
                del (rem l-0 (/ 50 fac)))
          (if (> del 0)
           (setq l-0 (- l-0 del)))))
  l-0)
 (defun create-layer  (name color lineWeight)
  (entmakex (list '(0 . "LAYER")
                  (cons 100 "AcDbSymbolTableRecord")
                  (cons 100 "AcDbLayerTableRecord")
                  (cons 2 name)
                  (cons 70 0)
                  (cons 62 color)
                  (cons 6 "Continuous")
                  (cons 370 (fix (* 100 lineWeight))))))
 (defun Make-Line  (p1 p2 lay)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 lay))))
 ;;-------------------
 (defun tiep_theo_qm  (/ cdim pt2 kc pd1 pd2 pd3 pa1 pa2 pa3 ptt)
  (setq cdim (* (getvar "DIMTXT") (getvar "DIMSCALE")))
  (setq pt2 (getpoint "\nNhap toa do diem cuoi duoi dam:" pt1))
  (setq kc (distance pt1 pt2))
  ;; Momen duong
  (setq pd1 (polar pt1 (* pi 0) (kcach_dau nil kc 1))
        pd2 (polar pt2 (* pi 1) (kcach_dau nil kc 1))
        pd3 (polar pt1 (* pi 1.5) (* cdim 4)))
  (setvar "CLAYER" "DIM")
  (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
          (mapcar 'vlax-3d-point (list pt1 pd1 pd2))
          (mapcar 'vlax-3d-point (list pd1 pd2 pt2))
          (mapcar 'vlax-3d-point (list pd3 pd3 pd3)))
  (Make-Line (setq ptt (polar pd1 (* pi 0.5) bv)) (polar ptt (* pi 0.25) bv) laythep)
  (Make-Line (setq ptt (polar pd2 (* pi 0.5) bv)) (polar ptt (* pi 0.75) bv) laythep)
  ;; Momen am
  (setq pt1 (polar pt1 (* pi 0.5) cd)
        pt2 (polar pt2 (* pi 0.5) cd)
        pa1 (polar pt1 (* pi 0) (kcach_dau t kc 1))
        pa2 (polar pt2 (* pi 1) (kcach_dau t kc 1))
        pa3 (polar pt1 (* pi 0.5) (* cdim 4)))
  (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
          (mapcar 'vlax-3d-point (list pt1 pa1 pa2))
          (mapcar 'vlax-3d-point (list pa1 pa2 pt2))
          (mapcar 'vlax-3d-point (list pa3 pa3 pa3)))
  (Make-Line (setq ptt (polar pa1 (* pi 1.5) bv)) (polar ptt (* pi 1.25) bv) laythep)
  (Make-Line (setq ptt (polar pa2 (* pi 1.5) bv)) (polar ptt (* pi 1.75) bv) laythep)
  (setvar "CLAYER" lay))
 ;; MAIN
 (vl-load-com)
 (setq msp     (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
       lay     (getvar "clayer")
       laythep "THEPDOC")
 (create-layer laythep 1 0.4)
 (create-layer "DIM" 8 -3)
 (or (and cd (or (= (type cd) 'int) (= (type cd) 'real))) (setq cd 400))
 (or (and bv (or (= (type bv) 'int) (= (type bv) 'real))) (setq bv 20))
 (setq temp "T")
 (while (= temp "T")
  (initget 0 "Cao Bao")
  (setq pt1 (getpoint
             (strcat "\nCaodam <" (rtos cd 2 0) ">/Baove <" (rtos bv 2 0) ">. Nhap toa do diem dau duoi dam: ")))
  (cond ((= pt1 "Cao")
         (setq cd (cond ((getdist (strcat "\nChieu cao dam <" (rtos cd 2 0) ">:")))
                        (cd))))
        ((= pt1 "Bao")
         (setq bv (cond ((getdist (strcat "\nChieu day lop betong bao ve <" (rtos bv 2 0) ">:")))
                        (bv))))
        ((= pt1 nil) (setq temp nil))
        (t (tiep_theo_qm))))
 (princ))

 

Mình đọc được topic 1 số lisp bác sửa mà link die mất rồi. bác up lại dc k

http://www.cadviet.com/forum/topic/160861-yeu-c-u-nh-cac-bac-vi-t-dum-lisp-nay-cho-ae-xd-tri-n-khai-k-t-c-u/

 

Cái đó là có dim trước, rồi chia dim khác với topic này.

  • Vote tăng 2

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


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

Theo bài 1:

(defun c:tt  (/ modelSpace lay bv cd pt1 temp create-layer tiep_theo_qm kcach_dau Make-Line laythep)
 (defun kcach_dau  (mm-am len fac / del l-0)
  (if (eq mm-am t)
   (progn (setq l-0 (/ len 4)
                del (rem l-0 50))
          (if (> del 0)
           (setq l-0 (- l-0 del (/ -50 fac)))))
   (progn (setq l-0 (/ len 6)
                del (rem l-0 (/ 50 fac)))
          (if (> del 0)
           (setq l-0 (- l-0 del)))))
  l-0)
 (defun create-layer  (name color lineWeight)
  (entmakex (list '(0 . "LAYER")
                  (cons 100 "AcDbSymbolTableRecord")
                  (cons 100 "AcDbLayerTableRecord")
                  (cons 2 name)
                  (cons 70 0)
                  (cons 62 color)
                  (cons 6 "Continuous")
                  (cons 370 (fix (* 100 lineWeight))))))
 (defun Make-Line  (p1 p2 lay)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 lay))))
 ;;-------------------
 (defun tiep_theo_qm  (/ cdim pt2 kc pd1 pd2 pd3 pa1 pa2 pa3 ptt)
  (setq cdim (* (getvar "DIMTXT") (getvar "DIMSCALE")))
  (setq pt2 (getpoint "\nNhap toa do diem cuoi duoi dam:" pt1))
  (setq kc (distance pt1 pt2))
  ;; Momen duong
  (setq pd1 (polar pt1 (* pi 0) (kcach_dau nil kc 1))
        pd2 (polar pt2 (* pi 1) (kcach_dau nil kc 1))
        pd3 (polar pt1 (* pi 1.5) (* cdim 4)))
  (setvar "CLAYER" "DIM")
  (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
          (mapcar 'vlax-3d-point (list pt1 pd1 pd2))
          (mapcar 'vlax-3d-point (list pd1 pd2 pt2))
          (mapcar 'vlax-3d-point (list pd3 pd3 pd3)))
  (Make-Line (setq ptt (polar pd1 (* pi 0.5) bv)) (polar ptt (* pi 0.25) bv) laythep)
  (Make-Line (setq ptt (polar pd2 (* pi 0.5) bv)) (polar ptt (* pi 0.75) bv) laythep)
  ;; Momen am
  (setq pt1 (polar pt1 (* pi 0.5) cd)
        pt2 (polar pt2 (* pi 0.5) cd)
        pa1 (polar pt1 (* pi 0) (kcach_dau t kc 1))
        pa2 (polar pt2 (* pi 1) (kcach_dau t kc 1))
        pa3 (polar pt1 (* pi 0.5) (* cdim 4)))
  (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
          (mapcar 'vlax-3d-point (list pt1 pa1 pa2))
          (mapcar 'vlax-3d-point (list pa1 pa2 pt2))
          (mapcar 'vlax-3d-point (list pa3 pa3 pa3)))
  (Make-Line (setq ptt (polar pa1 (* pi 1.5) bv)) (polar ptt (* pi 1.25) bv) laythep)
  (Make-Line (setq ptt (polar pa2 (* pi 1.5) bv)) (polar ptt (* pi 1.75) bv) laythep)
  (setvar "CLAYER" lay))
 ;; MAIN
 (vl-load-com)
 (setq msp     (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
       lay     (getvar "clayer")
       laythep "THEPDOC")
 (create-layer laythep 1 0.4)
 (create-layer "DIM" 8 -3)
 (or (and cd (or (= (type cd) 'int) (= (type cd) 'real))) (setq cd 400))
 (or (and bv (or (= (type bv) 'int) (= (type bv) 'real))) (setq bv 20))
 (setq temp "T")
 (while (= temp "T")
  (initget 0 "Cao Bao")
  (setq pt1 (getpoint
             (strcat "\nCaodam <" (rtos cd 2 0) ">/Baove <" (rtos bv 2 0) ">. Nhap toa do diem dau duoi dam: ")))
  (cond ((= pt1 "Cao")
         (setq cd (cond ((getdist (strcat "\nChieu cao dam <" (rtos cd 2 0) ">:")))
                        (cd))))
        ((= pt1 "Bao")
         (setq bv (cond ((getdist (strcat "\nChieu day lop betong bao ve <" (rtos bv 2 0) ">:")))
                        (bv))))
        ((= pt1 nil) (setq temp nil))
        (t (tiep_theo_qm))))
 (princ))
 

 

 

Cái đó là có dim trước, rồi chia dim khác với topic này.

like. Mai em test lisp bác.:). Code bác viết rành mạch, đẹp thế. Nhiều hàm em chưa bik bao giờ :p

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


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

3 câu dưới đây của bạn thì bạn cứ âm thầm hành động, khỏi reply tốn công người đọc. Chừng nào test xong hẵng trả lời:

1). để em thử ng/c.

2). em chưa test.

3). Mai em test lisp bác.

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

3 câu dưới đây của bạn thì bạn cứ âm thầm hành động, khỏi reply tốn công người đọc. Chừng nào test xong hẵng trả lời:

1). để em thử ng/c.

2). em chưa test.

3). Mai em test lisp bác.

em rút kinh nghiệm. Tại hay vào bằng đt, hóng topic của mình mà. :)

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âng cấp:

1. Chạy với dầm xiên

2. Vẽ luôn thép đai

3. Tính toán số lượng đai và ghi vào dưới dim

4. Có tùy chọn nhập khoảng cách đai, đường kính

P/s: Nếu text của dim dùng Font họ vnsimli.shx, vnsimple.shx ... thì để nguyên ký hiệu Fi (~), loại font khác thì có thể thay đổi thành %%c để có ký hiệu Fi.

 

(defun c:tt  (/ msp lay bv cd pt1 temp create-layer tiep_theo_qm kcach_dau Make_pline mid lthep pt-01 pt-02 goi nhi fi)
 (defun kcach_dau  (mm-am len fac / del l-0)
  (if (eq mm-am t)
   (progn (setq l-0 (/ len 4)
                del (rem l-0 50))
          (if (> del 0)
           (setq l-0 (- l-0 del (/ -50 fac)))))
   (progn (setq l-0 (/ len 6)
                del (rem l-0 (/ 50 fac)))
          (if (> del 0)
           (setq l-0 (- l-0 del)))))
  l-0)
 (defun create-layer  (name color lineWeight)
  (entmakex (list '(0 . "LAYER")
                  (cons 100 "AcDbSymbolTableRecord")
                  (cons 100 "AcDbLayerTableRecord")
                  (cons 2 name)
                  (cons 70 0)
                  (cons 62 color)
                  (cons 6 "Continuous")
                  (cons 370 (fix (* 100 lineWeight))))))
 (defun Make_pline  (listpoint Layer / Lst)
  (setq lst (list '(0 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  (cons 8 layer)
                  (cons 90 (length listpoint))
                  (cons 70 0)))
  (foreach p listpoint (setq lst (append lst (list (cons 10 p)))))
  (entmakex lst))
 (defun mid (p1 p2) (list (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0)))
 ;;; Main defun
 (defun tiep_theo_qm  (/ cdim pt2 kc pd1 pd2 pd3 pa1 pa2 pa3 ang lent p1 p2 p3 p4 p0 i sdg sdn ptn ppn add kcd dng kc1 kc2 kc3 kc4 ncd kcl)
  (if (setq pt-02 (getpoint "\nNhap toa do diem cuoi duoi dam:" pt-01))
   (progn (setq cdim (* (getvar "DIMTXT") (getvar "DIMSCALE"))
                kc   (distance pt-01 pt-02)
                lent (* bv 1.5))
          (if (< (car pt-01) (car pt-02))
           (setq pt1 pt-01
                 pt2 pt-02
                 ang (angle pt-01 pt-02))
           (setq pt1 pt-02
                 pt2 pt-01
                 ang (angle pt-02 pt-01)))
          ;; Momen duong
          (setq pd1 (polar pt1 ang (kcach_dau nil kc 1))
                pd2 (polar pt2 (+ ang (* pi 1.0)) (kcach_dau nil kc 1))
                pd3 (polar pt1 (+ ang (* pi 1.5)) (* cdim 4)))
          (setvar "CLAYER" "DIM")
          (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
                  (mapcar 'vlax-3d-point (list pt1 pd1 pd2))
                  (mapcar 'vlax-3d-point (list pd1 pd2 pt2))
                  (mapcar 'vlax-3d-point (list pd3 pd3 pd3)))
          (setq p2 (polar pd1 (+ ang (* pi 0.5)) bv)
                p1 (polar p2 (+ ang (* pi 0.25)) lent)
                p3 (polar pd2 (+ ang (* pi 0.5)) bv)
                p4 (polar p3 (+ ang (* pi 0.75)) lent))
          (Make_pline (list p1 p2 p3 p4) lthep)
          ;; Momen am
          (setq kcd (kcach_dau t kc 1)
                pt1 (polar pt1 (+ ang (* pi 0.5)) cd)
                pt2 (polar pt2 (+ ang (* pi 0.5)) cd)
                pa1 (polar pt1 (+ ang (* pi 0)) kcd)
                pa2 (polar pt2 (+ ang (* pi 1)) kcd)
                pa3 (polar pt1 (+ ang (* pi 0.5)) (* cdim 4)))
          (setq kc1 (* (1+ (fix (/ kcd goi))) goi)
                kc2 (- kc (* 2 kc1))
                kc3 (* (1- (fix (/ (* kc2 0.5) nhi))) nhi)
                kc4 (- kc2 (* 2 kc3)))
          (setq dng (* (fix (/ (* 0.5 kc2) nhi)) 2))
          (cond ((>= kc4 (* 3.5 nhi)) (setq dng (+ dng 3)))
                ((>= kc4 (* 3.0 nhi)) (setq dng (+ dng 2)))
                ((>= kc4 (* 1.5 nhi)) (setq dng (+ dng 1)))
                (t (setq dng (+ dng 0))))
          (setq sdg (strcat "<>\\X" (itoa (+ (fix (/ kcd goi)) 1)) "~" (itoa fi) "a" (rtos goi 2 0))
                sdn (strcat "<>\\X" (rtos dng 2 0) "~" (itoa fi) "a" (rtos nhi 2 0)))
          (mapcar (function (lambda (x y z s) (vla-put-TextOverride (vla-adddimaligned msp x y z) s)))
                  (mapcar 'vlax-3d-point (list pt1 pa1 pa2))
                  (mapcar 'vlax-3d-point (list pa1 pa2 pt2))
                  (mapcar 'vlax-3d-point (list pa3 pa3 pa3))
                  (list sdg sdn sdg))
          (setq p1 (polar pa1 (+ ang (* pi 1.5)) bv)
                p2 (polar p1 (+ ang (* pi 1.25)) lent))
          (Make_pline (list p1 p2) lthep)
          ;; Ve thep dai ben trai
          ;; Goi
          (setq i  0
                p0 (polar pt1 (* pi 1.5) bv))
          (repeat (+ (fix (/ kcd goi)) 1)
           (Make_pline (list p0 (polar p0 (+ ang (* pi 1.5)) (- cd (* bv 2)))) lthep)
           (setq p0 (polar (polar pt1 (* pi 1.5) bv) (+ ang 0) (* goi (setq i (1+ i))))))
          ;; Nhip
          (setq i   0
                p1  p0
                ncd (* goi (fix (/ kcd goi))))
          (repeat (1- (fix (/ (- kc (* 2 ncd)) (* 2 nhi))))
           (Make_pline (list p0 (polar p0 (+ ang (* pi 1.5)) (- cd (* bv 2)))) lthep)
           (setq p0 (polar p1 (+ ang 0) (* nhi (setq i (1+ i))))))
          (setq ptn p0)
          ;;-----------
          (setq p1 (polar pa2 (+ ang (* pi 1.5)) bv)
                p2 (polar p1 (+ ang (* pi 1.75)) lent))
          (Make_pline (list p1 p2) lthep)
          ;; Ve thep dai ben phai
          ;; Goi
          (setq i  0
                p0 (polar pt2 (* pi 1.5) bv))
          (repeat (+ (fix (/ kcd goi)) 1)
           (Make_pline (list p0 (polar p0 (+ ang (* pi 1.5)) (- cd (* bv 2)))) lthep)
           (setq p0 (polar (polar pt2 (* pi 1.5) bv) (+ ang pi) (* goi (setq i (1+ i))))))
          ;; Nhip
          (setq i  0
                p1 p0)
          (repeat (1- (fix (/ (- kc (* 2 ncd)) (* 2 nhi))))
           (Make_pline (list p0 (polar p0 (+ ang (* pi 1.5)) (- cd (* bv 2)))) lthep)
           (setq p0 (polar p1 (+ ang pi) (* nhi (setq i (1+ i))))))
          (setq ppn p0)
          ;; Bo sung khoang giua
          (setq kcl (distance (polar ptn (+ ang pi) nhi) (polar ppn (+ ang 0) nhi)))
          (cond ((>= kcl (* 3.5 nhi))
                 (Make_pline (list ptn (polar ptn (+ ang (* pi 1.5)) (- cd (* bv 2)))) lthep)
                 (Make_pline (list (mid ptn ppn) (polar (mid ptn ppn) (+ ang (* pi 1.5)) (- cd (* bv 2)))) lthep)
                 (Make_pline (list ppn (polar ppn (+ ang (* pi 1.5)) (- cd (* bv 2)))) lthep))
                ((>= kcl (* 3.0 nhi))
                 (Make_pline (list ptn (polar ptn (+ ang (* pi 1.5)) (- cd (* bv 2)))) lthep)
                 (Make_pline (list ppn (polar ppn (+ ang (* pi 1.5)) (- cd (* bv 2)))) lthep))
                ((>= kcl (* 1.5 nhi))
                 (Make_pline (list (mid ptn ppn) (polar (mid ptn ppn) (+ ang (* pi 1.5)) (- cd (* bv 2)))) lthep)))
          (setvar "CLAYER" lay))))
 ;;; MAIN
 (vl-load-com)
 (setq msp   (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
       lay   (getvar "clayer")
       lthep "THEPDOC")
 (create-layer lthep 1 0.4)
 (create-layer "DIM" 8 -3)
 (or (> (getvar 'USERR1) 0) (setvar 'USERR1 400))
 (or (> (getvar 'USERR2) 0) (setvar 'USERR2 25))
 (or (> (getvar 'USERR3) 0) (setvar 'USERR3 150))
 (or (> (getvar 'USERR4) 0) (setvar 'USERR4 200))
 (or (> (getvar 'USERI5) 0) (setvar 'USERI5 6))
 (or (and cd (or (= (type cd) 'int) (= (type cd) 'real))) (setq cd (getvar 'USERR1)))
 (or (and bv (or (= (type bv) 'int) (= (type bv) 'real))) (setq bv (getvar 'USERR2)))
 (or (and goi (or (= (type goi) 'int) (= (type goi) 'real))) (setq goi (getvar 'USERR3)))
 (or (and nhi (or (= (type nhi) 'int) (= (type nhi) 'real))) (setq nhi (getvar 'USERR4)))
 (or (and fi (= (type fi) 'int)) (setq fi (getvar 'USERI5)))
 (setq temp "T")
 (while (= temp "T")
  (initget 0 "Cao Bao Goi Nhip Kinh")
  (setq pt-01 (getpoint (strcat "\nCaodam <"
                                (rtos cd 2 0)
                                ">/Baove <"
                                (rtos bv 2 0)
                                ">/daiGoi <"
                                (rtos goi 2 0)
                                ">/daiNhip <"
                                (rtos nhi 2 0)
                                ">/duongKinh <"
                                (itoa fi)
                                "> . Nhap toa do diem dau duoi dam: ")))
  (cond ((= pt-01 "Cao")
         (setq cd (cond ((getdist (strcat "\nChieu cao dam <" (rtos cd 2 0) ">:")))
                        (cd)))
         (setvar 'USERR1 cd))
        ((= pt-01 "Bao")
         (setq bv (cond ((getdist (strcat "\nChieu day lop betong bao ve <" (rtos bv 2 0) ">:")))
                        (bv)))
         (setvar 'USERR2 bv))
        ((= pt-01 "Goi")
         (setq goi (cond ((getdist (strcat "\nKhoang cach dai vung goi <" (rtos goi 2 0) ">:")))
                         (goi)))
         (setvar 'USERR3 goi))
        ((= pt-01 "Nhip")
         (setq nhi (cond ((getdist (strcat "\nKhoang cach dai vung nhip <" (rtos nhi 2 0) ">:")))
                         (nhi)))
         (setvar 'USERR4 nhi))
        ((= pt-01 "Kinh")
         (setq fi (cond ((getint (strcat "\nDuong kinh thep dai <" (itoa fi) ">:")))
                        (fi)))
         (setvar 'USERI5 fi))
        ((= pt-01 nil) (setq temp nil))
        (t (tiep_theo_qm))))
 (princ))
  • Vote tăng 1

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


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


ko hiếu sao lisp bác viết (lisp trc) em k dùng dc. báo lỗi ; error: syntax error khi load.
khi gõ lệnh thì lỗi : TABLETYour pointing device cannot be used as a tablet.
lisp xiên em thử cũng k dc. Viết bài ko cho vào quote thì k nhìn thấy bài :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

Không hiểu vì sao mà mình thường phải trả lời câu này:

=> Download bị lỗi thì dùng copy, paste... Chán...Phen này chắc phải làm chữ ký: Bạn hãy copy đừng download... :D

  • 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

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

Đăng nhập để thực hiện theo  

×