- page 204

Info

File

Tác giả: quocmanh04tt
Bài viết gốc: 398558
Tên lệnh: ttd%C2%A0

Thử phát không biết có đúng ý chủ thớt không???

Quét 1 lần ra các kết quả, lấy cái nào thì tùy ý.

(defun c:ttd  (/ els ent i k lst ss str sty ttl)
 (setq ttl 0)
 (if (setq ss (ssget '((0 . "DIMENSION"))))
  (progn (repeat (setq i (sslength ss))
          (setq ent (ssname ss (setq i (1-...
>>

Thử phát không biết có đúng ý chủ thớt không???

Quét 1 lần ra các kết quả, lấy cái nào thì tùy ý.

(defun c:ttd  (/ els ent i k lst ss str sty ttl)
 (setq ttl 0)
 (if (setq ss (ssget '((0 . "DIMENSION"))))
  (progn (repeat (setq i (sslength ss))
          (setq ent (ssname ss (setq i (1- i)))
                els (entget ent)
                sty (cdr (assoc 3 els)))
          (or (not (eq (setq str (atof (cdr (assoc 1 els)))) 0.)) (setq str (cdr (assoc 42 els))))
          (setq ttl (+ ttl str))
          (if (not (assoc sty lst))
           (setq lst (cons (cons sty str) lst))
           (setq lst (subst (cons sty (+ str (cdr (assoc sty lst)))) (assoc sty lst) lst))))
         (foreach x lst (princ (strcat "\n" (car x) ": " (rtos (cdr x)))))
         (princ (strcat "\nTOTAL LENGTH: " (rtos ttl)))
         (textscr)))
 (princ))

Download lisp

Filename: 398558_ttd%C2%A0.lsp

Tác giả: thainguyen_tg
Bài viết gốc: 398620
Tên lệnh: ff

Đóng Ngoặc Text, Mtext, Dim

Trong trường hợp này mình sữa dòng (if (= enttxt "TEXT")

thành dòng (if (= enttxt "*TEXT, *DIMENSION") sao không chon được mtext và dim vậy các bạn(đầu tiên thì chọn được TEXT rồi)? Các bạn sữa hộ giúp mình lsp này với.

;;;*************************DAU PHI***************************
(defun c:ff ()
    (setvar "cmdecho" 0)
    (setq olderr *error* *error* myerror)
    (prompt "\nHay...
>>

Trong trường hợp này mình sữa dòng (if (= enttxt "TEXT")

;;;*************************DAU PHI***************************
(defun c:ff ()
    (setvar "cmdecho" 0)
    (setq olderr *error* *error* myerror)
    (prompt "\nHay chon dong TEXT !... ")
    (prompt "\nSelect objects: ")
    (command "select" "au" pause)
    (setq sstxt (ssget "p")
          sslen (sslength sstxt)
          ctr 0
    )
    (command ".undo" "mark")
    (while (< ctr sslen)
           (setq listxt (entget (ssname sstxt ctr))
                 txttxt (cdr (assoc 1 listxt))
                 enttxt (cdr (assoc 0 listxt))
           )
           (if (= enttxt "TEXT")
               (progn
                   (setq testxt (substr txttxt 1 3))
                   (if (or (= testxt "%%C") (= testxt "%%C"))
                       (setq newtxt (substr txttxt 4))
                       (setq newtxt (strcat "%%C" txttxt))
                   )
                   (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))
                   (entmod listxt)
                )
            )
            (setq ctr (1+ ctr))
    )
    (setq *error* olderr)
    (setvar "cmdecho" 1)
    (princ)
)

Download lisp

Filename: 398620_ff.lsp

Tác giả: quocmanh04tt
Bài viết gốc: 398590
Tên lệnh: fg%C2%A0

?óng Ngo?c Text, Mtext, Dim

Em c?ng tham gia v?i các bác 1 cái (thu?n lisp):

(defun c:fg  (/ els i ss str)
 (if (setq ss (ssget '((0 . "*TEXT,DIMENSION"))))
  (repeat (setq i (sslength ss))
   (setq els (entget (ssname ss (setq i (1- i))))
         str (cdr (assoc 1 els)))
   (if (eq (cdr (assoc 0 els)) "DIMENSION")
    (or (not (eq (setq str (cdr (assoc 1 els))) "")) (setq str...
>>

Em c?ng tham gia v?i các bác 1 cái (thu?n lisp):

(defun c:fg  (/ els i ss str)
 (if (setq ss (ssget '((0 . "*TEXT,DIMENSION"))))
  (repeat (setq i (sslength ss))
   (setq els (entget (ssname ss (setq i (1- i))))
         str (cdr (assoc 1 els)))
   (if (eq (cdr (assoc 0 els)) "DIMENSION")
    (or (not (eq (setq str (cdr (assoc 1 els))) "")) (setq str (rtos (cdr (assoc 42 els))))))
   (setq els (subst (cons 1 (strcat "(" str ")")) (assoc 1 els) els))
   (entmod els)))
 (princ))

Download lisp

Filename: 398590_fg%C2%A0.lsp

Tác giả: hungdlcm
Bài viết gốc: 105775
Tên lệnh: pla

Xem giúp đoạn lisp của mình vẽ pline có nhập chiều dài và góc

Hôm trước bác 18011985 có cho em đoạn lisp để vẽ PLine liên tiếp cho đến khi nào nhấn phím space thì ngưng. Đoạn lisp như này:

Nhưng trong đoạn lisp trên em không hỉu lắm cách thức hoạt động cũng như ý nghĩa của Entity "VERTEX" và "SEQEND". Nếu được bác 18011985 hoặc bác nào hỉu rõ jải thích jùm cho em thông chỗ này nhé.

Cảm ơn các bác. Đừng trách em vì hỏi nhìu...

Download lisp

Filename: 105775_pla.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 398933
Tên lệnh: ha

T?o Danh Sách T? N Ph?n T? Nh?p Vào

Quick code cho bạn cho lẹ.

(defun C:HA(/ l)
(repeat (getint "\nn : ")
(setq l (cons (getreal "Number :") l)))
(reverse l))

Download lisp

Filename: 398933_ha.lsp

Tác giả: lenhatanh
Bài viết gốc: 263123
Tên lệnh: bdt

Về lệnh boundary

Chào các bạn.

Các bạn cho mình hỏi có lệnh hoặc "set" biến hệ thống nào để các Polylines được tạo ra sau khi dùng lệnh "Boundary"

luôn nằm trên cùng (nhìn thấy được theo màu của layer hiện hành).

mình đang dùng CAD-2010.

;; free lisp from cadviet.com
;;; this lisp was downloaded from...
>>

Chào các bạn.

Các bạn cho mình hỏi có lệnh hoặc "set" biến hệ thống nào để các Polylines được tạo ra sau khi dùng lệnh "Boundary"

luôn nằm trên cùng (nhìn thấy được theo màu của layer hiện hành).

mình đang dùng CAD-2010.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/12432-da-xong-nho-giup-lisp-tinh-dien-tich-va-lap-bang/page-2


(defun c:bdt()

(setvar "cmdecho" 0)

(command "undo" "begin")

(setq lacol (getvar "CEColor"))

(setq ladin (getvar "dimzin"))

(setq laos (getvar "osmode"))  

(if (not tl) (setq tl 1))

(if (not h) (setq h 1))

(setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))

    caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >: ")))

(if tl1 (setq tl tl1))

(if caot1 (setq h caot1))

(setq k 0 tdt 0)



(setvar "dimzin" 0)

(setvar "OSMODE" 0)

(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))

(setq     P1 (list (+ (car PT)(* 6 h)) (cadr PT))

    P2 (list (+ (car PT)(* 22 h)) (cadr PT))

    P3 (list (car PT) (- (cadr PT)(* 3 h)))

    P4 (list (car P1) (cadr P3))

    P5 (list (car P2) (cadr P3))

    P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))

    P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))

    P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))

);setq

(command "pline" PT P2 P5 P3 "C"

        "pline" P1 P4 ""

        "text" "m" P6 (* 1.2 h) 0 "%%UB¶ng thèng kª diÖn tÝch"

        "text" "m" P7 h 0 "STT"

        "text" "m" P8 h 0 "DiÖn tÝch (m2)"

);command



(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))

(while (/= pt1 nil)

(command "erase" ss "")

(setq k (+ 1 k))

(command "TEXT" "m" pt1 (* 3 h) 0 (rtos k 2 0))

(setq PT (list (car P3) (cadr P3))

    P1 (list (+ (car PT)(* 6 h)) (cadr PT))

    P2 (list (+ (car PT)(* 22 h)) (cadr PT))

    P3 (list (car PT) (- (cadr PT)(* 3 h)))

    P4 (list (car P1) (cadr P3))

    P5 (list (car P2) (cadr P3))

    P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))

    P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))

    P9 (list (car PT) (- (cadr P3)(* 3 h)))

    P10 (list (car P1) (cadr P9))

    P11 (list (car P2) (cadr P9))

    P12 (list (car P7) (- (cadr P3)(* 1.5 h)))

    P13 (list (car P8) (cadr P12))

    );setq

(setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary

(command "cecolor"4 "-boundary" pt1 "");; boundary

(setq toe (entlast));; chon doi tuong cuoi cung sau khi boundary

(setq cur frome	ss (ssadd) S 0)

(while 	(not (eq cur toe));; chon cac doi tuong tu frome den toe

	(setq cur (entnext cur) ss (ssadd cur ss))

	(command "area" "S" "O" ss "" "")

	(setq dt (getvar "area") S (+ S dt))

);while

(command "area" "A" "O" "L" "" "")

(setq dt (getvar "area"))

(setq S (* (+ S (* dt 2)) tl tl) tdt (+ s tdt))  

(setvar "CEColor" lacol)

(command "pline" PT P2 P5 P3 "C"

	 "pline" P1 P4 ""

	 "text" "m" P7 h 0 (rtos k 2 0)

	 "text" "m" P8 h 0 (rtos s 2 2))

(setq pt1 (getpoint (strcat "\nTong dien tich = " (rtos tdt 2 3) "m2. chon mien do tiep theo...")))

);while

(command "erase" ss "")

(setq ss nil)

(setvar "DIMZIN" ladin)

(command     "pline" P3 P9 P11 P5 "C"

        "pline" P10 P4 ""

        "text" "m" P12 h 0 "Tæng"

        "text" "m" P13 h 0 (rtos tdt 2 2)

);command

(setvar "OSMODE" laos)

(command "undo" "end")

(setvar "cmdecho" 1)

)

Download lisp

Filename: 263123_bdt.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 292194
Tên lệnh: dbcount

lisp chuyển màu các thuộc tính dynamic block

Chẳng hiểu sao dạo này forum lại khó down khó up. Thử kiểu này nữa xem sao:

;;-----------------=={ Dynamic Block Counter }==--------------;;

;; ;;

;; Program will count all blocks, dynamic blocks and xRefs ;;

;; in the current layout, detailing the quantity of blocks ;;

;; assuming each visibility state of every...

Download lisp

Filename: 292194_dbcount.lsp

Tác giả: phamthanhbinh
Bài viết gốc: 391375
Tên lệnh: gpad+%C2%A0

Cách Chuyển Cao Độ Dạng Text (Chữ Số)

Không mở được file khi đã chuyển text thành cao độ ý bác. Em làm lại thì đã mở được nhưng không thể mô hình địa hình được ạ. Bác giúp em với!!!!

Ví dụ file này http://www.cadviet.com/upfiles/5/119084_binh_do_ho_2.dwg của...
>>
Không mở được file khi đã chuyển text thành cao độ ý bác. Em làm lại thì đã mở được nhưng không thể mô hình địa hình được ạ. Bác giúp em với!!!!

Ví dụ file này http://www.cadviet.com/upfiles/5/119084_binh_do_ho_2.dwg của em không vẽ được lưới tám giác và đường đồng mức ạ.

Hề hề hề,

Bạn cho hỏi rằng cái text cao độ của bạn thể hiện cao độ theo đơn vị là m hay là mm?

Nếu là mm thì bạn có thể dùng lisp sau đây để chèn một point vào điểm đặt của text với cao độ là giá trị của text và trả về một list các point này. Từ đó bạn muốn làm chi với nó thì tùy nhé.

http://www.cadviet.com/upfiles/5/5194_chendiem.lsp
(defun c:gpad  ( / sslt pls cd pd p )
(vl-load-com)
(setq sslt (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "docaoct")))))
(setq pls (list))
(foreach tp sslt
       (setq cd (atof (cdr (assoc 1 (entget tp))))
                 pd (cdr (assoc 10 (entget tp)))
                 p (list (car pd) (cadr pd) cd)  )
      (command "point" p )
      (setq pls (append pls (list p)))
)
)
<<

Download lisp

Filename: 391375_gpad+%C2%A0.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 399787
Tên lệnh: cbs

Nh? Ch?nh Lisp C?t Thép D?m Momen

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

Download lisp

Filename: 399787_cbs.lsp

Tác giả: phongtran86
Bài viết gốc: 399773
Tên lệnh: qq

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

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

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

Download lisp

Filename: 399773_qq.lsp

Tác giả: quocmanh04tt
Bài viết gốc: 399937
Tên lệnh: test%C2%A0

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

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

òa... Viết được thì cũng đọc được chứ hả... Thêm nhiều thì cứ copy, paste và edit lại 1 tý thôi mà.

Bạn test nhé:

(defun c:test  (/ bv cd pt1 temp)
 (or (and cd (or (=...
>>

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

òa... Viết được thì cũng đọc được chứ hả... Thêm nhiều thì cứ copy, paste và edit lại 1 tý thôi mà.

Bạn test nhé:

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

Download lisp

Filename: 399937_test%C2%A0.lsp

Tác giả: huunhantvxdts
Bài viết gốc: 400003
Tên lệnh: tacht

Lisp Tính S? L??ng ?ai Và Ghi Ra Thành Text

b?n ?i. Lisp die r?i, b?n up l?i lén dc k

(defun C:tacht (/ ss tong text point giatri)
(vl-load-com)
(defun ss2ent (ss / sodt index lstent)  
(setq sodt (if ss (sslength ss) 0)    
index 0  )  
(repeat sodt 
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent))
)  
(reverse lstent))
(prompt "\nChon doi...
>>

b?n ?i. Lisp die r?i, b?n up l?i lén dc k

(defun C:tacht (/ ss tong text point giatri)
(vl-load-com)
(defun ss2ent (ss / sodt index lstent)  
(setq sodt (if ss (sslength ss) 0)    
index 0  )  
(repeat sodt 
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent))
)  
(reverse lstent))
(prompt "\nChon doi tuong Text.")
(setq ss (ssget '((0 . "TEXT")))
lst (ss2ent ss)
lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))))))) 
(setq tong 0)
(setq chuoi "")
(foreach enxt lst
(setq giatri (cdr (assoc 1 (entget enxt))))
(setq text (substr giatri 1 (- (vl-string-search "C" giatri) 2)))
(setq chuoi (strcat chuoi "+" text))
(setq tong (+ (atof text) tong))
)
(setq chuoi (substr chuoi 2 (- (strlen chuoi) 1)))
(setq point (getpoint "\n Chon diem ghi dien tich: "))
(setq dientext (strcat chuoi " = " (rtos tong 2 0)))
(command "TEXT" point 80 0 dientext)
(princ) 
)

Download lisp

Filename: 400003_tacht.lsp

Tác giả: quocmanh04tt
Bài viết gốc: 400023
Tên lệnh: tt+%C2%A0

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

Nâng cấp:

1. Chạy với dầm xiên

2. Vẽ luôn thép đai

3. Tính toán số lượng đai và ghi vào dưới dim

4. Có tùy chọn nhập khoảng cách đai, đường kính

P/s: Nếu text của dim dùng Font họ vnsimli.shx, vnsimple.shx ... thì để nguyên ký hiệu Fi (~), loại font khác thì có thể thay đổi thành %%c để có ký hiệu Fi.

>>

Nâng cấp:

1. Chạy với dầm xiên

2. Vẽ luôn thép đai

3. Tính toán số lượng đai và ghi vào dưới dim

4. Có tùy chọn nhập khoảng cách đai, đường kính

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

Download lisp

Filename: 400023_tt+%C2%A0.lsp

Tác giả: quocmanh04tt
Bài viết gốc: 400052
Tên lệnh: tt%C2%A0

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

khá tổng quát, bác vẽ cả phần phi thép rồi khoảng cách, rải cả thép đai. quá cả mong đợi.

Bác chỉnh em chút xíu nữa:

-Bác gán thêm dim giữa 2 cột, phần phía trên và phần dưới (điểm cuối của pick lần n với điểm đầu lần n+1)

-Đai dầm bác chỉnh cách mép cột 50 dc k. vẽ nó...

khá tổng quát, bác vẽ cả phần phi thép rồi khoảng cách, rải cả thép đai. quá cả mong đợi.

Bác chỉnh em chút xíu nữa:

-Bác gán thêm dim giữa 2 cột, phần phía trên và phần dưới (điểm cuối của pick lần n với điểm đầu lần n+1)

-Đai dầm bác chỉnh cách mép cột 50 dc k. vẽ nó bị trùng với nét mép cột.

Phần dim của anh có cả thép đai trong đấy rất hay, nhưng như thế k dùng lisp công text để ra số thép đai dc (thống kê)

ĐƯợc voi đòi tiên nhờ Bác viết 1 lisp +tổng số đai kiểu này dc k. :P

Một lisp tách từ lisp trên vẽ momen trên: chọn dim, thông số phi<6>/khoảng cách</150> thì trong dim có thêm thông số về số lượng đai và khoảng cách :3000\X15~6a200. voi lai font họ vnsimli.shx, vnsimple.shx đều gõ %%C để ra phi dc. :D

Một cái máy gặt thực sự thay cho cái liềm. hihi

- %%C ra Phi trong dimtext (font .shx) ký hiêụ rất xấu không cùng dạng.

- Lisp chỉnh sửa đáp ứng các nhu cầu trên (trước khi kết thúc lệnh sẽ có bảng thống kê đai theo từng nhịp).

(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 pcd dim_cot pca ang lst-dai k thong_ke_dai)
 (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)))
 (defun dim_cot  ()
  (if (and pt-02 pcd pca)
   (progn (vla-put-layer (vla-adddimaligned msp (vlax-3d-point pt-02) (vlax-3d-point pt-01) (vlax-3d-point pcd))
                         "DIM")
          (vla-put-layer (vla-adddimaligned msp
                                            (vlax-3d-point (polar pt-02 (+ ang (* 0.5 pi)) cd))
                                            (vlax-3d-point (polar pt-01 (+ ang (* 0.5 pi)) cd))
                                            (vlax-3d-point pca))
                         "DIM"))))
 (defun thong_ke_dai  (/ Text poi htx)
  (defun Text (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str))))
  (setq htx (* (getvar "DIMTXT") (getvar "DIMSCALE")))
  (if (and lst-dai (setq poi (getpoint "\nDiem chen thong ke dai: ")))
   (foreach x  lst-dai
    (Text poi htx (itoa (car x)))
    (Text (polar poi 0 (* 4 htx)) htx (itoa (cadr x)))
    (Text (polar poi 0 (* 8 htx)) htx (itoa (caddr x)))
    (setq poi (polar poi (* 1.5 pi) (* 2.5 htx))))))
;;; Main defun
 (defun tiep_theo_qm  (/ cdim pt2 kc pd1 pd2 pd3 pa1 pa2 pa3 lent p1 p2 p3 p4 p0 i sdg sdn ptn ppn add kcd dng kc1 kc2 kc3 kc4 ncd kcl sdai_n)
  (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))
                pcd pd3)
          (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))
                pca pa3)
          (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 sdai_n (+ (* (+ (fix (/ kcd goi)) 1) 2) dng))
          (setq lst-dai (append lst-dai (list (list k sdai_n fi))))
          (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
                pt1 (polar pt1 ang 50)
                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
                pt2 (polar pt2 (+ ang pi) 50)
                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"
       k    1)
 (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 (dim_cot) (tiep_theo_qm)))
  (setq k (1+ k)))
 (thong_ke_dai)
 (princ))

