Jump to content
InfoFile
Tác giả: quansla
Bài viết gốc: 263885
Tên lệnh: bang cuu chuong
mọi người chỉ mình cách viết lisp hiện bảng cửu chương với

  • Xác định yêu cầu bài toán: Viết chương trình bằng LISP và xuất ra bảng cửu chương từ 2-10.
  • Xác định thuật toán:...Người dùng nhập vào điểm đặt A, chiều cao Text H, xuất ra bảng cửu chương bằng cách: cho một biến i chạy từ 1-10, biến j chạy từ 1-10, mỗi lần chạy biến j nhảy điểm đặt (A + độ dời Y) Phun dòng Text "i*j = kq" với i,j là số, kq...
    >>

  • Xác định yêu cầu bài toán: Viết chương trình bằng LISP và xuất ra bảng cửu chương từ 2-10.
  • Xác định thuật toán:...Người dùng nhập vào điểm đặt A, chiều cao Text H, xuất ra bảng cửu chương bằng cách: cho một biến i chạy từ 1-10, biến j chạy từ 1-10, mỗi lần chạy biến j nhảy điểm đặt (A + độ dời Y) Phun dòng Text "i*j = kq" với i,j là số, kq là số (tích của i*j) , mỗi lần chạy hết biến j, thì tăng i và nhảy điểm đặt  (A + độ dời phương X) lặp lại quá trình của j
  • Xác định biến : điểm đặt A, chiều cao Text, biến i, j, kq.
  • Đi vào viết chương trình.
http://www.cadviet.com/upfiles/3/101306_bang_cuu_chuong.lsp

