Jump to content
InfoFile
Tác giả: quocmanh04tt
Bài viết gốc: 400204
Tên lệnh: tt%C2%A0
Nhờ Chỉnh Lisp Cắt Thép Dầm Momen

Có bác ah, xin lỗi bác đã không nói đầy đủ ý.

Vội nên chưa test, có gì bạn phản hồi nhé!

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

Có bác ah, xin lỗi bác đã không nói đầy đủ ý.

Vội nên chưa test, có gì bạn phản hồi nhé!

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

<<

Filename: 400204_tt%C2%A0.lsp
Tác giả: nnt12yeu
Bài viết gốc: 15414
Tên lệnh: dttd tacht
Viết Lisp theo yêu cầu
em đã có bài tính tổng số lượng các block, tuy nhiên các block của em có kích thước khác nhau (do em scale) vậy bác có cách nào để tính được kích thước (hay diện tích) của block và xuất ra số block cùng tên nhưng có kích thước khác nhau (hay diện tích khác nhau) ko.
ví dụ như:
command: tongbl (enter)
(S)pecifed (enter)
AA (enter)
xuất ra:
9 block AA co dien tich 10 m2
10 block AA co...
>>
em đã có bài tính tổng số lượng các block, tuy nhiên các block của em có kích thước khác nhau (do em scale) vậy bác có cách nào để tính được kích thước (hay diện tích) của block và xuất ra số block cùng tên nhưng có kích thước khác nhau (hay diện tích khác nhau) ko.
ví dụ như:
command: tongbl (enter)
(S)pecifed (enter)
AA (enter)
xuất ra:
9 block AA co dien tich 10 m2
10 block AA co dien tich 20 m2
.......
chẳng hạn
<<

Filename: 15414_dttd_tacht.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 235927
Tên lệnh: hcn
Code lisp như thế nào để hạn chế lỗi cho người dùng?

Thank bác Duy782006. Qua 3 góp ý ở trên, sơ bộ sửa như vầy. Và hình như nó vẫn còn cần bẫy lỗi? Mời tiếp tục!

 

(defun C:HCN( / p1 p3)
 (if
  (and
   (setq p1 (getpoint "\nPick diem 1: "))
   (setq p3 (getcorner p1 "\nPick diem 2: ")))
  (command ".rectang" "non" p1 "non" p3))
 (princ))

Filename: 235927_hcn.lsp
Tác giả: phongtran86
Bài viết gốc: 400283
Tên lệnh: tt
Nhờ Chỉnh Lisp Cắt Thép Dầm Momen

Bác có thể chỉnh giúp khi yêu cầu nhập lớp bảo vê giá trị mặc định là 0 để vẽ móc ngay lớp thép thứ 1. Khi cần vẽ lớp 2 thì mới nhập giá trị cần. Cảm ơn bác.