Download lisp

Filename: 400052_tt%C2%A0.lsp

Tác giả: quocmanh04tt
Bài viết gốc: 399987
Tên lệnh: tt%C2%A0

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

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

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 đó là có dim trước, rồi chia dim khác với topic này.

Download lisp

Filename: 399987_tt%C2%A0.lsp

Tác giả: hainguyen2014
Bài viết gốc: 400111
Tên lệnh: nt

Lisp Nhân Nhi?u S? V?i M?t S? L?a Ch?n

B?n th? xem ?úng ý ch?a nhé!

(prompt "Lenh NT")

(defun C:NT() ;;;;;;;;;; NHAN VOI MOT SO ;;;;;;;;;;;
(command "undo" "BE")
(setq ttt (getreal "Nhap gia tri muon nhan : "))
(setq tp (getint "Nhap so thap phan : "))
(princ "Chon cac Text can nhan:")
(setq ss (ssget '((0 . "TEXT"))))
(setq j -1)
(repeat (sslength ss)
(setq j (+ j 1))
(setq dt1 (ssname ss j))
(setq el (entget dt1) )
(setq gt (cdr (assoc 1 el)...

Download lisp

Filename: 400111_nt.lsp

Tác giả: quocmanh04tt
Bài viết gốc: 400091
Tên lệnh: tt%C2%A0

Nh? Ch?nh Lisp C?t Thép D?m Momen

a? uh! Mi?nh không ?ê? y?:

(defun c:tt  (/ Make-Line ang bv cdi hbv hcd len msp pd3 po1 po2 po3 po4 pt1 pt2 pt3 pt4 tlv p11 p33)
 (defun Make-Line  (p1 p2 lay)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 lay))))
 (vl-load-com)
 (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
       cdi (* (getvar "DIMTXT") (getvar...
>>

a? uh! Mi?nh không ?ê? y?:

(defun c:tt  (/ Make-Line ang bv cdi hbv hcd len msp pd3 po1 po2 po3 po4 pt1 pt2 pt3 pt4 tlv p11 p33)
 (defun Make-Line  (p1 p2 lay)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 lay))))
 (vl-load-com)
 (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
       cdi (* (getvar "DIMTXT") (getvar "DIMSCALE")))
 (if (and (setq pt1 (getpoint "\nDiem p1: "))
          (setq pt2 (getpoint "\nDiem p2: "))
          (setq pt3 (getpoint "\nDiem p3: "))
          (setq pt4 (getpoint "\nDiem p4: "))
          (setq hcd (getdist "\nChieu cao dam: "))
          (setq hbv (getdist "\nChieu day bt bao ve: "))
          (setq tlv (getreal "\nTi le ve <Nhap 20 de co ty le 1/20>:")))
  (progn (setq po1 (polar pt3 (* pi 1.0) (* hcd (/ 100 tlv)))
               po2 (polar po1 (* pi (/ 30 180.0)) 70)
               po3 (polar pt4 (* pi 0.0) (* hcd (/ 100 tlv)))
               po4 (polar po3 (* pi (/ 150 180.0)) 70)
               ang (angle pt1 pt2)
               pd3 (polar pt1 (+ ang (* pi 1.5)) (* cdi 4)))
         (Make-Line po1 po2 "CAT-THEP")
         (Make-Line po3 po4 "CAT-THEP")
         (setq p11 (inters pt1 pt2 po1 (polar po1 (* pi 1.5) hcd))
               p33 (inters pt1 pt2 po3 (polar po3 (* pi 1.5) hcd)))
         (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
                 (mapcar 'vlax-3d-point (list pt1 pt2 p11))
                 (mapcar 'vlax-3d-point (list p11 p33 p33))
                 (mapcar 'vlax-3d-point (list pd3 pd3 pd3)))))
 (princ))

Download lisp

Filename: 400091_tt%C2%A0.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 400117
Tên lệnh: a2t

Chuyển text sẵn có thành ATT

Có l? do forum b? l?i. B?n down l?i nhé.

(defun C:A2T (/ eset1 blkcnt en enlist vl space)
  (setq eset1  (ssget (list (cons 0 "ATTDEF")))
blkcnt 0)
  (if eset1
    (while (<= blkcnt (- (sslength eset1) 1))
      (setq en    (ssname eset1 blkcnt)
   enlist (entget en)
   space  (cdr (assoc 67 enlist)))
      (setq vl (list
(cons 0 "TEXT")
(cons 100...
>>

Có l? do forum b? l?i. B?n down l?i nhé.

(defun C:A2T (/ eset1 blkcnt en enlist vl space)
  (setq eset1  (ssget (list (cons 0 "ATTDEF")))
blkcnt 0)
  (if eset1
    (while (<= blkcnt (- (sslength eset1) 1))
      (setq en    (ssname eset1 blkcnt)
   enlist (entget en)
   space  (cdr (assoc 67 enlist)))
      (setq vl (list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(assoc 7 enlist)
(assoc 8 enlist)
(assoc 10 enlist)
(assoc 40 enlist)
(cond ((assoc 62 enlist))
      ((cons 62 256)))
(cons 1 (cdr (assoc 2 enlist)))
(if (= space nil)
  (cons 67 0)
  (cons 67 space))))
      (entdel en)
      (entmake vl)
      (setq blkcnt (1+ blkcnt)))))

Download lisp

Filename: 400117_a2t.lsp

Tác giả: quocmanh04tt
Bài viết gốc: 400222
Tên lệnh: tt%C2%A0

Nh? Ch?nh Lisp C?t Thép D?m Momen

Theo "Nghị Quyết" của Topic, Lisp 2 ra đời: :D

(defun c:tt  (/ thuc_hien dkd kcd kwo ss)
 (defun thuc_hien  (/ ent i len sld str)
  (or dkd (setq dkd (getvar 'USERI5)))
  (or kcd (setq kcd (getvar 'USERR2)))
  (repeat (setq i (sslength ss))
   (setq ent (ssname ss (setq i (1- i)))
         len (cdr...
>>

Theo "Nghị Quyết" của Topic, Lisp 2 ra đời: :D

(defun c:tt  (/ thuc_hien dkd kcd kwo ss)
 (defun thuc_hien  (/ ent i len sld str)
  (or dkd (setq dkd (getvar 'USERI5)))
  (or kcd (setq kcd (getvar 'USERR2)))
  (repeat (setq i (sslength ss))
   (setq ent (ssname ss (setq i (1- i)))
         len (cdr (assoc 42 (entget ent)))
         sld (1+ (fix (/ len kcd)))
         str (strcat "<>\\X" (itoa sld) "~" (itoa dkd) "a" (rtos kcd 2 0)))
   (vla-put-TextOverride (vlax-ename->vla-object ent) str)))
 (or (> (getvar 'USERI5) 0) (setvar 'USERI5 6))
 (or (> (getvar 'USERR2) 0) (setvar 'USERR2 150))
 (vl-load-com)
 (if (setq ss (ssget '((0 . "DIMENSION"))))
  (progn (setq kwo t)
         (while kwo
          (initget "T K")
          (setq kwo (getkword
                     (strcat "\nThep dai \U+00D8" (itoa (getvar 'USERI5)) " /Khoang cach a" (rtos (getvar 'USERR2) 2 0) " <T or K or Enter to Override>:")))
          (cond ((eq kwo "T")
                 (initget 6)
                 (setq dkd (cond ((getint (strcat "\nDuong kinh thep dai \U+00D8 <" (itoa (getvar 'USERI5)) ">:")))
                                 ((getvar 'USERI5))))
                 (setvar 'USERI5 dkd))
                ((eq kwo "K")
                 (initget 6)
                 (setq kcd (cond ((getreal (strcat "\nKhoang cach thep dai a <" (rtos (getvar 'USERR2) 2 0) ">:")))
                                 ((getvar 'USERR2))))
                 (setvar 'USERR2 kcd))
                (t (setq kwo nil))))
         (thuc_hien)))
 (princ))

Download lisp

Filename: 400222_tt%C2%A0.lsp

Tác giả: phongtran86
Bài viết gốc: 400249
Tên lệnh: tt

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

Nhờ bác thêm vào lisp để nó vẽ đường thẳng từ móc này đến móc kia giùm e với, nó sẽ thành một thanh polyline.

Cảm ơn bác nhiều.

(defun c:tt  (/ Make-Line ang bv cdi hbv hcd len msp pd3 po1 po2 po3 po4 pt1 pt2 pt3 pt4 tlv p11 p33)
;;;ve pline 
(defun Make_pline  (listpoint Layer /...
>>

Nhờ bác thêm vào lisp để nó vẽ đường thẳng từ móc này đến móc kia giùm e với, nó sẽ thành một thanh polyline.

Cảm ơn bác nhiều.

(defun c:tt  (/ Make-Line ang bv cdi hbv hcd len msp pd3 po1 po2 po3 po4 pt1 pt2 pt3 pt4 tlv p11 p33)
;;;ve pline 
(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))
;;;;ham ve pline 
(defun Make-Line  (p1 p2 lay)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 lay))))
 (vl-load-com)
 (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
       cdi (* (getvar "DIMTXT") (getvar "DIMSCALE")))
 (if (and (setq pt1 (getpoint "\nDiem p1: "))
          (setq pt2 (getpoint "\nDiem p2: "))
          (setq pt3 (getpoint "\nDiem p3: "))
          (setq pt4 (getpoint "\nDiem p4: "))
          (setq hcd (getdist "\nChieu cao dam: "))
          (setq hbv (getdist "\nChieu day bt bao ve: "))
          (setq tlv (getreal "\nTi le ve <Nhap 20 de co ty le 1/20>:")))
  (progn (setq po1 (polar (polar pt3 (* pi 1.0) (* hcd (/ 100 tlv))) (* pi 0.5) (* hbv (/ 100 tlv)))
               po2 (polar po1 (* pi (/ 30 180.0)) 70)
               po3 (polar (polar pt4 (* pi 0.0) (* hcd (/ 100 tlv))) (* pi 0.5) (* hbv (/ 100 tlv)))
               po4 (polar po3 (* pi (/ 150 180.0)) 70)
               ang (angle pt1 pt2)
               pd3 (polar pt1 (+ ang (* pi 1.5)) (* cdi 4)))
       (Make_pline (list po2 po1 po3 po4) "CAT-THEP")
        ; (Make-Line po1 po2 "CAT-THEP")
        ; (Make-Line po3 po4 "CAT-THEP")

         (setq p11 (inters pt1 pt2 po1 (polar po1 (* pi 1.5) hcd))
               p33 (inters pt1 pt2 po3 (polar po3 (* pi 1.5) hcd)))
         (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
                 (mapcar 'vlax-3d-point (list pt1 pt2 p11))
                 (mapcar 'vlax-3d-point (list p11 p33 p33))
                 (mapcar 'vlax-3d-point (list pd3 pd3 pd3)))))
 (princ))

Hỗ trợ bác quốc mạnh để bác tập trung giúp em lisp số 3. Bạn thử xem dc chưa

Download lisp

Filename: 400249_tt.lsp

Trang 204/330