(defun c:bang_cuu_chuong(/ i j kq A p H ) ; khai bao ten lenh LISP; khai bao bien dia phuong
  (if (and
(setq A (getpoint "\nChon diem chen bang cuu chuong"))
(or (setq H (getint "\nchon chieu cao Text")) (setq H 250))
)
    ;doan (and ...) dung de neu nguoi dung nhap du 2 giu kien A,H thi lam tiep phan (progn ...) con k0 thi thoat lenh
    (progn
      (setq lst '(1 2 3 4 5 6 7 8 9 10)) ; tao truoc mot list '(1 2 3 4 5 6 7 8 9 10)
      (setq ls1 lst ls2 lst) ; khoi tao ls1, ls2 (i thuoc ls1, j thuoc ls2)
      (foreach i ls1 ; chay bien i trong ls1
(setq p A) ; Khoi tao bien p, gan gia tri ban dau la diem chen A
(foreach j ls2 ; chay bien j trong ls2
 (setq kq (* i j)) ; tinh kq = i * j
 (entmakex ; toan bo phan (entmakex ...)dung de tao ra mot doi tuong Text nhu mo ta trong Code
   (list
     (cons 0 "TEXT")
     (cons 100 "AcDbEntity")
     (cons 100 "AcDbText")
     (cons 10 p)
     (cons 11 p)
     (cons 40 H)
     (cons 1 (strcat (rtos i 2 0) " * " (rtos j 2 0) " = " (rtos kq 2 0))))) ; ket thu (entmakex)
 (setq p (polar p (/ pi -2) (* 3 H))) ; Den day thi tang bien j, gan lai gia tri cua p (truot p xuong Duoi(nguoc chieu Y) mot doan 3H
 ) ; Ket thuc cong viec cua bien j, tang bien i, lap lai cong viec bien j
(setq A (polar A 0 (* 15 H))))) ; Gan lai gia tri bien A, la vi tri chen bang cuu chuong cu, bang vi tri chen cot i cua bang cuu chuong
    ) ; Ket thuc cong viec, chay bien i, chay bien j
  (princ)) ;END LISP


<<

Filename: 263885_bang_cuu_chuong.lsp
Tác giả: gia_bach
Bài viết gốc: 263969
Tên lệnh: ptb1
hỏi cách viết chương trình giải phương trình bậc nhất và bậc 2

bạn muốn viết bằng ngôn ngữ gì thì phải nói cả ra chứ ?

Cậu này muốn làm khó member mới ?

Post vào topic AutoLisp thì viết bằng VB ?!

el_nino20xx
>>

bạn muốn viết bằng ngôn ngữ gì thì phải nói cả ra chứ ?

Cậu này muốn làm khó member mới ?

Post vào topic AutoLisp thì viết bằng VB ?!

el_nino20xx tham khảo giải Pt bậc 1 : (týõng tự, Pt bậc 2 thì biện luận các t/hợp nhý SGK)
(defun c:ptb1 (/ a b)
  (princ "Giai PT bac 1 : aX + b = 0")
  (if (and (setq a (getreal (strcat "\nNhap he so a =")) )
	   (setq b (getreal (strcat "\nNhap he so b =")) ))
    (if (= a 0)
      (if (= b 0)
	(princ "PT co vo so nghiem")
	(princ "PT vo nghiem"))      
      (princ (strcat "Nghiem PT la : X= " (rtos (* -1(/ b a)))))))
  (princ))

<<

Filename: 263969_ptb1.lsp
Tác giả: gia_bach
Bài viết gốc: 264257
Tên lệnh: entpro2ex
Giup viet lisp

Mong tìm được sự giúp đỡ, viết lisp theo file đính kèm, e có tìm một số lisp nhưng không theo yêu cầu công việc của e, xin mọi người giúp đỡ.

 

Mong tìm được sự giúp đỡ, viết lisp theo file đính kèm, e có tìm một số lisp nhưng không theo yêu cầu công việc của e, xin mọi người giúp đỡ.

 

http://www.cadviet.com/upfiles/3/65580_giup_do_xuat_du_lieu_cad_sang_excel.rar

http://www.cadviet.com/upfiles/3/65580_untitled33333333_1.pdf

Thử Lisp này xem sao ?

(defun c:entPro2Ex (/ col e i prolst pros row ss x xlapp xlcells)
  ;; By : Gia_Bach 2013 ;;
  (defun getProEnt(e / area bl heigh leng maxp minp obj tr width)
    (setq obj (vlax-Ename->Vla-Object e)
	  leng (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
	  area (vlax-curve-getArea obj))
    (vla-getBoundingBox obj 'minp 'maxp )
    (setq TR (vlax-safearray->list maxp) BL (vlax-safearray->list minp)
	  width (- (car TR) (car BL)) heigh(- (cadr TR) (cadr BL)))
    (list (rtos width 2 0) (rtos heigh 2 0) (rtos leng 2 0) (rtos area 2 0))  )
  ; main
  (if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*POLYLINE,SPLINE"))))
    (progn
      (setq i -1)
      (repeat (sslength ss)
	(setq e (ssname ss (setq i (1+ i)))
	      pros (getProEnt e)
	      proLst (append proLst (list pros))))
      (setq xlApp (vlax-get-or-create-object "Excel.Application")
	    xlCells (vlax-get-property(vlax-get-property(vlax-get-property(vlax-invoke-method(vlax-get-property xlApp "Workbooks") "Add") "Sheets") "Item" 1) "Cells"))
      (setq col 2)
      (foreach pt (list "Length (mm)" "Witdth (mm)" "Perimeter" "Area")
	(vlax-put-property xlCells 'Item 1 col pt)
	(setq col (1+ col)))
      (setq col 1 row 2)	
      (foreach pt proLst
	(vlax-put-property xlCells 'Item row col (- row 1))
	(setq col (1+ col))
	(foreach str pt
	  (vlax-put-property xlCells 'Item row col str)
	  (setq col (1+ col)))
	(setq row (1+ row) col 1) )
      (vla-put-visible xlApp :vlax-true)
      (mapcar (function (lambda (x) (vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x)))))))	(list xlCells xlApp)) ))
  (princ))

<<

Filename: 264257_entpro2ex.lsp
Tác giả: Namvanvo
Bài viết gốc: 264186
Tên lệnh: hcn
mọi người giúp mình cách viết chương trình tính chu vi,diện tích với

Bạn dùng thử xem có cần chỉnh lại chỗ nào không nhé, lệnh tắt là hcn 

(defun C:hcn(/ d r p)
  (setq old (mapcar 'getvar '("osmode" "cmdecho")))
(mapcar 'setvar '("osmode" "cmdecho") '(0 0))
  (initget 1)
  (setq d (getdist "\nSpecify length for rectangles:"))
  (initget 1)
  (setq r (getdist "\nSpecify width for rectangles:"))
  (initget 1)
  (setq p (getpoint "\nSpecify first corner:"))
  (command ".rectang" p...
>>
Bạn dùng thử xem có cần chỉnh lại chỗ nào không nhé, lệnh tắt là hcn 

(defun C:hcn(/ d r p)
  (setq old (mapcar 'getvar '("osmode" "cmdecho")))
(mapcar 'setvar '("osmode" "cmdecho") '(0 0))
  (initget 1)
  (setq d (getdist "\nSpecify length for rectangles:"))
  (initget 1)
  (setq r (getdist "\nSpecify width for rectangles:"))
  (initget 1)
  (setq p (getpoint "\nSpecify first corner:"))
  (command ".rectang" p (strcat "@" (rtos d 2 4) "," (rtos r 2 4)))
  (command ".area" "object" (entlast))
  (alert (strcat  "\nDien tich hcn :" (rtos (getvar 'area) 2 4)
 "\nChu vi hcn :" (rtos (getvar 'perimeter) 2 4)))
  (princ)
  (princ (strcat  "\nDien tich hcn :" (rtos (getvar 'area) 2 4)))
  (princ (strcat  "\nChu vi hcn :" (rtos (getvar 'perimeter) 2 4)))
  (mapcar 'setvar '("osmode" "cmdecho") old)
  (princ)
  )

<<

Filename: 264186_hcn.lsp
Tác giả: quansla
Bài viết gốc: 264388
Tên lệnh: gt
Nhờ viết lisp đo khoảng cách và ghi ra text có sẵn

Hề hề hề,
Có phải cái nè không hè???
http://www.cadviet.com/upfiles/3/5194_ghikc.lsp

Code của bác Bình

(defun c:gt (/ p1 p2 txt etxt d)
(setq p1 (getpoint "\n Chon diem thu nhat")
          p2 (getpoint "\n Chon diem thu hai ")
          txt...
>>

Hề hề hề,
Có phải cái nè không hè???
http://www.cadviet.com/upfiles/3/5194_ghikc.lsp

Code của bác Bình

(defun c:gt (/ p1 p2 txt etxt d)
(setq p1 (getpoint "\n Chon diem thu nhat")
          p2 (getpoint "\n Chon diem thu hai ")
          txt (car (entsel "\n Chon text can thay" ))
          d (distance p1 p2)
         etxt (entget txt)
         etxt (subst (cons 1 (rtos d 2 2)) (assoc 1 etxt) etxt)
)
(entmod etxt)
(princ)
)

Có khi ý chủ thớt lại thế này bác ạ. E sửa luôn trên Code bác nhé.

(defun c:gt (/ p1 p2 txt etxt d str)
(setvar "cmdecho" 0)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat"))
(setq p2 (getpoint p1 "\n Chon diem thu hai "))
(setq txt (car (entsel "\n Chon text can thay" ))))
(progn
(command "undo" "begin")
(setq d (distance p1 p2) etxt (entget txt))
(setq str (strcat "\n" (cdr(assoc 1 etxt)) " + " (rtos d 2 2) " = " (rtos (+ d (atof(cdr(assoc 1 etxt)))) 2 2)))
(entmod(subst(cons 1 (rtos (+ d (atof (cdr(assoc 1 etxt)))) 2 2)) (assoc 1 etxt) etxt))
(command "undo" "end")
(princ str)
(princ)
)
)
(setvar "cmdecho" 1)
(princ)
)

<<

Filename: 264388_gt.lsp
Tác giả: quansla
Bài viết gốc: 264389
Tên lệnh: gt
Nhờ viết lisp đo khoảng cách và ghi ra text có sẵn

Hề hề hề,
Có phải cái nè không hè???
http://www.cadviet.com/upfiles/3/5194_ghikc.lsp

Code của bác Bình

(defun c:gt (/ p1 p2 txt etxt d)
(setq p1 (getpoint "\n Chon diem thu nhat")
          p2 (getpoint "\n Chon diem thu hai ")
          txt...
>>

Hề hề hề,
Có phải cái nè không hè???
http://www.cadviet.com/upfiles/3/5194_ghikc.lsp

Code của bác Bình

(defun c:gt (/ p1 p2 txt etxt d)
(setq p1 (getpoint "\n Chon diem thu nhat")
          p2 (getpoint "\n Chon diem thu hai ")
          txt (car (entsel "\n Chon text can thay" ))
          d (distance p1 p2)
         etxt (entget txt)
         etxt (subst (cons 1 (rtos d 2 2)) (assoc 1 etxt) etxt)
)
(entmod etxt)
(princ)
)

Có khi ý chủ thớt lại thế này bác ạ. E sửa luôn trên Code bác nhé.

(defun c:gt (/ p1 p2 txt etxt d str)
(setvar "cmdecho" 0)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat"))
(setq p2 (getpoint p1 "\n Chon diem thu hai "))
(setq txt (car (entsel "\n Chon text can thay" ))))
(progn
(command "undo" "begin")
(setq d (distance p1 p2) etxt (entget txt))
(setq str (strcat "\n" (cdr(assoc 1 etxt)) " + " (rtos d 2 2) " = " (rtos (+ d (atof(cdr(assoc 1 etxt)))) 2 2)))
(entmod(subst(cons 1 (rtos (+ d (atof (cdr(assoc 1 etxt)))) 2 2)) (assoc 1 etxt) etxt))
(command "undo" "end")
(princ str)
(princ)
)
)
(setvar "cmdecho" 1)
(princ)
)

<<

Filename: 264389_gt.lsp
Tác giả: gia_bach
Bài viết gốc: 264551
Tên lệnh: entpro2ex
Giup viet lisp

....

Khi chọn nhiều đa giác xuất ra execl thì trên exxcel có xuất phần số thứ tự. Mình không biết các đa giác đó hiện nằm trong vùng nào.

Anh có thể bổ sung việc đánh số đó vào cad theo đúng phần đã xuất giúp mình với.

....

Update theo yêu cầu.

- chiều cao text lấy theo biến...

>>

....

Khi chọn nhiều đa giác xuất ra execl thì trên exxcel có xuất phần số thứ tự. Mình không biết các đa giác đó hiện nằm trong vùng nào.

Anh có thể bổ sung việc đánh số đó vào cad theo đúng phần đã xuất giúp mình với.

....

Update theo yêu cầu.

- chiều cao text lấy theo biến hệ thống TextSize

- số chữ số thập phân lấy theo biến hệ thống Luprec (giống như trong Cad)

(defun c:entPro2Ex (/ col i obj prolst pros row sosole spc ss x xlapp xlcells)
  ;; By : Gia_Bach 2013 ;;
  (vl-load-com)
  (defun getProEnt(obj sole / area bl cen heigh leng maxp minp obj tr width)
    (setq leng (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
	  area (vlax-curve-getArea obj))
    (vla-getBoundingBox obj 'minp 'maxp )
    (setq TR (vlax-safearray->list maxp) BL (vlax-safearray->list minp)
	  width (- (car TR) (car BL)) heigh(- (cadr TR) (cadr BL))
	  cen (mapcar '(lambda (a b) (/ (+ a b) 2.0)) TR BL))
    (list cen (rtos width 2 sole) (rtos heigh 2 sole) (rtos leng 2 sole) (rtos area 2 sole))  )
  ; main
  (if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*POLYLINE,SPLINE"))))
    (progn
      (setq i -1 sosole (getvar "luprec"))
      (repeat (sslength ss)
	(setq obj (vlax-Ename->Vla-Object(ssname ss (setq i (1+ i))))
	      pros (getProEnt obj sosole)
	      proLst (append proLst (list pros))))
      (setq xlApp (vlax-get-or-create-object "Excel.Application")
	    xlCells (vlax-get-property(vlax-get-property(vlax-get-property(vlax-invoke-method(vlax-get-property xlApp "Workbooks") "Add") "Sheets") "Item" 1) "Cells"))
      (setq col 2 spc (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object))))
      (foreach pt (list "Length (mm)" "Witdth (mm)" "Perimeter" "Area")
	(vlax-put-property xlCells 'Item 1 col pt)
	(setq col (1+ col)))
      (setq col 1 row 2 txtheight (getvar "TextSize"))
      (foreach pt proLst
	(vla-AddText spc (- row 1) (vlax-3D-point (car pt)) txtheight)
	(vlax-put-property xlCells 'Item row col (- row 1))
	(setq col (1+ col))
	(foreach str (cdr pt)
	  (vlax-put-property xlCells 'Item row col str)
	  (setq col (1+ col)))
	(setq row (1+ row) col 1) )
      (vla-put-visible xlApp :vlax-true)
      (mapcar (function (lambda (x) (vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x)))))))	(list xlCells xlApp)) ))
  (princ))

<<

Filename: 264551_entpro2ex.lsp
Tác giả: cd2k44
Bài viết gốc: 264625
Tên lệnh: gt
Nhờ viết lisp đo khoảng cách và ghi ra text có sẵn

(defun c:gt (/ p1 p2 txt etxt d str)
(setvar "cmdecho" 0)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat"))
(setq p2 (getpoint p1 "\n Chon diem thu hai "))
(setq txt (car (entsel "\n Chon text can thay" ))))
(progn
(command "undo" "begin")
(setq d (distance p1 p2) etxt (entget txt))
(setq str (strcat "\n" (cdr(assoc 1 etxt)) " + " (rtos d 2 2) " = " (rtos (+ d (atof(cdr(assoc 1 etxt)))) 2 2)))
(entmod(subst(cons 1 (rtos (+ d (atof (cdr(assoc 1...

>>

(defun c:gt (/ p1 p2 txt etxt d str)
(setvar "cmdecho" 0)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat"))
(setq p2 (getpoint p1 "\n Chon diem thu hai "))
(setq txt (car (entsel "\n Chon text can thay" ))))
(progn
(command "undo" "begin")
(setq d (distance p1 p2) etxt (entget txt))
(setq str (strcat "\n" (cdr(assoc 1 etxt)) " + " (rtos d 2 2) " = " (rtos (+ d (atof(cdr(assoc 1 etxt)))) 2 2)))
(entmod(subst(cons 1 (rtos (+ d (atof (cdr(assoc 1 etxt)))) 2 2)) (assoc 1 etxt) etxt))
(command "change" txt "" "p" "c" 1 "")
(command "undo" "end")
(princ str)
(princ)
)
)
(setvar "cmdecho" 1)
(princ)
)

bạn thử xem đứng ý bạn không


<<

Filename: 264625_gt.lsp
Tác giả: Namvanvo
Bài viết gốc: 264434
Tên lệnh: p2
hỏi cách viết chương trình giải phương trình bậc nhất và bậc 2
Mấy bác làm khó member mới quá :D , chắc máy tính casio fx 570es plus của bạn í bị hư rồi nên mới cần lisp này để học toán chăng?  :wacko:
Bạn El_ninoxx dùng thử cái Casio này xem:

(defun C:p2(/ a b c delta)
  (initget 2)
  (setq a (getreal "\nNhap he so a: ")
b (getreal "\nNhap he so b: ")
c (getreal "\nNhap he so c: ")
delta (- (expt b 2) (* 4 a c))
b (- 0 B))
  (if (< delta 0) (princ "\n Phuong...
>>
Mấy bác làm khó member mới quá :D , chắc máy tính casio fx 570es plus của bạn í bị hư rồi nên mới cần lisp này để học toán chăng?  :wacko:
Bạn El_ninoxx dùng thử cái Casio này xem:

(defun C:p2(/ a b c delta)
  (initget 2)
  (setq a (getreal "\nNhap he so a: ")
b (getreal "\nNhap he so b: ")
c (getreal "\nNhap he so c: ")
delta (- (expt b 2) (* 4 a c))
b (- 0 B))
  (if (< delta 0) (princ "\n Phuong trinh bac hai vo nghiem :D")
     (if (= delta 0)
   (progn
     (alert (strcat "\nPhuong trinh bac hai co nghiem kep: "
      "\n X1=X2=" (rtos (/ (+ b (sqrt delta)) 2 a) 2 4)))
     (princ (strcat "\nPhuong trinh bac hai co nghiem kep: "
      "\n X1=X2=" (rtos (/ (+ b (sqrt delta)) 2 a) 2 4)))
     )      
   (progn
     (alert (strcat  "\n Phuong trinh co 2 nghiem: "
      "\n X1=" (rtos (/ (+ b (sqrt delta)) 2 a) 2 4)
      "\n X2=" (rtos (/ (- b (sqrt delta)) 2 a) 2 4)))
     (princ (strcat  "\n Phuong trinh co 2 nghiem: "
      "\n X1=" (rtos (/ (+ b (sqrt delta)) 2 a) 2 4)
      "\n X2=" (rtos (/ (- b (sqrt delta)) 2 a) 2 4)))
     )
  )
    )
  (princ)
  )

<<

Filename: 264434_p2.lsp
Tác giả: cd2k44
Bài viết gốc: 264800
Tên lệnh: sht
Nhờ viết lisp xuất tọa độ x,y,giá trị cao độ text (theo ví dụ đính kèm)

(Defun c:sht ( / picset Idx Entt PLis)
(If (Setq picset (Ssget (List (Cons 0 "*TEXT"))))
(Progn
(Setq Idx 0)
(Repeat (SSlength picset)
(Setq Entt (Entget (SSname picset Idx)))
(If (And (Or (Equal (Cdr (Assoc 0 Entt)) "TEXT") ;;Doi tuong la TEXT
(Equal (Cdr (Assoc 0 Entt)) "MTEXT") ;;Hoac doi tuong la MTEXT
)
(Numberp (Read (Cdr (Assoc 1 Entt)))) ;;La TEXT dang chu so
)
(Progn
(Setq Pnt (List (Cadr (Assoc 10 Entt)) (Caddr (Assoc 10 Entt)) (AtoF...

>>

(Defun c:sht ( / picset Idx Entt PLis)
(If (Setq picset (Ssget (List (Cons 0 "*TEXT"))))
(Progn
(Setq Idx 0)
(Repeat (SSlength picset)
(Setq Entt (Entget (SSname picset Idx)))
(If (And (Or (Equal (Cdr (Assoc 0 Entt)) "TEXT") ;;Doi tuong la TEXT
(Equal (Cdr (Assoc 0 Entt)) "MTEXT") ;;Hoac doi tuong la MTEXT
)
(Numberp (Read (Cdr (Assoc 1 Entt)))) ;;La TEXT dang chu so
)
(Progn
(Setq Pnt (List (Cadr (Assoc 10 Entt)) (Caddr (Assoc 10 Entt)) (AtoF (Cdr (Assoc 1 Entt)))))
(Setq Entt (Subst (Cons 10 Pnt) (Assoc 10 Entt) Entt))
(Entmod Entt)
)
)
(Setq Idx (+ Idx 1))
)
)
)
(Princ)
)

Bạn dùng lisp sau.Nó sẽ tự gán giá trị Z bằng giá trị text cho bạn


<<

Filename: 264800_sht.lsp
Tác giả: cd2k44
Bài viết gốc: 264797
Tên lệnh: aao
Xin nhờ các cao thủ sửa hộ em cái lisp này với ạ

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(defun C:AAO( / ss L e)
(princ "\nChon nhung doan can tinh chieu dai")
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (+ L (length1 e)))
(ssdel e ss)
)
(setq tchon (strcase (getstring "\nTuy chon hien thi: Gan gia tri vao text (S), Ghi text (G), Thong bao...

>>

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(defun C:AAO( / ss L e)
(princ "\nChon nhung doan can tinh chieu dai")
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (+ L (length1 e)))
(ssdel e ss)
)
(setq tchon (strcase (getstring "\nTuy chon hien thi: Gan gia tri vao text (S), Ghi text (G), Thong bao (T)")))
(cond
((= tchon "T")
(alert (strcat "Tong chieu dai = " (rtos L 2 3))))
((= tchon "G")
(setq ddtext (getpoint "\nDiem dat text:"))
(setq kqtext (strcat "Tong chieu dai = " (rtos L 2 3)))
(command ".text" "BL" ddtext "" "" kqtext))
((= tchon "S")
(setq textgoc (entget (car (entsel "\nChon text muon sua: "))))
(setq textmoi (rtos L 2 2))
(setq textgoc (subst (cons 1 textmoi) (assoc 1 textgoc) textgoc))
(entmod textgoc))
)
)

Vì bạn không đưa lisp gốc lên nên không biết sửa cái gì cho bạn. Lisp này nguyên thủy của bác Sgcq trên cadviet.Mình thêm 3 tùy chọn cho phù hợp với yêu cầu của bạn. Hiện thông báo, hoặc ghi text, hoặc sửa text


<<

Filename: 264797_aao.lsp
Tác giả: cd2k44
Bài viết gốc: 264792
Tên lệnh: gt
Nhờ viết lisp đo khoảng cách và ghi ra text có sẵn

(defun c:gt (/ p1 p2 txt etxt d str)
(setvar "cmdecho" 0)
(command "undo" "begin")
(while (and (setq p1 (getpoint "\n Chon diem thu nhat"))
(setq p2 (getpoint p1 "\n Chon diem thu hai "))
(setq d (distance p1 p2))
(setq tchon (strcase (getstring "\nTuy chon hien thi: Gan gia tri vao text (S), Ghi text (G)")))
(cond
((= tchon "S")
(setq txt (car (entsel "\n Chon text can thay" )))
(setq etxt (entget txt))
(progn
(setq str (strcat "\n" (cdr(assoc...

>>

(defun c:gt (/ p1 p2 txt etxt d str)
(setvar "cmdecho" 0)
(command "undo" "begin")
(while (and (setq p1 (getpoint "\n Chon diem thu nhat"))
(setq p2 (getpoint p1 "\n Chon diem thu hai "))
(setq d (distance p1 p2))
(setq tchon (strcase (getstring "\nTuy chon hien thi: Gan gia tri vao text (S), Ghi text (G)")))
(cond
((= tchon "S")
(setq txt (car (entsel "\n Chon text can thay" )))
(setq etxt (entget txt))
(progn
(setq str (strcat "\n" (cdr(assoc 1 etxt)) " + " (rtos d 2 2) " = " (rtos (+ d (atof(cdr(assoc 1 etxt)))) 2 2)))
(entmod(subst(cons 1 (rtos (+ d (atof (cdr(assoc 1 etxt)))) 2 2)) (assoc 1 etxt) etxt))
(command "change" txt "" "p" "c" 1 "")
(princ str)
(princ)
)
)
((= tchon "G")
(setq ddtext (getpoint "\nDiem dat text:"))
(setq gocxoay (angle p1 p2))
(command ".text" "BL" ddtext "" gocxoay (rtos d 2 2))
)
)
(command "undo" "end")
(setvar "cmdecho" 1)
(princ)
)
)
)

Xin bạn viết bổ sung việc chọn đo khoảng cách, ghi ra text tại điểm mình chọn và xoay theo chiều của hướng đo.

Cám ơn

bạn test thử xem nhé


<<

Filename: 264792_gt.lsp
Tác giả: ssg
Bài viết gốc: 5583
Tên lệnh: vt2
Chương trình thống kê vật tư


Trình của bạn chạy tốt, nhưng Ssg xin góp ý ở góc nhìn của lập trình viên:
1) Không nên lập function ghi. Đối tượng ss sau khi chọn đã xác định hoàn toàn, lẽ ra chỉ nên open và close file 1 lần thôi. Cách làm của bạn làm chương trình chạy chậm, vì phải thao tác nhiều lần trên disk (do chương trình nhỏ nên có thể không nhận thấy)
2) Dùng thông báo alert gây ấn tượng và...
>>


Trình của bạn chạy tốt, nhưng Ssg xin góp ý ở góc nhìn của lập trình viên:
1) Không nên lập function ghi. Đối tượng ss sau khi chọn đã xác định hoàn toàn, lẽ ra chỉ nên open và close file 1 lần thôi. Cách làm của bạn làm chương trình chạy chậm, vì phải thao tác nhiều lần trên disk (do chương trình nhỏ nên có thể không nhận thấy)
2) Dùng thông báo alert gây ấn tượng và hiệu quả hơn princ

Bạn tham khảo đoạn sau và cho ý kiến:


<<

Filename: 5583_vt2.lsp
Tác giả: gia_bach
Bài viết gốc: 266152
Tên lệnh: left
Nhờ các anh sửa giúp lisp chuyển vị trí text sang trái (Justifi : Left)

Lisp chuyển điểm chèn về Left theo yêu cầu.

(defun c:left (/ i ss obj align pt)
  ;; By : Gia_Bach 2013 ;;
  (vl-load-com)
  (if (setq i -1 ss (ssget (list(cons 0 "TEXT")) ))
    (repeat (sslength ss)
      (setq obj (vlax-Ename->Vla-Object (ssname ss (setq i (1+ i)))))
      (if (/= (setq align (vla-get-Alignment obj)) 0)
	(progn
	  (setq pt (vla-get-textalignmentpoint obj))
	  (vla-put-alignment obj 0)
	  (vla-put-insertionpoint obj pt)...
>>

Lisp chuyển điểm chèn về Left theo yêu cầu.

(defun c:left (/ i ss obj align pt)
  ;; By : Gia_Bach 2013 ;;
  (vl-load-com)
  (if (setq i -1 ss (ssget (list(cons 0 "TEXT")) ))
    (repeat (sslength ss)
      (setq obj (vlax-Ename->Vla-Object (ssname ss (setq i (1+ i)))))
      (if (/= (setq align (vla-get-Alignment obj)) 0)
	(progn
	  (setq pt (vla-get-textalignmentpoint obj))
	  (vla-put-alignment obj 0)
	  (vla-put-insertionpoint obj pt) ))))
  (princ))

<<

Filename: 266152_left.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 226006
Tên lệnh: jf jf pljoinfuzz pljoinfuzz
lisp nối đường cong, đường thẳng

Lisp nối Arc, Line, Polyline, Lwpolyline của Jimmy Bergmark. Chấp nhận giữa các đối tượng có khoảng hở (fuzz).

Filename: 226006_jf_jf_pljoinfuzz_pljoinfuzz.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 106058
Tên lệnh: chsize
Viết lisp theo yêu cầu [phần 2]

Chào bạn nguyentuyen6,
Bạn xài thử cái này, đã bổ sung đối với Mtext và với các đối tượng block.
Tuy nhiên yêu cầu 2 của bạn cũng tương tự như vấn đề mình nêu ở bài trước mình vẫn chưa giải quyết được . Thực ra với mình điều này cũng rất không ưng nhưng vì dốt nên đành chịu bó tay bạn ạ.
Việc bạn muốn bỏ đi cái alert theo mình là không nên vì đó là cái...
>>

Chào bạn nguyentuyen6,
Bạn xài thử cái này, đã bổ sung đối với Mtext và với các đối tượng block.
Tuy nhiên yêu cầu 2 của bạn cũng tương tự như vấn đề mình nêu ở bài trước mình vẫn chưa giải quyết được . Thực ra với mình điều này cũng rất không ưng nhưng vì dốt nên đành chịu bó tay bạn ạ.
Việc bạn muốn bỏ đi cái alert theo mình là không nên vì đó là cái cảnh báo để người dùng không bị nhầm lẫn giữa việc chọn nguồn và đích. Tuy nhiên theo yêu cầu của bạn mình đã bỏ, nhưng nếu bạn muốn phục hồi chỉ cần xóa đi các dấu chấm phẩy (:D phía trước dòng code này.
rất mong bạn thông cảm với cái sự dốt của mình và chờ thêm ít nữa, có thể có người sẽ có cách giải quyết khác để giúp bạn.
Chúc bạn vui.

<<

Filename: 106058_chsize.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 106060
Tên lệnh: xt2ex
Viết lisp theo yêu cầu [phần 2]
Sau khi tham khảo ý kiến của bác Vbao, mình post lên đây cái lisp đã viết giúp bác Vbao, hy vọng có thể sẽ có người cần dùng.


Nhờ anh Bình viết hộ cái lisp theo file đính kèm dưới đây. Chân thành cảm ơn anh.

http://www.cadviet.com/upfiles/3/t2e.dwg

Chào bác VBao,
Gửi bác cái củ sâm này, hy vọng nó chữa được cái bệnh của bác. Cái này sau khi mót lại của bác...
>>
Sau khi tham khảo ý kiến của bác Vbao, mình post lên đây cái lisp đã viết giúp bác Vbao, hy vọng có thể sẽ có người cần dùng.


Nhờ anh Bình viết hộ cái lisp theo file đính kèm dưới đây. Chân thành cảm ơn anh.

http://www.cadviet.com/upfiles/3/t2e.dwg

Chào bác VBao,
Gửi bác cái củ sâm này, hy vọng nó chữa được cái bệnh của bác. Cái này sau khi mót lại của bác ndtvn trên diễn đàn, mình chế lại một chút cộng với cái lisp t2e.lsp và cho nó ra đời.
Cái này khắc phục được cái vụ explode ờ lisp trước và tránh được sự nhầm lẫn nếu như trong vùng chọn của bác có thằng cu Mtext nào lạc vào đó. Và do đó nó túm được chính xác hơn cái bác cần. Cũng nhờ nó mà mình bỏ luôn được mấy thằng undo cho đỡ rối bác ạ.
Chúc bác luôn khỏe và vui.



Bravo bác Bình, đúng là củ sâm tốt hơn củ chuối hột, lisp chạy tốc độ hơn. Vâng bác cứ post lên diễn đàn (lisp này dùng trích số liệu trắc dọc để nộp bài cho cơ quan). Thanks bác
<<

Filename: 106060_xt2ex.lsp
Tác giả: thiep
Bài viết gốc: 75610
Tên lệnh: unmove
Lisp đưa đối tượng về vị trí cũ sau khi move?

Chào Hai_1410 và Tue_nv, nói là bó tay, nhưng mình vẫn suy nghĩ để giải quyết bài toán này. Và qua 1 đêm ngủ chập chờn, sáng nay mình viết 1 đoạn lisp này đây:

Filename: 75610_unmove.lsp
Tác giả: metavn
Bài viết gốc: 267181
Tên lệnh: dttg t33 tich4 lapphuong dtvk dttg2 dtmc klg klth klth2 doidv
Chương 3 - Các hàm nhập liệu

Nộp bài chương 3 cho bác ketxu:

 

 

;1. Tinh dien tich tam giac

(defun dientichtg (x y)
(* x y 0.5)
)

(defun c:dttg (/ a b)
    (setq a (getreal "\nNhap gia tri chieu dai canh day a:"))
    (setq b (getreal "\nNhap gia tri chieu cao b:"))
    (princ "\nDien tich tam giac la:")
    (princ (dientichtg a b))
    (princ)
)



;2. Tinh trung binh cong 3 so

(defun trungbinhcong (x y z)
(/ (+ x y z)...
>>

Nộp bài chương 3 cho bác ketxu:

 

 

;1. Tinh dien tich tam giac

(defun dientichtg (x y)
(* x y 0.5)
)

(defun c:dttg (/ a b)
    (setq a (getreal "\nNhap gia tri chieu dai canh day a:"))
    (setq b (getreal "\nNhap gia tri chieu cao b:"))
    (princ "\nDien tich tam giac la:")
    (princ (dientichtg a b))
    (princ)
)



;2. Tinh trung binh cong 3 so

(defun trungbinhcong (x y z)
(/ (+ x y z) 3.0)
)

(defun c:t33 (/ a b c)
    (setq a (getreal "\nNhap gia tri a:"))
    (setq b (getreal "\nNhap gia tri b:"))
    (setq c (getreal "\nNhap gia tri c:"))
    (princ "\nTrung binh cong 3 so la:")
    (princ (trungbinhcong a b c))
    (princ)
)


;3. Tinh tich 4 so

(defun tich (x y z m)
(* x y z m)
)

(defun c:tich4 (/ a b c d)
    (setq a (getreal "\nNhap gia tri a:"))
    (setq b (getreal "\nNhap gia tri b:"))
    (setq c (getreal "\nNhap gia tri c:"))
    (setq d (getreal "\nNhap gia tri d:"))
    (princ "\nTich 4 so la:")
    (princ (tich a b c d))
    (princ)
)



;4. Tinh lap phuong 1 so

(defun lapphuong (x)
(* x x x)
)

(defun c:lapphuong (/ a)
    (setq a (getreal "\nNhap gia tri a:"))
    (princ "\nLap phuong cua so do la:")
    (princ (lapphuong a))
    (princ)
)


;5. Tinh dien tich vanh khan

(defun dientichvk (x y)
(* pi (- (* y y) (* x x)))
)

(defun c:dtvk (/ a b)
    (setq a (getreal "\nNhap gia tri ban kinh vong tron nho:"))
    (setq b (getreal "\nNhap gia tri ban kinh vong tron lon:"))
    (princ "\nDien tich hinh vanh khan la:")
    (princ (dientichvk a b))
    (princ)
)



;6 Tinh dien tich tam giac biet 3 canh, cong thuc Heron

(defun dientichtamgiac (x y z)
(sqrt (* (* (+ x y z) 0.5) (- (* (+ x y z) 0.5) a) (- (* (+ x y z) 0.5) b) (- (* (+ x y z) 0.5) c)))
)

(defun c:dttg2 (/ a b c)
    (setq a (getreal "\nNhap gia tri canh a:"))
    (setq b (getreal "\nNhap gia tri canh b:"))
    (setq c (getreal "\nNhap gia tri canh c:"))
    (princ "\nDien tich tam giac la:")
    (princ (dientichtamgiac a b c))
    (princ)
)




;7. Tinh dien tich mc ngang thanh thep tron biet duong kinh thep

(defun dientichmc (x)
(* pi (/ (* x x) 4.0))
)


(defun c:dtmc (/ d)
    (setq d (getreal "\nNhap gia tri duong kinh thanh thep (mm):"))
    (princ "\nDien tich mat cat ngang thanh thep la:")
    (princ (dientichmc d))
    (princ)
)




;8. Tinh khoi luong 1 thanh thep tron dai 11.7m biet duong kinh

(defun khoiluong (x)
(* (/ (dientichmc x) 1000000) 7850 11.7)
)


(defun c:klg (/ d)
    (setq d (getreal "\nNhap gia tri duong kinh thanh thep (mm):"))
    (princ "\nKhoi luong thanh thep dai 11.7m la:")
    (princ (khoiluong d))
    (princ)
)



;9. Tinh khoi luong 1 thanh thep hop dai 11.7m biet kich thuoc ngoai va chieu day

(defun kluongthephop (x y)
    (* (/ (- (* x x) (* (- x (* y 2)) (- x (* y 2)))) 1000000) 7850 11.7)
)


(defun c:klth (/ a b)
    (setq a (getreal "\nNhap gia tri chieu dai canh ngoai a (mm):"))
    (setq b (getreal "\nNhap gia tri chieu day b (mm):"))
    (princ "\nKhoi luong thanh thep hop 11.7m la:")
    (princ (kluongthephop a b))
    (princ)
)



;10. Tinh khoi luong 1 thanh thep hop dai 11.7m biet kich thuoc trong va ngoai

(defun kluongthephop2 (x y)
    (* (/ (- (* x x) (* y y)) 1000000) 7850 11.7)
)

(defun c:klth2 (/ a b)
    (setq a (getreal "\nNhap gia tri chieu dai canh ngoai a (mm):"))
    (setq b (getreal "\nNhap gia tri chieu dai canh trong  b (mm):"))
    (princ "\nKhoi luong thanh thep hop 11.7m la:")
    (princ (kluongthephop2 a b))
    (princ)
)


;11. Chuong trinh doi mm sang m

(defun doidonvi (x)
    (/ x 1000.0)
)

(defun c:doidv (/ a)
    (setq a (getreal "\nNhap gia tri a (mm):"))
    (princ "\nGia tri doi sang don vi m la:")
    (princ (doidonvi a))
    (princ)
)



<<

Filename: 267181_dttg_t33_tich4_lapphuong_dtvk_dttg2_dtmc_klg_klth_klth2_doidv.lsp
Tác giả: metavn
Bài viết gốc: 267203
Tên lệnh: dttg t33 tich4 lapphuong dtvk dttg2 dtmc klg klth klth2 doidv
[LI]Chương 3 - Các hàm nhập liệu

Bài tập Chương 3.2: Làm sao để loại bỏ các hàm con ra khỏi bộ nhớ của thủ tục hoặc hàm chính. Nếu được, hãy sửa lại 11 bài trên và so sánh thiệt - hơn với từng cách

Sau khi đọc các bài của nhoclangbat ở trên thì mình trả lời câu hỏi này là: để loại các hàm con ra khỏi bộ nhớ của thủ tục hoặc hàm chính thì đưa nó vào thân thủ tục và chỗ...

>>

Bài tập Chương 3.2: Làm sao để loại bỏ các hàm con ra khỏi bộ nhớ của thủ tục hoặc hàm chính. Nếu được, hãy sửa lại 11 bài trên và so sánh thiệt - hơn với từng cách

Sau khi đọc các bài của nhoclangbat ở trên thì mình trả lời câu hỏi này là: để loại các hàm con ra khỏi bộ nhớ của thủ tục hoặc hàm chính thì đưa nó vào thân thủ tục và chỗ (defun (/ x y ...)

 

Sửa lại bài tập chương 3 với việc khử hàm con:

 

 

;1. Tinh dien tich tam giac

(defun c:dttg (/ a b dientichtg)
(setq a (getreal "\nNhap gia tri chieu dai canh day a:"))
(setq b (getreal "\nNhap gia tri chieu cao b:"))
(defun dientichtg (x y)
(* x y 0.5)
)
(princ "\nDien tich tam giac la:")
(princ (dientichtg a b))
(princ)
)


;2. Tinh trung binh cong 3 so

(defun c:t33 (/ a b c trungbinhcong)
(setq a (getreal "\nNhap gia tri a:"))
(setq b (getreal "\nNhap gia tri b:"))
(setq c (getreal "\nNhap gia tri c:"))
(defun trungbinhcong (x y z)
(/ (+ x y z) 3.0)
)
(princ "\nTrung binh cong 3 so la:")
(princ (trungbinhcong a b c))
(princ)
)


;3. Tinh tich 4 so

(defun c:tich4 (/ a b c d tich)
(setq a (getreal "\nNhap gia tri a:"))
(setq b (getreal "\nNhap gia tri b:"))
(setq c (getreal "\nNhap gia tri c:"))
(setq d (getreal "\nNhap gia tri d:"))
(defun tich (x y z m)
(* x y z m)
)
(princ "\nTich 4 so la:")
(princ (tich a b c d))
(princ)
)


;4. Tinh lap phuong 1 so

(defun c:lapphuong (/ a lapphuong)
(setq a (getreal "\nNhap gia tri a:"))
(defun lapphuong (x)
(* x x x)
)
(princ "\nLap phuong cua so do la:")
(princ (lapphuong a))
(princ)
)


;5. Tinh dien tich vanh khan

(defun c:dtvk (/ a b dientichvk)
(setq a (getreal "\nNhap gia tri ban kinh vong tron nho:"))
(setq b (getreal "\nNhap gia tri ban kinh vong tron lon:"))
(defun dientichvk (x y)
(* pi (- (* y y) (* x x)))
)
(princ "\nDien tich hinh vanh khan la:")
(princ (dientichvk a b))
(princ)
)


;6 Tinh dien tich tam giac biet 3 canh, cong thuc Heron

(defun c:dttg2 (/ a b c dientichtamgiac)
(setq a (getreal "\nNhap gia tri canh a:"))
(setq b (getreal "\nNhap gia tri canh b:"))
(setq c (getreal "\nNhap gia tri canh c:"))
(defun dientichtamgiac (x y z)
(sqrt (* (* (+ x y z) 0.5) (- (* (+ x y z) 0.5) a) (- (* (+ x y z) 0.5) b) (- (* (+ x y z) 0.5) c)))
)
(princ "\nDien tich tam giac la:")
(princ (dientichtamgiac a b c))
(princ)
)


;7. Tinh dien tich mc ngang thanh thep tron biet duong kinh thep

(defun dientichmc (x)
(* pi (/ (* x x) 4.0))
)
(defun c:dtmc (/ d)
(setq d (getreal "\nNhap gia tri duong kinh thanh thep (mm):"))
(princ "\nDien tich mat cat ngang thanh thep la:")
(princ (dientichmc d))
(princ)
)


;8. Tinh khoi luong 1 thanh thep tron dai 11.7m biet duong kinh

(defun c:klg (/ d khoiluong dientichmc)
(setq d (getreal "\nNhap gia tri duong kinh thanh thep (mm):"))
(defun khoiluong (x)
(* (/ (dientichmc x) 1000000) 7850 11.7)
)
(princ "\nKhoi luong thanh thep dai 11.7m la:")
(princ (khoiluong d))
(princ)
)



;9. Tinh khoi luong 1 thanh thep hop dai 11.7m biet kich thuoc ngoai va chieu day

(defun c:klth (/ a b kluongthephop)
(setq a (getreal "\nNhap gia tri chieu dai canh ngoai a (mm):"))
(setq b (getreal "\nNhap gia tri chieu day b (mm):"))
(defun kluongthephop (x y)
(* (/ (- (* x x) (* (- x (* y 2)) (- x (* y 2)))) 1000000) 7850 11.7)
)
(princ "\nKhoi luong thanh thep hop 11.7m la:")
(princ (kluongthephop a b))
(princ)
)



;10. Tinh khoi luong 1 thanh thep hop dai 11.7m biet kich thuoc trong va ngoai

(defun c:klth2 (/ a b kluongthephop2)
(setq a (getreal "\nNhap gia tri chieu dai canh ngoai a (mm):"))
(setq b (getreal "\nNhap gia tri chieu dai canh trong b (mm):"))
(defun kluongthephop2 (x y)
(* (/ (- (* x x) (* y y)) 1000000) 7850 11.7)
)
(princ "\nKhoi luong thanh thep hop 11.7m la:")
(princ (kluongthephop2 a b))
(princ)
)


;11. Chuong trinh doi mm sang m

(defun c:doidv (/ a doidonvi)
(setq a (getreal "\nNhap gia tri a (mm):"))
(defun doidonvi (x)
(/ x 1000.0)
)
(princ "\nGia tri doi sang don vi m la:")
(princ (doidonvi a))
(princ)
)


<<

Filename: 267203_dttg_t33_tich4_lapphuong_dtvk_dttg2_dtmc_klg_klth_klth2_doidv.lsp

Trang 146/304

146