(defun c:tt  (/ Make-Line...
>>

Bác có thể chỉnh giúp khi yêu cầu nhập lớp bảo vê giá trị mặc định là 0 để vẽ móc ngay lớp thép thứ 1. Khi cần vẽ lớp 2 thì mới nhập giá trị cần. Cảm ơn bác.

(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: "))
(or	hbv  (setq hbv 0))
(setq hbv (cond ((getdist (strcat "\nChieu day lop BT bao ve <" (rtos hbv 2 2) ">: "))) (hbv)))
          (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))

<<

Filename: 400283_tt.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 400309
Tên lệnh: test%C2%A0
Nhờ Viết Hàm Trong Lisp

em biết làm hàm polar rồi. Nhưng lisp em có rất nhiều điểm A như thế cần xác định điểm B. EM muốn tạo funcion ( A, a, apha, beta) để ghi gọi nó tính ra các điểm B luôn. Em k bik cách lập hàm. :(

Test thử nhé!

(defun c:test  (/ a anpha beta...
>>

em biết làm hàm polar rồi. Nhưng lisp em có rất nhiều điểm A như thế cần xác định điểm B. EM muốn tạo funcion ( A, a, apha, beta) để ghi gọi nó tính ra các điểm B luôn. Em k bik cách lập hàm. :(

Test thử nhé!

(defun c:test  (/ a anpha beta pa)
 (setq a 500
       anpha 75
       beta 30)
 (command "Line" (setq pa (getpoint "\nPick point: ")) (b_point pa anpha beta a) ""))
;;----------------
(defun b_point  (pa anpha beta a)
 (polar pa
        (- (* 2 pi) (* pi (/ (* (+ (- 180 anpha) beta) 0.5) 180)))
        (/ a (sin (* pi (/ (* (- 180 (+ anpha beta)) 0.5) 180.))))))

<<

Filename: 400309_test%C2%A0.lsp
Tác giả: traitimgio
Bài viết gốc: 400311
Tên lệnh: test
Nh? Vi?t Hàm Trong Lisp

(defun c:test ()
;;;;;;;;;;;;;;;;
(defun tinhtoado ( point a ang1 ang2 / pB)
(setq pB (polar point (/ (+ pi ( - ang2 ang1)) -2) (/ a (sin (/ (- pi ang1 ang2) -2)))))
)
;;;;;;;;;;;;
(setq pt-01 (getpoint "\nNhap toa do diem 01:"))
(setq pt-02 (getpoint "\nNhap toa do diem 02:"))
(setq pt-03 (getpoint "\nNhap toa do diem 03:"))
(setq ang1 (angle pt-01 pt-02))
(setq ang2 (angle pt-02 pt-03))

(COMMAND "line" (b_point pt-02 ang1 ang2 500)...
>>
(defun c:test ()
;;;;;;;;;;;;;;;;
(defun tinhtoado ( point a ang1 ang2 / pB)
(setq pB (polar point (/ (+ pi ( - ang2 ang1)) -2) (/ a (sin (/ (- pi ang1 ang2) -2)))))
)
;;;;;;;;;;;;
(setq pt-01 (getpoint "\nNhap toa do diem 01:"))
(setq pt-02 (getpoint "\nNhap toa do diem 02:"))
(setq pt-03 (getpoint "\nNhap toa do diem 03:"))
(setq ang1 (angle pt-01 pt-02))
(setq ang2 (angle pt-02 pt-03))

(COMMAND "line" (b_point pt-02 ang1 ang2 500) pt-02)
)
;;----------------
(defun b_point (pa anpha beta a)
(polar pa
(- (* 2 pi) (* pi (/ (* (+ (- 180 anpha) beta) 0.5) 180)))
(/ a (sin (* pi (/ (* (- 180 (+ anpha beta)) 0.5) 180.))))))

em tự lập hàm với thử hàm của bác đều k ra kết quả chuẩn so với hình học tính. với góc anfa= góc( p-01,p-02)=45do, beta= (p-02,p03)=315do a=500.
đây là hình ảnh so với lisp test. hình như nó liên quan đến góc âm, góc dương với 2kPi j đó. bác test giúp em vs
1r5e7d8ppp9npp7zg.jpg

1r5e7d8ppp9npp7zg.jpg


<<

Filename: 400311_test.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 400324
Tên lệnh: tt%C2%A0
Nhờ Viết Hàm Trong Lisp

Vẫn hàm cũ, theo thứ tự pick điểm của bạn nhé!

(Chú ý: cách xác định góc của AutoCAD).

(defun c:tt  (/ ang1 ang2 pt-01 pt-02 pt-03 b_point)
 (defun b_point  (pa anpha beta a)
  (polar pa
         (- (* 2 pi) (* pi (/ (* (+ (- 180 anpha) beta) 0.5) 180)))
         (/ a (sin (* pi (/ (* (- 180 (+ anpha beta)) 0.5)...
>>

Vẫn hàm cũ, theo thứ tự pick điểm của bạn nhé!

(Chú ý: cách xác định góc của AutoCAD).

(defun c:tt  (/ ang1 ang2 pt-01 pt-02 pt-03 b_point)
 (defun b_point  (pa anpha beta a)
  (polar pa
         (- (* 2 pi) (* pi (/ (* (+ (- 180 anpha) beta) 0.5) 180)))
         (/ a (sin (* pi (/ (* (- 180 (+ anpha beta)) 0.5) 180.))))))
 ;;-------------------------------------------------------
 (if (and (setq pt-01 (getpoint "\nNhap toa do diem 01:"))
          (setq pt-02 (getpoint "\nNhap toa do diem 02:"))
          (setq pt-03 (getpoint "\nNhap toa do diem 03:")))
  (progn (setq ang1 (- (angle pt-02 pt-01) pi))
         (setq ang2 (- (* 2 pi) (angle pt-02 pt-03)))
         (COMMAND "line" (b_point pt-02 (* 180.0 (/ ang1 pi)) (* 180.0 (/ ang2 pi)) 500) pt-02 ""))))

<<

Filename: 400324_tt%C2%A0.lsp
Tác giả: Tot77
Bài viết gốc: 400330
Tên lệnh: tt
Nh? Vi?t Hàm Trong Lisp

Có cách này ko c?n quan tâm góc.

 
(defun tt (pt-01 pt-02 pt-03 a / ANG1 ANG2 ANG3) 
(if (and pt-01 pt-02 pt-03 a) 
(progn
(setq ang1 (angle pt-01 pt-02)
ang2 (angle pt-01 pt-03)
ang3 (* 0.5 (+ ang1 ang2))
)
(COMMAND "line" (polar pt-01 ang3 (/ a (sin (abs (- ang1 ang3))))) pt-01 "")))
)
(defun c:tt() (tt (getpoint "\nP1:") (getpoint "\nP2:") (getpoint "\nP3:") (getreal "\nOffset:")))

Filename: 400330_tt.lsp
Tác giả: quansla
Bài viết gốc: 400281
Tên lệnh: ll2
[Nhờ Vả] Xin Sửa Giúp Lisp Dành Cho Vẽ Mũi Tên Dạng Leader Bằng Lwpolyline

Thành quả cuối cùng, tạm sửa như vầy, mong mọi người tối ưu giùm vì nó còn khá nhiều bất tiện

(defun ve_PLine_q(/ lst_str p0 str)
(setq lst_str
(list
(cons "A" "Specify endpoint of arc or\n:")
(cons "L" "Specify next point or :")
(cons "H" "Specify starting/ending half-width ")
))
(setq p0 (getpoint "\nChon diem thu nhat"))
(setq str "Chon diem tiep theo")
(command "PLINE" p0
(while (> (getvar "cmdactive")...

>>

Thành quả cuối cùng, tạm sửa như vầy, mong mọi người tối ưu giùm vì nó còn khá nhiều bất tiện

(defun ve_PLine_q(/ lst_str p0 str)
(setq lst_str
(list
(cons "A" "Specify endpoint of arc or\n:")
(cons "L" "Specify next point or :")
(cons "H" "Specify starting/ending half-width ")
))
(setq p0 (getpoint "\nChon diem thu nhat"))
(setq str "Chon diem tiep theo")
(command "PLINE" p0
(while (> (getvar "cmdactive") 0)
(progn
(initget "A H L U W CE LC D C L R S")
(setq p0 (getpoint (getvar "lastpoint") (strcat "\n" str)))
(cond
((= (type p0) 'LIST) (command p0))
((= (type p0) 'STR)
(command p0)
(setq str (cdr (assoc p0 lst_str)))
)
((not p0) (command ""))
)
)
))
)



(defun c:ll2 (/ arr_leng arr_size el en_luu ls_10 ls_10_x1 ls_10_x2 ls_not10 r2)
(vl-load-com)
(setq arr_size 50.0 arr_leng 150.0 el (entlast))

(ve_PLine_q)
(if (and (/= el (entlast))
(setq en_luu (entget (entlast)))
(= (cdr(assoc 0 en_luu)) "LWPOLYLINE"))
(progn
;(alert "\nThuc hien chuyen doi")
(setq ls_10 (vl-remove-if '(lambda(x) (not(member (car x) '(10 40 41 42 91)))) en_luu)
ls_10_x1 (list (car ls_10) (cadr ls_10) (caddr ls_10) (cadddr ls_10) (car(cddddr ls_10)))
ls_10_x2 (cdr(cddddr ls_10))
ls_not10 (vl-remove-if '(lambda(x) (member (car x) '(5 330 -1 8 90 43 10 40 41 42 91))) en_luu))
(setq r2 (append
(subst (cons 41 arr_size) (assoc 41 ls_10_x1)ls_10_x1)
(list
(cons 10 (polar (cdr(car ls_10_x1)) (angle (cdr(car ls_10_x1)) (cdr(car ls_10_x2))) arr_leng))
(cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 91 0))
ls_10_x2))
(while (entnext el) (entdel (setq el (entnext el))))
(entmakex
(append
ls_not10
(list (cons 8 "0"))
(list (cons 90 (1+ (length ls_10))))
r2))
)
(princ "nothing do")
))


<<

Filename: 400281_ll2.lsp
Tác giả: traitimgio
Bài viết gốc: 400337
Tên lệnh: tt
Nhờ Viết Hàm Trong Lisp

Có cách này ko cần quan tâm góc.

 
(defun tt (pt-01 pt-02 pt-03 a / ANG1 ANG2 ANG3) 
(if (and pt-01 pt-02 pt-03 a) 
(progn
(setq ang1 (angle pt-01 pt-02)
ang2 (angle pt-01 pt-03)
ang3 (* 0.5 (+ ang1 ang2))
)
(COMMAND "line" (polar pt-01 ang3 (/ a (sin (abs (- ang1 ang3))))) pt-01 "")))
)
(defun c:tt() (tt (getpoint "\nP1:") (getpoint...
>>

Có cách này ko cần quan tâm góc.

 
(defun tt (pt-01 pt-02 pt-03 a / ANG1 ANG2 ANG3) 
(if (and pt-01 pt-02 pt-03 a) 
(progn
(setq ang1 (angle pt-01 pt-02)
ang2 (angle pt-01 pt-03)
ang3 (* 0.5 (+ ang1 ang2))
)
(COMMAND "line" (polar pt-01 ang3 (/ a (sin (abs (- ang1 ang3))))) pt-01 "")))
)
(defun c:tt() (tt (getpoint "\nP1:") (getpoint "\nP2:") (getpoint "\nP3:") (getreal "\nOffset:")))

pt_01 là điểm giữa.

cách này hay. em sửa lại chút để làm chỉ xuất ra tọa độ điểm B. còn lệnh thực hiện với điểm đó k phải line, line chỉ để test thôi.
(defun tt (pt-01 pt-02 pt-03 a / ANG1 ANG2 ANG3) 
(if (and pt-01 pt-02 pt-03 a) 
(progn
(setq ang1 (angle pt-01 pt-02)
ang2 (angle pt-01 pt-03)
ang3 (* 0.5 (+ ang1 ang2)))
(setq pb (polar pt-01 ang3 (/ a (sin (abs (- ang1 ang3))))) ))))
(defun c:tt () 
(COMMAND "line" (tt (getpoint "\nP1:") (getpoint "\nP2:") (getpoint "\nP3:") (getreal "\nOffset:")) pt-01 ""))
 vậy mà  khi gõ lệnh tt nhập điểm xong, báo lỗi ko hiểu lệnh tt

<<

Filename: 400337_tt.lsp
Tác giả: quansla
Bài viết gốc: 400274
Tên lệnh: qqtt
[Nhờ Vả] Xin Sửa Giúp Lisp Dành Cho Vẽ Mũi Tên Dạng Leader Bằng Lwpolyline
Chào các bác, em có biết một chút về LISP nên có tự viết 1 lisp sau (mục tiêu của Lisp là vẽ mũi tên ghi chú bằng LWPolyline (không phải Leader của Cad, bởi vì Leader nhiều khi không tạo được hình dáng đẹp như LWPolyline)) có điều LISP đang KHỒNG HOẠT ĐỘNG
xin các bác sửa giúp em để có thể chạy được
(vấn đề gặp phải trong CODE Dòng (command "PLINE") và dòng (alert "Thuc hien chuyen doi") nhẽ ra...
>>
Chào các bác, em có biết một chút về LISP nên có tự viết 1 lisp sau (mục tiêu của Lisp là vẽ mũi tên ghi chú bằng LWPolyline (không phải Leader của Cad, bởi vì Leader nhiều khi không tạo được hình dáng đẹp như LWPolyline)) có điều LISP đang KHỒNG HOẠT ĐỘNG
xin các bác sửa giúp em để có thể chạy được
(vấn đề gặp phải trong CODE Dòng (command "PLINE") và dòng (alert "Thuc hien chuyen doi") nhẽ ra như mong muốn là phải thực hiện xong lệnh PLINE có đội tượng LWPolyline xong hết rồi, mới làm đến các lệnh kể từ (alert "Thuc hien chuyen doi") đổ đi, nhưng hiện tại dòng (command "PLINE") không chịu hoàn thành trả kết quả trước)
Đây là file, mong các bác giúp em
(defun c:qqtt (/ arr_leng arr_size el en_luu ls ls_10 ls_not10 r2 x)
(vl-load-com)
(setq arr_size 50.0 arr_leng 150.0 el (entlast))

(command "Pline")
;(while (> (getvar "cmdactive" ) 0) )
(if (and (/= el (entlast))
(setq en_luu (entget (entlast)))
(= (cdr(assoc 0 en_luu)) "LWPOLYLINE"))
(progn
(alert "\nThuc hien chuyen doi")
(setq ls_10 (vl-remove-if '(lambda(x) (not(member (car x) '(10)))) en_luu)
ls_not10 (vl-remove-if '(lambda(x) (member (car x) '(5 330 -1 8 90 43 10 40 41 42 91))) en_luu))
(setq r2 (append
(list (car ls_10) (cons 40 0.0) (cons 41 arr_size) (cons 42 0.0) (cons 91 0))
(list (cons 10 (polar (cdr(car ls_10)) (angle (cdr(car ls_10)) (cdr(cadr ls_10))) arr_leng))
(cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 91 0))
(apply 'append
(mapcar '(lambda(x)
(list x (cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 91 0)))
(cdr ls_10)))
))
(while (entnext el) (entdel (setq el (entnext el))))
(entmakex
(append
ls_not10
(list (cons 8 "0"))
(list (cons 90 (1+ (length ls_10))))
r2))
;(entmakex (append ls_not10 ls))
)
(princ "nothing do")
))



Nếu có thể xin hãy giữ lại toàn bộ các lựa chọn vẽ của lệnh LWPOLyline như mặc định của CAD khi thực hiện lệnh vẽ LWpolyline (tức vẫn lựa chọn được "A;C;H;L;U;W;L" trong ( :)
<<

Filename: 400274_qqtt.lsp
Tác giả: quansla
Bài viết gốc: 400149
Tên lệnh: tta
Chuyển Text Att Về Text

Lệnh Burst là chuyển block ATT về block thường
Chứ nó k chuyển được text ATT thanh text

Mình vẫn dùng cái này này

(defun c:tta (/ en sset ostr str osty sty olay lay ospt
spt ojpt jpt otxht txht otxwd txwd orot rot
oaln1 aln1 olan2 aln2 angd stytbl cursty curht
curwd curobl curupdn curlastht curfont just
newattrib...

>>

Lệnh Burst là chuyển block ATT về block thường
Chứ nó k chuyển được text ATT thanh text

Mình vẫn dùng cái này này

(defun c:tta (/ en sset ostr str osty sty olay lay ospt
spt ojpt jpt otxht txht otxwd txwd orot rot
oaln1 aln1 olan2 aln2 angd stytbl cursty curht
curwd curobl curupdn curlastht curfont just
newattrib entjunk junkpoint origcol col ocol)

(command "undo" "begin")
(SETVAR "CMDECHO" 0)
(graphscr)


;(prompt "\nSelect text object to change.")
(setq sset (entsel "\nSelect text object to change."))
(if (null sset)
(progn
(princ "\nNo objects selected.")
(exit)
)
)
(setq en (entget (car sset))
ostr (assoc 1 en)
str (cdr ostr)
osty (assoc 7 en)
sty (cdr osty)
olay (assoc 8 en)
lay (cdr olay)
ospt (assoc 10 en)
spt (cdr ospt)
ojpt (assoc 11 en)
jpt (cdr ojpt)
otxht (assoc 40 en)
txht (cdr otxht)
otxwd (assoc 41 en)
txwd (cdr otxwd)
orot (assoc 50 en)
rot (cdr orot)
ocol (assoc 62 en)
col (cdr ocol)
oaln1 (assoc 72 en)
aln1 (cdr oaln1)
oaln2 (assoc 73 en)
aln2 (cdr oaln2)
angd (/ (* rot 180) pi)
) ;end_setq en
(setq stytbl (tblsearch "style" sty)
cursty (cdr (assoc 2 stytbl))
curht (cdr (assoc 40 stytbl))
curwd (cdr (assoc 41 stytbl))
curobl (cdr (assoc 50 stytbl))
curupdn (cdr (assoc 71 stytbl))
curlastht (cdr (assoc 42 stytbl))
curfont (cdr (assoc 3 stytbl))
)


(command "-style" sty curfont 0 txwd 0 "n" "n" (if (> (getvar "cmdactive") 0)(command "n")))


(command "erase" sset "")

(cond
((= aln1 5)(setq horiz-just "fit"))
((= aln1 3)(setq horiz-just "aligned"))
((= aln1 4)(setq horiz-just "M"))
((= aln1 2)(setq horiz-just "R"))
((= aln1 1)(setq horiz-just "C"))
((= aln1 0)(setq horiz-just "L"))
)

(cond
((= aln2 0)(setq vert-just ""))
((= aln2 1)(setq vert-just "B"))
((= aln2 2)(setq vert-just "M"))
((= aln2 3)(setq vert-just "T"))
)

(setq just (strcat vert-just horiz-just))

(cond
((= just "aligned")(command "-attdef" "" str str str "S" sty "j" "aligned" spt jpt))
((= just "fit")(command "-attdef" "" str str str "S" sty "j" "fit" spt jpt txht))
((= just "L")(command "-attdef" "" str str str "S" sty spt txht (angtos rot)))
((or (/= just "aligned")(/= just "fit")(/= just "L"))(command "-attdef" "" str str str "S" sty "j" just spt txht (angtos rot)))
)


(setq newattrib (entlast))
(setq entjunk (entget newattrib))
(setq junkpoint (cdr (assoc 10 entjunk)))
(command "move" newattrib "" junkpoint spt)

(cond
((= col nil)(setq origcol "bylayer"))
((= col 0) (setq origcol "byblock"))
((or (/= col nil)(/= col 0))(setq origcol col))
)

(command "change" newattrib "" "p" "c" origcol "layer" lay "")

(command "-style" sty curfont curht curwd curobl "n" "n" (if (> (getvar "cmdactive") 0)(command "n")))


(command "undo" "end")
)


<<

Filename: 400149_tta.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 400372
Tên lệnh: tt%C2%A0
Nhờ Viết Hàm Trong Lisp

Thiếu rau thì bổ sung bát canh chua vậy:

(defun b_point  (pt1 pt2 pt3 a b / ag1 ag2 phi len bet)
  (setq ag1 (angle pt2 pt1)
        ag2 (angle pt2 pt3)
        phi (- ag2 ag1)
        bet (atan (/ (* a (sin phi)) (+ (* a (cos phi)) b)))
        len (/ a (sin bet)))
  (polar pt2 (+...
>>

Thiếu rau thì bổ sung bát canh chua vậy:

(defun b_point  (pt1 pt2 pt3 a b / ag1 ag2 phi len bet)
  (setq ag1 (angle pt2 pt1)
        ag2 (angle pt2 pt3)
        phi (- ag2 ag1)
        bet (atan (/ (* a (sin phi)) (+ (* a (cos phi)) b)))
        len (/ a (sin bet)))
  (polar pt2 (+ ag1 bet) len))
;;----------------------------
(defun c:tt  (/ pt-01 pt-02 pt-03)
 (if (and (setq pt-01 (getpoint "\nNhap toa do diem 01:"))
          (setq pt-02 (getpoint "\nNhap toa do diem 02:" pt-01))
          (setq pt-03 (getpoint "\nNhap toa do diem 03:" pt-02)))
  (command "Line" "none" (b_point pt-01 pt-02 pt-03 900 500) pt-02 ""))
 (princ))

P/s: Thứ tự p1, p2, p3 thuận chiều kim đồng hồ, p2 nằm ở đỉnh.


<<

Filename: 400372_tt%C2%A0.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 400545
Tên lệnh: ha
Chuy?n ???ng Cong Tròn, Spline Thành Pline G?m Nhi?u ?o?n Th?ng Nh? N?i L?i

Cho b?n 1 cái t?m nè! L?nh: HA

(defun HA:ListPoints1 (ent len / x lenc lst)
 (setq x 0 lenc (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) lst (cons (vlax-curve-getpointatdist ent x) lst))
 (while (< (setq x (+ x len)) lenc)
  (setq lst (cons (vlax-curve-getpointatdist ent x) lst)))
 (reverse (setq lst (cons (vlax-curve-getEndpoint ent) lst))))
(defun LWPoly (lst cls)
 (entmake (append (list (cons...
>>

Cho b?n 1 cái t?m nè! L?nh: HA

(defun HA:ListPoints1 (ent len / x lenc lst)
 (setq x 0 lenc (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) lst (cons (vlax-curve-getpointatdist ent x) lst))
 (while (< (setq x (+ x len)) lenc)
  (setq lst (cons (vlax-curve-getpointatdist ent x) lst)))
 (reverse (setq lst (cons (vlax-curve-getEndpoint ent) lst))))
(defun LWPoly (lst cls)
 (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline")
   (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))))
;-----(vlax-curve-isclosed ent)
(defun C:HA()
 (setq ent (car (entsel "\nChon Curve de Convert: ")))
 (setq lst (HA:ListPoints1 ent 100))
 (LWPoly lst 0)
 (princ))

<<

Filename: 400545_ha.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 400599
Tên lệnh: mddc
Viết Lisp Kéo Đường Pline Địa Chất Vào Đường Pline Tự Nhiên Bằng 2 Điểm Pick

Các anh Pro ơi, giúp e viết Lisp kéo đường Pline địa chất vào đường Pline tự nhiên bằng 2 điểm Pick giống trong video này được k ạ. Em rất mong sự giúp đỡ của các anh. Cảm ơn các anh

https://www.youtube.com/watch?v=6UL7PV2k3Ck

>>

Các anh Pro ơi, giúp e viết Lisp kéo đường Pline địa chất vào đường Pline tự nhiên bằng 2 điểm Pick giống trong video này được k ạ. Em rất mong sự giúp đỡ của các anh. Cảm ơn các anh

https://www.youtube.com/watch?v=6UL7PV2k3Ck

http://www.cadviet.com/upfiles/6/152227_file_test.dwg

Hề hề hề,

Không hiểu lắm yêu cầu của bạn nên mình viết đại theo cái sự hiểu của mình. Bạn dùng thử coi đã ưng ý chưa và nếu cần sửa thì post lên để mình xem lại.

(defun c:mddc (/ ent1 ent2 ent3 p1 p2 pt )
(setq ent1 (car (entsel "\n Chon pline dia chat "))
          ent2 (car (entsel "\n Chon pline tu nhien"))
          pt (getpoint "\n Chon tim coc")  )
(command "undo" "be")
(command "xline" "v" pt "")
(setq ent3 (entlast)
          p1 (car (acet-geom-intersectwith ent1 ent3 0))
          p2 (car (acet-geom-intersectwith ent2 ent3 0)) )
(command "move" ent1 "" p1 p2)
(command "erase" ent3 "")
(command "undo" "e")
(princ)
)

<<

Filename: 400599_mddc.lsp
Tác giả: ssg
Bài viết gốc: 15439
Tên lệnh: hd
Xường cơ khí nhỏ

Ha ha, bái phục bác ksgia! Khi nào có dịp đúc nhôm, ssg cũng thử làm vài cái vòi ấm theo kiểu này nấu nước uống chơi!

Filename: 15439_hd.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 400984
Tên lệnh: bx by
[Yêu Cầu] Lisp Đổi Dấu Scale X, Scale Y Của Block

 

Xin các bạn giúp cho cái lisp này để thuận tiện hơn trong công việc.
 
Tôi muốn đổi dấu cho tỷ lệ X và Y của block (từ + sang - hoặc từ - sang +) để nó có thể lật qua , lật lại quanh điểm insert theo các hướng X và Y
 
Cái này nó cũng giống như FLIP...
>>

 

Xin các bạn giúp cho cái lisp này để thuận tiện hơn trong công việc.
 
Tôi muốn đổi dấu cho tỷ lệ X và Y của block (từ + sang - hoặc từ - sang +) để nó có thể lật qua , lật lại quanh điểm insert theo các hướng X và Y
 
Cái này nó cũng giống như FLIP trong dynamic block. Nhưng ở đây tôi phải chọn nhiều block cùng lúc và thực hiện lệnh thì mới nhanh được , chứ click vào từng block ròi flip từng cái thì lâu quá.
 
Chẳng hạn tôi muốn gọi lệnh bx để đổi dấu cho scale X, lệnh by để đổi dấu cho scale Y.
 
gọi lệnh trước rồi chọn đối tượng hay chọn đối tượng trước rồi gọi lệnh đều được.
 
tôi cũng muốn học lisp rồi tự viết cho tiện. Khổ nỗi thời gian ngặt nghèo quá nên đành nhờ trợ giúp. Hy vọng lisp này cũng có ích với nhiều người khác và như vậy thì sự đòi hỏi của tôi cũng không đến nỗi "ích kỷ"
XIN CẢM ƠN.

 

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

(defun getscale_blk  (/ ent i ss)
 (if (setq ss (ssget '((0 . "INSERT"))))
  (repeat (setq i (sslength ss))
   (setq ent (ssname ss (setq i (1- i)))
         blk (vlax-ename->vla-object ent)
         scx (* (vlax-get blk 'XScaleFactor) -1)
         scy (* (vlax-get blk 'YScaleFactor) -1)))))
(defun c:bx (/ blk scx scy)
 (and (getscale_blk)
      (vlax-put blk 'XScaleFactor scx))(princ))
(defun c:by (/ blk scx scy)
 (and (getscale_blk)
      (vlax-put blk 'YScaleFactor scy))(princ))
(vl-load-com)

<<

Filename: 400984_bx_by.lsp
Tác giả: phongtran86
Bài viết gốc: 400993
Tên lệnh: ll lgt lc ln lh l%2F lmh
Lisp các phép tính đại số tự động cập nhật khi giá trị nguồn thay đổi

 

 
 

;;;============================================================================================
;;;-------------------LINK GIA TRI CUA DOI TUONG NAY DEN DOI TUONG TEXT KHAC...
>>

 

 
 

;;;============================================================================================
;;;-------------------LINK GIA TRI CUA DOI TUONG NAY DEN DOI TUONG TEXT KHAC (>=Cad2006)-------
;;;============================================================================================
(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
(defun LM:ObjectID ( obj )
    (eval
        (list 'defun 'LM:ObjectID '( obj )
            (if
                (and
                    (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                    (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                )
                (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:ObjectID obj)
)
;;;----------------------------------------
;;;LINK CHIEU DAI
(defun C:LL (/ obn Tkq)
	(START_PG)
	(setq obn (vlax-ename->vla-object (car (entsel "\nChon doi tuong nguon")))
				obd	(vlax-ename->vla-object (car (nentsel "\nChon text ghi chieu dai")))
				ltr	(I_INT0 "\n Nhap chu so lam tron" ltr)
				hso	(I_REAL "\n Nhap he so nhan" hso)
				Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "
										(LM:ObjectID obn)
										">%).Length \\f \"%lu2"
										"%pr" (rtos ltr 2 0)
										"%ct8"
										"\">%"
						)

	)
	(vla-put-textstring obd Tkq)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK GIA TRI
(defun C:LGT (/ obn Tkq)
	(START_PG)
	(setq obn (vlax-ename->vla-object (car (nentsel "\nChon doi tuong nguon")))
				obd	(vlax-ename->vla-object (car (nentsel "\nChon text dich")))
				Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "
										(LM:ObjectID obn)
										">%).TextString>%"
						)
	)
	(vla-put-textstring obd Tkq)
	(vla-update obd)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TONG
(defun C:LC (/ obn Lob Tgt)
	(START_PG) 
	(setq	ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				Tgt "%<\\AcExpr (0")
	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tong/ENTER de ket thuc chon..."))
		(setq Tgt	(strcat Tgt "+"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object obn))
											">%).TextString>%"
							)
		)
	)
 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))
	(EX_VALUE_T_P_L Tgt (car Lob))
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TICH
(defun C:LN (/ Tgt obn Lob)
	(START_PG)
	(setq	ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				Tgt 	"%<\\AcExpr (1"
	)
	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tich/ENTER de ket thuc chon..."))
		(setq Tgt	(strcat Tgt "*"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object obn))
											">%).TextString>%"
							)
		)
	)
 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))
	(EX_VALUE_T_P_L Tgt (car Lob))
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK HIEU

(defun C:LH (/ Tgt ent1 ent2)
	(START_PG)
	(setq ltr		(I_INT0 "\n Nhap chu so lam tron" ltr))
	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so bi tru..."))))
	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so tru..."))))
	(setq ent1 (car (C_S2L ss1))
				ent2 (car (C_S2L ss2))
	)
	(setq Tgt	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											"-"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2%pr" (itoa ltr) "\""
										">%"
						)
	)
	(EX_VALUE_T_P_L Tgt ent1)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK CHIA

(defun C:L/ (/ Tgt ent1 ent2)
	(START_PG)
	(setq ltr		(I_INT0 "\n Nhap chu so lam tron" ltr))
	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so BI CHIA..."))))
	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so CHIA.."))))
	(setq ent1 	(car (C_S2L ss1))
				ent2 	(car (C_S2L ss2))
	)
	(setq Tgt	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											"/"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2%pr" (itoa ltr) "\""
										">%"
						)
	)
	(EX_VALUE_T_P_L Tgt ent1)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TONG
(defun C:LMH (/ Lst1 Lst2 Lst3 Tgt dem pt1 ob Tj) ;;;Link Multi Hang
	(START_PG) 
	(setq	42pan	(I_KEY "\n Tinh Cong/Nhan/CHia <C/N/CH>" "C N CH" 42pan)
				ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				hso		(I_REAL "\n Nhap he so nhan" hso)
				Lst1	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu nhat...")))
				Lst2	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu hai...")))
				Lst3	(OD_SSY_DES_L (C_S2L (S_TM "\nChon cot ket qua/ENTER de xuat ke qua...")))
				Tgt 	"%<\\AcExpr (0"
				dem		0
	)
	(if (null Lst3)
		(while (null (setq pt1 (getpoint "\n X dat cot: "))))
	)
	(if (/= (length Lst1) (length Lst2))
		(progn
			(alert "So hang cua 2 cot khong bang nhau. Chon lai")
			(exit)
		)
	)
	(repeat (length Lst1)
		(setq ent1 (nth dem Lst1)
					ent2 (nth dem Lst2)
		)
		(if Lst3
			(setq ent3 (nth dem Lst3))
			(setq ent3 nil)
		)
		(setq dem (1+ dem))
		(cond	(	(= 42pan "C")
						(setq Tgt	(CALC_LINK ent1 ent2 "+" ltr hso))
					)
					(	(= 42pan "N")
						(setq Tgt	(CALC_LINK ent1 ent2 "*" ltr hso))
					)
					(	(= 42pan "CH")
						(setq Tgt	(CALC_LINK ent1 ent2 "/" ltr hso))
					)
		)
		(if	(/= ent3 nil)
			(progn
				(setq ob (entget ent3))
				(entmod (subst (cons 1 Tgt) (assoc 1 ob) ob))
			)
			(progn
				(if	(and (= (cadr (assoc 11 (entget ent1))) 0.0)
								 (= (caddr (assoc 11 (entget ent1))) 0.0)
						)
					(setq Tj 10)
					(setq Tj 11)
				)
				(setq	ent1	(entget ent1)
							pt1		(list (car pt1) (caddr (assoc Tj ent1)))
			 	)
				(entmakex (list	'(0 . "TEXT")
												'(100 . "AcDbEntity")
												(assoc 8 ent1)
												'(100 . "AcDbText")
												(cons Tj pt1)
												(assoc 40 ent1)
												(cons 1 Tgt)
												(assoc 50 ent1)
												(assoc 41 ent1)
												(assoc 51 ent1)
												(assoc 7 ent1)
												(assoc 71 ent1)
												(assoc 72 ent1)
												'(100 . "AcDbText")
												(assoc 73 ent1)
									)
				)
			)
		)
	)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)
;;;============================================================================================
;;;---------------------------------PHEP TINH TOAN VOI LINK------------------------------------
;;;============================================================================================

(defun CALC_LINK (ent1 ent2 ptinh ltr hso)
	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											ptinh
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2"
															"%pr" (itoa ltr)
															"%ct8\""
					">%"
	)
)


(defun OWNER_ENAME (obn)
	(vlax-vla-object->ename
		(vla-objectidtoobject
			(vla-get-activedocument (vlax-get-acad-object))
			(vla-get-ownerid
				(vlax-ename->vla-object obn)
			)
		)
	)
)

;;;----------------------------------------------------------
;;;HAM LUU BAT DAU VA KET THUC CHUONG TRINH
(C:EXPRESSTOOLS)
;;;===============================================================
;;;---------- CAC HAM THIET LAP BAY LOI, RESTORE------------------
;;;===============================================================

;;;HAM BAY LOI
(defun INIT	()
	(setq	OLD_ERROR	*error*
				*error*	MYERROR
	)
	(command "Undo" "begin")
)

(defun MYERROR (errmsg)

	(cond
		((= errmsg "quit / exit abort")
		 (princ)
		)
		((/= errmsg "Function cancelled")
		 (princ (strcat "\n Co loi: " errmsg))
		)
	)

	(setvar "osmode" OLD_OSMODE)
	(setvar "AUTOSNAP" OLD_AUTOSNAP)
	(setvar "ORTHOMODE" OLD_ORTHOMODE)
	(setvar "DIMZIN" OLD_DIMZIN)
	(setvar "clayer" OLD_CLAYER)
	(setvar "CECOLOR" OLD_CECOLOR)
	(setvar "cmdecho" 1)
	(command "Undo" "end")
	(DONE)
	(prompt "\n Da Reset lai thiet lap ban dau")


)

(defun DONE	()
	(if	OLD_ERROR
		(setq *error* OLD_ERROR)
	)
)
;;;----------------------------------------------------------
;;;HAM LUU VA TRA LAI CAC THONG SO BAN DAU
(defun SAVE_MODE ()

	(setvar "cmdecho" 0)
	(command "Undo" "begin")
	(command "UCS" "W")
	(setq	OLD_OSMODE		(getvar "OSMODE")
				OLD_CECOLOR		(getvar "CECOLOR")
				OLD_AUTOSNAP	(getvar "AUTOSNAP")
				OLD_ORTHOMODE	(getvar "ORTHOMODE")
				OLD_CLAYER		(getvar "clayer")
				OLD_DIMZIN		(getvar "DIMZIN")
	)
	(setvar "DIMZIN" 0)

)
(defun RESTORE ()

	(setvar "osmode" OLD_OSMODE)
	(setvar "AUTOSNAP" OLD_AUTOSNAP)
	(setvar "ORTHOMODE" OLD_ORTHOMODE)
	(setvar "DIMZIN" OLD_DIMZIN)
	(setvar "clayer" OLD_CLAYER)
	(setvar "CECOLOR" OLD_CECOLOR)
	(command "Undo" "end")
	(setvar "cmdecho" 1)
	(Grtext -1 "Copyright by Nataca - 0983.715.333")
)
(defun START_PG	(/ ss)
	(setq ss (ssget "I"))

	(INIT)
	(SAVE_MODE)
	(sssetfirst nil ss)
)

(defun END_PG	()
	(DONE)
	(RESTORE)
)
;;;------------------------------------------
;;;NHAP GIA TRI LA SO NGUYEN ( BAO GOM CA SO 0)
(defun I_INT0	(dongnhac Tso)
	(if	(null Tso)
		(progn
			(initget (+ 1 4))
			(getint (strcat dongnhac " <?>:"))
		)
		(progn
			(cond
				((progn
					 (initget 4)
					 (getint (strcat dongnhac " < " (itoa Tso) " >:"))
				 )
				)
				(T Tso)

			)
		)

	)
)
;;;NHAP GIA TRI LA SO THUC
(defun I_REAL	(dongnhac Tso / Tso1)
	(if	(null Tso)
		(progn
			(initget (+ 1 2))
			(setq Tso (getdist (strcat dongnhac " <?>:")))
			(princ (strcat "\nGia tri vua nhap la: " (rtos Tso 2 5)))
			Tso
		)
		(progn
			(cond
				((progn
					 (initget (+ 2))
					 (setq Tso1 (getdist (strcat dongnhac " < " (rtos Tso 2 5) " >:")))
					 (if Tso1
						 (progn
							 (princ (strcat "\nGia tri vua nhap la: " (rtos Tso1 2 5)))
							 (setq Tso Tso1)
						 )
					 )
				 )
				)
				(T Tso)

			)
		)

	)
)
;;;------------------------------------------
;;;CHON LIEN TIEP NHIEU DOI TUONG THEO PHUONG PHAP PICK KEM DONG NHAC (BAT BUOC CHON)
(defun ES_ENT_LMP	(dongnhac / Lsel sel mouse ew)   ;;;LMP = List Multi Pick
	(prompt dongnhac)
	(while (/= (car mouse) 2)
		(setq mouse (grread 0 15 2))
		(if	(= (car mouse) 3)
	 		(if (setq sel (car (nentselp (cadr mouse))))
				(progn
					(setq Lsel (append Lsel (list sel)))
					(princ (strcat "\n" (itoa (length Lsel)) " doi tuong duoc pick chon/ENTER ke ket thuc chon"))
				)
				(princ "\nChon chua dung!")
			)
		)
	)
	Lsel
)

;;;------------------------------------------
;;;XUAT/EDIT KET QUA VOI TEXT MAU BANG CACH PICK DIEM (EDIT CA ATTRIBUTE, DUNG CHO LINK GIA TRI)
(defun EX_VALUE_T_P_L	(Tkq Tmau / mouse sel pt1 ob kq1 Elst Tj caoText oldTsize oldTstyle)
;;;Real+interge
	(prompt "\n Chon text chua kq / An enter de viet text kq...")
	(while (and (/= (car mouse) 2) (null sel))
		(setq mouse (grread 0 15 2))
		(if	(= (car mouse) 3)
			(if (null (setq sel (car (nentselp (cadr mouse)))))
					(princ "\nChon chua dung! Chon lai...")
			)
		)
	)
	(if	(/= sel nil)
		(progn
			(setq ob (entget sel))
			(entmod (subst (cons 1 Tkq) (assoc 1 ob) ob))
		)
		(progn
			(while (null (setq pt1 (getpoint "\n Diem dat text: "))))
			(if	Tmau
				(progn
					(if	(and (= (cadr (assoc 11 (entget Tmau))) 0.0)
									 (= (caddr (assoc 11 (entget Tmau))) 0.0)
							)
						(setq Tj 10)
						(setq Tj 11)
					)
					(setq	Tmau	(entget Tmau))
					(entmakex (list	'(0 . "TEXT")
													'(100 . "AcDbEntity")
													(assoc 8 Tmau)
													'(100 . "AcDbText")
													(cons Tj pt1)
													(assoc 40 Tmau)
													(cons 1 Tkq)
													(assoc 50 Tmau)
													(assoc 41 Tmau)
													(assoc 51 Tmau)
													(assoc 7 Tmau)
													(assoc 71 Tmau)
													(assoc 72 Tmau)
													'(100 . "AcDbText")
													(assoc 73 Tmau)
										)
					)
				)
			)
		)
	)

)

;;;------------------------------------------
;;;CHON TEXT VA DIMENSION KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM&D (dongnhac / ss)
	(while (and	(not (prompt dongnhac))
							(not (or (setq ss (ssget "I" '((0 . "*TEXT,DIMENSION"))))
											 (setq ss (ssget '((0 . "*TEXT,DIMENSION"))))
									 )
							)
				 )
	)
	ss
)
;;;CHUYEN BIEU DIEN TAP HOP DOI TUONG DUOI DANG LIST CHUA ENAME CUA CAC DOI TUONG
(defun C_S2L (ss)
	(if	ss
		(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		nil
	)
)

;;;------------------------------------------
;;;NHAP KEY VAO
(defun I_KEY (dongnhac key Text)

	(if	(null Text)
		(progn
			(initget 1 key)
			(getkword (strcat dongnhac " :"))
		)
		(progn
			(cond
				((progn
					 (initget key)
					 (getkword (strcat dongnhac " < " Text " >:"))
				 )
				)
				(T Text)

			)
		)

	)
)

(defun OD_SSY_DES_L	(Lst)
	(setq	lst	(vl-sort lst
										 '(lambda	(e1 e2)
												(>
													(caddr (assoc
																	 (if (and	(= (cadr (assoc 11 (entget e1))) 0.0)
																						(= (caddr (assoc 11 (entget e1))) 0.0)
																			 )
																		 10
																		 11
																	 )
																	 (entget e1)
																 )
													)
													(caddr (assoc
																	 (if (and	(= (cadr (assoc 11 (entget e2))) 0.0)
																						(= (caddr (assoc 11 (entget e2))) 0.0)
																			 )
																		 10
																		 11
																	 )
																	 (entget e2)
																 )
													)
												)
											)
						)
	)
)

;;;------------------------------------------
;;;CHON TEXT, MTEXT KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM (dongnhac / ss)
	(while (and	(not (prompt dongnhac))
							(not (or (setq ss (ssget "I" '((0 . "*TEXT"))))
											 (setq ss (ssget '((0 . "*TEXT"))))
									 )
							)
				 )
	)
	ss
)

;;;CHON TEXT, MTEXT KEM DONG NHAC
(defun S_TM	(dongnhac / ss)
	(prompt dongnhac)
	(if	(null (setq ss (ssget "I" '((0 . "*TEXT")))))
		(setq ss (ssget '((0 . "*TEXT"))))
	)
	ss
)

lisp s?a ch?y dc trên cad 64 bit


<<

Filename: 400993_ll_lgt_lc_ln_lh_l%2F_lmh.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 401018
Tên lệnh: bx by
[Yêu Cầu] Lisp Đổi Dấu Scale X, Scale Y Của Block

Xin lỗi các bác...! Sai cơ bản :D

Em sửa lại đây:

(vl-load-com)
(defun getscale_blk  (x / blk ent i scx scy ss)
 (if (setq ss (ssget '((0 . "INSERT"))))
  (repeat (setq i (sslength ss))
   (setq ent (ssname ss (setq i (1- i)))
         blk (vlax-ename->vla-object ent)
         scx (* (vlax-get blk 'XScaleFactor)...
>>

Xin lỗi các bác...! Sai cơ bản :D

Em sửa lại đây:

(vl-load-com)
(defun getscale_blk  (x / blk ent i scx scy ss)
 (if (setq ss (ssget '((0 . "INSERT"))))
  (repeat (setq i (sslength ss))
   (setq ent (ssname ss (setq i (1- i)))
         blk (vlax-ename->vla-object ent)
         scx (* (vlax-get blk 'XScaleFactor) -1)
         scy (* (vlax-get blk 'YScaleFactor) -1))
   (if (eq x t)
    (vlax-put blk 'XScaleFactor scx)
    (vlax-put blk 'YScaleFactor scy))))(princ))
(defun c:bx () (getscale_blk t))
(defun c:by () (getscale_blk nil))

<<

Filename: 401018_bx_by.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 401072
Tên lệnh: ha
(Yêu C?u) Nh? Các Bác Vi?t Lisp Tính Theo Công Th?c (Text S? A - Text S? B)/ Text S? C Sau ?ó Dán Vào 1 Text Cho Tr??c.

?ây!

(defun C:HA(/ a b c )
 (vl-load-com)
 (setq a (distof (cdr (assoc 1 (entget (car (entsel "\nText a: ")))))))
 (setq b (distof (cdr (assoc 1 (entget (car (entsel "\nText b: ")))))))
 (setq c (distof (cdr (assoc 1 (entget (car (entsel "\nText c: ")))))))
 (vla-put-textstring (vlax-ename->vla-object (car (entsel "\nText ket qua: "))) (rtos (/ (- a b) c) 2 2))
 (princ))

Filename: 401072_ha.lsp

Trang 205/304

205