Jump to content
InfoFile
Tác giả: gia_bach
Bài viết gốc: 66535
Tên lệnh: hatcharea
Em đang học Lisp, nhờ các anh sửa júp em đoạn mã bị lỗi !!!!!

Bạn chạy thử Lisp này

Filename: 66535_hatcharea.lsp
Tác giả: hochoaivandot
Bài viết gốc: 245303
Tên lệnh: ha
nhờ chỉnh sửa lisp thay đổi chiều cao nhiều block attribute cùng 1 lúc

(defun C:hhh (/ CURCMD ATT OLDVAL TEXT)

Lisp đầu tiên. Tên lệnh HA.

Sẽ thay đổi tấc cả block thuộc tính. Chọn thuộc tính và nhập chiều cao

;;Thay doi chieu cao thuoc tinh (attributes) Block
;;Viet boi Duong Ba Diep - hochoaivandot
;;www.cadonline.duyxuyen.vn
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES)...

>>
(defun C:hhh (/ CURCMD ATT OLDVAL TEXT)

Lisp đầu tiên. Tên lệnh HA.

Sẽ thay đổi tấc cả block thuộc tính. Chọn thuộc tính và nhập chiều cao

;;Thay doi chieu cao thuoc tinh (attributes) Block
;;Viet boi Duong Ba Diep - hochoaivandot
;;www.cadonline.duyxuyen.vn
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
) ;_ end defun
(defun maklis ()  
(setq lis_hex '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"))  
(setq lis_dec '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15")) 
)
(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))
(defun 16t10 (hex / lis_hex lis_dec L kt S i j)
(maklis)
  (setq L (strlen hex) i L j 0 S 0)
  (Repeat L
    (setq kt (atoi (nth (vl-position (substr hex i 1) lis_hex) lis_dec)))
    (setq S (+ S (* (expt 16 j ) kt)))
    (setq i (1- i))
    (setq j (1+ j))
)
  (itoa S)
)
(defun 10t16 (dec / lis_hex lis_dec hex L dec1 i kt)
(maklis)
  (setq dec (fix dec))
  (setq hex (strcat))
  (setq L (1+ (fix (/ (log dec) (log 16)))) i (1- L) dec1 dec)
  (Repeat L
    (setq kt (nth (vl-position (itoa (fix (/ dec1 (expt 16 i)))) lis_dec) lis_hex))
(setq hex (strcat hex kt))
    (setq dec1 (- dec1 (* (expt 16 i ) (fix (/ dec1 (expt 16 i))))))
    (setq i (1- i))
)
  hex
)
(defun entback (ena / ena2 han1)
(setq han1 (GET-GC 5 ena))
(setq ena2 (handent (10t16 (- (atof (16t10 han1)) 1))))
)
(defun C:ha (/ *ERROR* ATT conti CURCMD e enn h i na OLDVAL ss tag)
(setq *ERROR* (defun MY-ERR (MSG)
(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))
(t (progn (princ MSG) (princ)))
) ;_ end cond
(setq *ERROR* NIL)
(princ)
) ;_ defun
) ;_ end setq
(setq CURCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(while (/= (setq ATT (car (nentselp "\nChon ATT muon Edit H: "))) NIL)
(if (= (GET-GC 0 ATT) "ATTRIB")
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq tag (GET-GC 2 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(while (= (GET-GC 0 (setq ATT (entback ATT))) "INSERT")
(setq na (GET-GC 2 ATT))
(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 na) (cons 66 1))))
)
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))) conti T)
(setq enn e)
(while conti
(if (and (setq enn (EntNext enn)) (= "ATTRIB" (GET-GC 0 enn)) (= (GET-GC 2 enn) tag))
(progn
(setq conti nil)
(PUT-GC h 40 enn)
)
)
)
)
)
)
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
) ;_ end while

(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
(princ "Viet boi Duong Ba Diep")
(princ)
) ;_ end defun

 

Lisp thứ 2. Chỉ thay đổi chiều cao 1 thuộc tính trong 1 block. Lisp này cũng có tác dụng với Text và Dim

(defun C:hhh (/ CURCMD ATT OLDVAL TEXT)

(setq *ERROR* (defun MY-ERR (MSG)

(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))

(t (progn (princ MSG) (princ)))

) ;_ end cond

(setq *ERROR* NIL)

(princ)

) ;_ defun

) ;_ end setq

(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))

(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
) ;_ end defun

(setq CURCMD (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

(while (/= (setq ATT (car (nentselp "\nCh\U+1ECDn thu\U+1ED9c tính \U+0111\U+1EC3 Edit: "))) NIL)

(if (or (= (GET-GC 0 ATT) "ATTRIB")

(= (GET-GC 0 ATT) "TEXT")

(= (GET-GC 0 ATT) "MTEXT")

(= (GET-GC 0 ATT) "DIMENSION")

) ;_ end or
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(PUT-GC h 40 ATT)
)
)
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
) ;_ end while
(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
(princ)
) ;_ end defun

(defun C:hhh (/ CURCMD ATT OLDVAL TEXT)
 
(setq *ERROR* (defun MY-ERR (MSG)
 
(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))
 
(t (progn (princ MSG) (princ)))
 
) ;_ end cond
 
(setq *ERROR* NIL)
 
(princ)
 
) ;_ defun
 
) ;_ end setq
 
(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))
 
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
) ;_ end defun
 
(setq CURCMD (getvar "CMDECHO"))
 
(setvar "CMDECHO" 0)
 
(while (/= (setq ATT (car (nentselp "\nCh\U+1ECDn thu\U+1ED9c tính \U+0111\U+1EC3 Edit: "))) NIL)
 
(if (or (= (GET-GC 0 ATT) "ATTRIB")
 
(= (GET-GC 0 ATT) "TEXT")
 
(= (GET-GC 0 ATT) "MTEXT")
 
(= (GET-GC 0 ATT) "DIMENSION")
 
) ;_ end or
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(PUT-GC h 40 ATT)
)
)
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
) ;_ end while
(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
(princ)
 

 

Mới làm nhanh chưa test. Bạn dùng nếu  có gì thì reply mình fix nhé

 

(defun C:hhh (/ CURCMD ATT OLDVAL TEXT)
(setq *ERROR* (defun MY-ERR (MSG)
(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))
     (t (progn (princ MSG) (princ)))
) ;_ end cond
(setq *ERROR* NIL)
(princ)
      ) ;_ defun
) ;_ end setq
(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES) 
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
) ;_ end defun
(setq CURCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(while (/= (setq ATT (car (nentselp "\nCh\U+1ECDn thu\U+1ED9c tính \U+0111\U+1EC3 Edit: "))) NIL)
(if (or (= (GET-GC 0 ATT) "ATTRIB")
(= (GET-GC 0 ATT) "TEXT")
(= (GET-GC 0 ATT) "MTEXT")
(= (GET-GC 0 ATT) "DIMENSION")
) ;_ end or
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(PUT-GC h 40 ATT)
)
)
) ;_ end while
(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
 (princ)
) ;_ end defun
(setq *ERROR* (defun MY-ERR (MSG)
(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))
     (t (progn (princ MSG) (princ)))
) ;_ end cond
(setq *ERROR* NIL)
(princ)
      ) ;_ defun
) ;_ end setq
(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES) 
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
) ;_ end defun
(setq CURCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(while (/= (setq ATT (car (nentselp "\nCh\U+1ECDn thu\U+1ED9c tính \U+0111\U+1EC3 Edit: "))) NIL)
(if (or (= (GET-GC 0 ATT) "ATTRIB")
(= (GET-GC 0 ATT) "TEXT")
(= (GET-GC 0 ATT) "MTEXT")
(= (GET-GC 0 ATT) "DIMENSION")
) ;_ end or
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(PUT-GC h 40 ATT)
)
)
) ;_ end while
(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
 (princ)
) ;_ end defun

<<

Filename: 245303_ha.lsp
Tác giả: Namvanvo
Bài viết gốc: 245622
Tên lệnh: getvars ci rt date cla
Chữa BT Chương 4.2 : Xử lý chuỗi
Namvanvo nộp bài tập Ketxu ơi.


Mong nhận sớm nhận được đáp án của thầy Ketxu và những góp ý của mọi người.
Thanks

Filename: 245622_getvars_ci_rt_date_cla.lsp
Tác giả: hiepttr
Bài viết gốc: 245633
Tên lệnh: drc
Hi there, I check your blogs regularly. Your writing style is awesome, keep up the good work!

Tranh thủ đc 2 bài, chờ chém :D

;bai tap 4.2.1

(defun GETVARS( / os lun lup aun aup)
(setq cmd (getvar "cmdecho")
	os (getvar "osmode")
	lun (getvar "lunits")
	lup (getvar "luprec")
	aun (getvar "aunits")
	aup (getvar "auprec"))
(princ (strcat "gia tri bien CMDECHO la: " (itoa cmd)))
(princ (strcat "\ngia tri bien OSMODE la: " (itoa os)))
(princ (strcat "\ngia tri bien LUNITS la: " (itoa lun)))
(princ (strcat "\ngia tri bien LUPREC la: " (itoa...
>>

Tranh thủ đc 2 bài, chờ chém :D

;bai tap 4.2.1

(defun GETVARS( / os lun lup aun aup)
(setq cmd (getvar "cmdecho")
	os (getvar "osmode")
	lun (getvar "lunits")
	lup (getvar "luprec")
	aun (getvar "aunits")
	aup (getvar "auprec"))
(princ (strcat "gia tri bien CMDECHO la: " (itoa cmd)))
(princ (strcat "\ngia tri bien OSMODE la: " (itoa os)))
(princ (strcat "\ngia tri bien LUNITS la: " (itoa lun)))
(princ (strcat "\ngia tri bien LUPREC la: " (itoa lup)))
(princ (strcat "\ngia tri bien AUNITS la: " (itoa aun)))
(princ (strcat "\ngia tri bien AUPREC la: " (itoa aup)))
(princ)
 )
 
;bai 4.2.2
(defun c:DRC( / cmd os o dt cir)
(setq cmd (getvar "cmdecho")
	os (getvar "osmode"))
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(setq o (getpoint "\nchon tam: ")
	dt (getreal "\nNhap dien tich hinh tron can ve: "))
(command ".circle" o (sqrt (/ dt pi)))
(setq cir (entlast))
(command ".area" "o" cir)
(princ (strcat "chu vi hinh tron la: " (rtos (getvar "perimeter"))))
(command ".text" "j" "mc" o 2.5 0 (strcat "Chu vi: " (rtos (getvar "perimeter") 2 2)))
(setvar 'cmdecho cmd)
(setvar 'osmode os)
(princ)
)

<<

Filename: 245633_drc.lsp
Tác giả: toiyeuvietnam
Bài viết gốc: 245496
Tên lệnh: dg10
Terrific work! That is the kind of info that are supposed to be shared around the net. Disgrace on Google for not positioning this put up higher! Come on over and visit my web site . Thank you =)

Thực ra là em cũng chỉ sửa chữa trên những thứ có sẵn để phù hợp với công việc của mình, nếu tạo được như vậy thì sau này không cần quan tâm đến layer đã có hay chưa và không cần phải quét đối tượng đưa về layer nữa mà chỉ cần dùng lệnh là vẽ luôn.

thực ra em vẫn đang dùng cái code dưới đây để chuyển, trong đó nó có khoảng cách nét do mình đặt, nhưng mà mình phải...

>>

Thực ra là em cũng chỉ sửa chữa trên những thứ có sẵn để phù hợp với công việc của mình, nếu tạo được như vậy thì sau này không cần quan tâm đến layer đã có hay chưa và không cần phải quét đối tượng đưa về layer nữa mà chỉ cần dùng lệnh là vẽ luôn.

thực ra em vẫn đang dùng cái code dưới đây để chuyển, trong đó nó có khoảng cách nét do mình đặt, nhưng mà mình phải MA.

(DEFUN C:DG10(/ cnt enam ent pnt s1 tot v1 val)
(setvar "CMDECHO" 0.000)
(prompt "\nCHON CAC DUONG MUON CHUYEN: ")
   (COMMAND "-LAYER" "m" "DUONG" "color" 1 "" "")(PRINC)  
   (SETQ A (SSGET))
   (COMMAND "CHPROP" A PAUSE "c" "RED" "LA" "DUONG" "lt" "Hidden" "s" "5" "")(princ)
)

 còn cái dưới đây dùng 2 lệnh RD và DG1 là ổn rồi, chỉ có điều khoảng cách hở của nét Hidden trong DG1 (Đường) mình không làm được (có cách nào để có thể thêm khoảng cách không ạ?). mong anh và các chuyên gia giúp em với, cảm ơn các anh rất nhiều!

 

 (defun c:DG1 (/ *error* old_lay) 
(defun *error* (msg)
   (setvar "clayer" old_lay) (princ))
  (setq old_lay (getvar "clayer"))
  (command "_.layer"  "_m" "DUONG DI" "_c" "1" "" "L" "Hidden" "S"  "5" "LW" "0.3" "" "") ;;;"S" "5" không dùng được?
(setvar "osmode" (+ 1 2 8 32 128)) 
(command "_.LINE") (princ))
------------------------
(defun c:RD (/ *error* old_lay) 
(defun *error* (msg)
   (setvar "clayer" old_lay) (princ))
  (setq old_lay (getvar "clayer"))
  (command "_.layer"  "_m" "RANH DAT" "_c" "5" "" "L" "" "" "LW" "0.5" "" "")
(setvar "osmode" (+ 1 2 8 32 128)) 
(command "_.LINE") (princ))
 

<<

Filename: 245496_dg10.lsp
Tác giả: toiyeuvietnam
Bài viết gốc: 245496
Tên lệnh: dg1 rd
Lisp tạo các Layer cho trước trong một bản vẽ mới

Thực ra là em cũng chỉ sửa chữa trên những thứ có sẵn để phù hợp với công việc của mình, nếu tạo được như vậy thì sau này không cần quan tâm đến layer đã có hay chưa và không cần phải quét đối tượng đưa về layer nữa mà chỉ cần dùng lệnh là vẽ luôn.

thực ra em vẫn đang dùng cái code dưới đây để chuyển, trong đó nó có khoảng cách nét do mình đặt, nhưng mà mình phải...

>>

Thực ra là em cũng chỉ sửa chữa trên những thứ có sẵn để phù hợp với công việc của mình, nếu tạo được như vậy thì sau này không cần quan tâm đến layer đã có hay chưa và không cần phải quét đối tượng đưa về layer nữa mà chỉ cần dùng lệnh là vẽ luôn.

thực ra em vẫn đang dùng cái code dưới đây để chuyển, trong đó nó có khoảng cách nét do mình đặt, nhưng mà mình phải MA.

(DEFUN C:DG10(/ cnt enam ent pnt s1 tot v1 val)
(setvar "CMDECHO" 0.000)
(prompt "\nCHON CAC DUONG MUON CHUYEN: ")
   (COMMAND "-LAYER" "m" "DUONG" "color" 1 "" "")(PRINC)  
   (SETQ A (SSGET))
   (COMMAND "CHPROP" A PAUSE "c" "RED" "LA" "DUONG" "lt" "Hidden" "s" "5" "")(princ)
)

 còn cái dưới đây dùng 2 lệnh RD và DG1 là ổn rồi, chỉ có điều khoảng cách hở của nét Hidden trong DG1 (Đường) mình không làm được (có cách nào để có thể thêm khoảng cách không ạ?). mong anh và các chuyên gia giúp em với, cảm ơn các anh rất nhiều!

 

 (defun c:DG1 (/ *error* old_lay) 
(defun *error* (msg)
   (setvar "clayer" old_lay) (princ))
  (setq old_lay (getvar "clayer"))
  (command "_.layer"  "_m" "DUONG DI" "_c" "1" "" "L" "Hidden" "S"  "5" "LW" "0.3" "" "") ;;;"S" "5" không dùng được?
(setvar "osmode" (+ 1 2 8 32 128)) 
(command "_.LINE") (princ))
------------------------
(defun c:RD (/ *error* old_lay) 
(defun *error* (msg)
   (setvar "clayer" old_lay) (princ))
  (setq old_lay (getvar "clayer"))
  (command "_.layer"  "_m" "RANH DAT" "_c" "5" "" "L" "" "" "LW" "0.5" "" "")
(setvar "osmode" (+ 1 2 8 32 128)) 
(command "_.LINE") (princ))
 

<<

Filename: 245496_dg1_rd.lsp
Tác giả: ndtnv
Bài viết gốc: 245778
Tên lệnh: tod
[ yêu cầu ] lisp cắt dim có đường dóng xiên góc ?

Khi cắt Dim xiên mà chiều dài 2 chân không bằng nhau thì kết quả sẽ không đúng, vì vậy lisp không xử lý trường hợp này

 

(defun Dxf(n g) (cdr (assoc n g)))
(defun C:Tod ( / a b g k ls e m n l p q) ; Trim oblique dim
    (setq ls (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "Dimension")))))))
    (setq p (trans (getpoint "\nChon Diem :" ) 1 0))
  (foreach e ls    (setq g (entget...
>>

Khi cắt Dim xiên mà chiều dài 2 chân không bằng nhau thì kết quả sẽ không đúng, vì vậy lisp không xử lý trường hợp này

 

(defun Dxf(n g) (cdr (assoc n g)))
(defun C:Tod ( / a b g k ls e m n l p q) ; Trim oblique dim
    (setq ls (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "Dimension")))))))
    (setq p (trans (getpoint "\nChon Diem :" ) 1 0))
  (foreach e ls    (setq g (entget e) )
        (if (> 2 (setq k (rem (Dxf 70 g) 32)))
            (progn
              (setq l (Dxf 10 g) m (Dxf 13 g) n (Dxf 14 g) a (angle n m))
                (if (= k 0)(setq b (Dxf 50 g)))
                (if (not (equal n l))
                    (if (or (= k 1) (equal a b 1e-8)(equal a (+ b pi) 1e-8))
                        (progn
                            (setq q (inters l n p (polar p a 100) nil))
                            (setq g (subst (cons 14 q) (assoc 14 g) g))
                            (setq g (subst (cons 13 (polar q a (distance m n))) (assoc 13 g) g))
                      (entmod g )
                    ))
                )
     ) ))
    (redraw)
)

<<

Filename: 245778_tod.lsp
Tác giả: dunguss3581
Bài viết gốc: 196721
Tên lệnh: xyz
nút lệnh pick point từ bản vẽ.


cảm ơn DOAN VAN HA nhe

Filename: 196721_xyz.lsp
Tác giả: khanhmytho
Bài viết gốc: 245585
Tên lệnh: dl
Nhờ viết thêm xuất ra text cho lisp

_ Mình xem trên diễn đàn thấy lisp kick đo khoảng cách giữa 2 điểm rất hay mình có down về sử dụng và sửa đôi chút (do mình chỉ cần 2 điểm) lisp dùng quá tốt nhưng mình muốn xuất kết quả đó ra thay vào 1 text thì mình không làm được, anh em nào viết giúp tiếp cho mình phần này mình xin cám ơn nhiều. Lisp bên dưới

>>

_ Mình xem trên diễn đàn thấy lisp kick đo khoảng cách giữa 2 điểm rất hay mình có down về sử dụng và sửa đôi chút (do mình chỉ cần 2 điểm) lisp dùng quá tốt nhưng mình muốn xuất kết quả đó ra thay vào 1 text thì mình không làm được, anh em nào viết giúp tiếp cho mình phần này mình xin cám ơn nhiều. Lisp bên dưới

;----------------------------------------------------------
(defun c:dl()
(setq po1 (getpoint "\n Pick diem A :"))
(setq po2 (getpoint po1 "\n Pick diem B :"))
(setq S (+ (distance po1 po2) (distance po2 po1)))
(while 
(setq po4 (getpoint po2 "\n Pick diem tiep theo de tinh khoang cach/ Enter de ket thuc :"))
(setq S (+ S (distance po3 po4)) po3 po4)
)
(alert (strcat "Tong S = " (rtos S)))
(princ)
)
;---------------------------------------------------------- 

_ Xin chân thành cám ơn !!!!


<<

Filename: 245585_dl.lsp
Tác giả: khanhmytho
Bài viết gốc: 245674
Tên lệnh: dl
Nhờ viết thêm xuất ra text cho lisp

Hề hề hề,
Không được thì nó báo lỗi gì hả bạn???
Có nhẽ lỗi là do cái lisp của bạn đấy. Vì bạn nói lisp dùng chuẩn rồi nên mình chả sửa gì, nhưng thực ra lisp đó có lỗi đấy.
Cái điểm p03 lấy ở đâu mà có được (distance p03 p04) ???
Còn (setq S (+ (distance p01 p02) (distance p02 p01))) để làm...

>>

Hề hề hề,
Không được thì nó báo lỗi gì hả bạn???
Có nhẽ lỗi là do cái lisp của bạn đấy. Vì bạn nói lisp dùng chuẩn rồi nên mình chả sửa gì, nhưng thực ra lisp đó có lỗi đấy.
Cái điểm p03 lấy ở đâu mà có được (distance p03 p04) ???
Còn (setq S (+ (distance p01 p02) (distance p02 p01))) để làm chi vậy??? Tại sao phải cộng hai lần distance này???

Đoạn code mình đưa ra chỉ là để thay cái kết quả S vào cái text mà bạn muốn thay thôi. Nếu cái lisp của bạn không chạy đúng thì tất nhiên nó sẽ chả cho ra cái kết quả đúng đâu.

Bạn hãy rút kinh nghiệm khi dùng lisp.

Đoạn code đó là viết cho lisp khi kích 3 điểm đó anh nhưng em chỉ cần 2 điểm thôi, em sửa "lụi" nên nó ra thế mà không sao chỉnh lại tí sẽ ok thôi, còn đoạn code anh gửi cho em thì nó có hiện ra dòng lệnh chọn text muốn thay thế nhưng khi kích vào text thì nó không thay thế được, đoạn code đã chỉnh sửa và thêm vào code của anh như sau : 

(defun c:dl()
(setq po1 (getpoint "\n Pick diem A :"))
(setq po2 (getpoint po1 "\n Pick diem B :"))
(setq S (+ (distance po1 po2)))
(while 
(setq po4 (getpoint po2 "\n Pick diem tiep theo de tinh khoang cach/ Enter de ket thuc :"))
(setq S (+ S (distance po1 po2)))
)
(alert (strcat "Tong S = " (rtos S)))
(setq txt (car (entsel "\n Chon text muon thay the")))
         elst (entget txt)
         elst (subst (cons 1 (rtos S 2 2)) (assoc 1 elst) elst)
)
(entmod elst)
(princ)
)

_ Thật ra thì nó giống như lệnh di của cad nhưng thêm phần thay thế vào text :)). Cám ơn anh đã quan tâm !!!


<<

Filename: 245674_dl.lsp
Tác giả: hiepttr
Bài viết gốc: 245758
Tên lệnh: hcn goi dvc
Chữa BT Chương 4.2 : Xử lý chuỗi

Mình update:

;Bai 4.2.3
(defun c:HCN( / cmd os dai cao x2 y2)
(setq cmd (getvar "cmdecho")
	os (getvar "osmode"))
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(setq p1 (getpoint "\n Chon goc trai ben duoi hcn: ")
	dai (getdist "\n Nhap chieu dai: ")
	cao (getdist "\n Nhap chieu cao: ")
	x2 (+ (car p1) dai)
	y2 (+ (cadr p1) cao)
	)
(command ".rectang" p1 (list x2 y2))
(command ".zoom" "o" (entlast) "")
(setvar 'cmdecho cmd)
(setvar 'osmode os)
(princ)
)

;Bai...
>>

Mình update:

;Bai 4.2.3
(defun c:HCN( / cmd os dai cao x2 y2)
(setq cmd (getvar "cmdecho")
	os (getvar "osmode"))
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(setq p1 (getpoint "\n Chon goc trai ben duoi hcn: ")
	dai (getdist "\n Nhap chieu dai: ")
	cao (getdist "\n Nhap chieu cao: ")
	x2 (+ (car p1) dai)
	y2 (+ (cadr p1) cao)
	)
(command ".rectang" p1 (list x2 y2))
(command ".zoom" "o" (entlast) "")
(setvar 'cmdecho cmd)
(setvar 'osmode os)
(princ)
)

;Bai 4.2.4
(defun c:GOI( / chuoi ngay thang nam)
(setq chuoi (rtos (getvar "cdate") 2 0)
	ngay (substr chuoi 7)
	thang (substr chuoi 5 2)
	nam (substr chuoi 1 4)
	)
(alert (strcat "Hom nay la: " ngay "/" thang "/" nam))
(princ)
)

;Bai 4.2.5
(defun c:DVC( / cmd os ab ad o r line)
(setq cmd (getvar "cmdecho")
	os (getvar "osmode"))
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(setq o (getpoint "\nchon tam: ")
	r (getreal "\nNhap ban kinh hinh tron: ")
	ang (getorient "\n Nhap goc bat dau ke line: ")
	x (getint "\n Nhap so phan can chia: ")
	)
(command ".circle" o r
	".line" o (polar o ang r) "")
(command ".array" (entlast) "" "p" o x "" "")
(setvar 'cmdecho cmd)
(setvar 'osmode os)
(princ)
)
;Bai 4.2.6
(defun GetLChar(str)
(substr str (strlen str))
)

<<

Filename: 245758_hcn_goi_dvc.lsp
Tác giả: hiepttr
Bài viết gốc: 245854
Tên lệnh: drc
Chữa BT Chương 4.2 : Xử lý chuỗi

(tblobjname "Style" (getvar 'TEXTSTYLE))

Cảm ơn thầy Két vì đã hào phóng cho nhiều hơn cái mình cần !

Cái mình cần là biến hệ thống TEXTSTYLE kia :D

Dưới đây, mình sửa lại :

;bai 4.2.2
(defun c:DRC( / cmd os o dt cir)
(setq cmd (getvar "cmdecho")
	os (getvar "osmode"))
(setvar 'cmdecho...
>>

(tblobjname "Style" (getvar 'TEXTSTYLE))

Cảm ơn thầy Két vì đã hào phóng cho nhiều hơn cái mình cần !

Cái mình cần là biến hệ thống TEXTSTYLE kia :D

Dưới đây, mình sửa lại :

;bai 4.2.2
(defun c:DRC( / cmd os o dt cir)
(setq cmd (getvar "cmdecho")
	os (getvar "osmode"))
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(setq o (getpoint "\nchon tam: ")
	dt (getreal "\nNhap dien tich hinh tron can ve: "))
(command ".circle" o (sqrt (/ dt pi)))
(setq cir (entlast))
(command ".area" "o" cir)
(princ (strcat "chu vi hinh tron la: " (rtos (getvar "perimeter"))))
(if (= 0 (cdr (assoc 40 (tblsearch "Style" (getvar 'TEXTSTYLE)))))
(command ".text" "j" "mc" o 2.5 0 (strcat "Chu vi: " (rtos (getvar "perimeter") 2 2)))
(command ".text" "j" "mc" o 0 (strcat "Chu vi: " (rtos (getvar "perimeter") 2 2)))
);if
(setvar 'cmdecho cmd)
(setvar 'osmode os)
(princ)
)

<<

Filename: 245854_drc.lsp
Tác giả: dvlam
Bài viết gốc: 243729
Tên lệnh: dai
Nhờ viết lisp tính toán chiều dài theo layer
1. Nếu chỉ riêng LINE, PLINE bạn có thể tắt những Layer không liên quan đi và áp dụng lisp sau của Lee Mac:
(defun c:DAI ( / ss )
  (vl-load-com)
  (if (setq ss (ssget '((0 . "LINE,*POLYLINE"))))
    (
      (lambda ( i total / e )
        (while (setq e (ssname ss (setq i (1+ i))))
          (setq total (+ total (vla-get-length (vlax-ename->vla-object e))))
        )
 
        (princ (strcat...
>>
1. Nếu chỉ riêng LINE, PLINE bạn có thể tắt những Layer không liên quan đi và áp dụng lisp sau của Lee Mac:
(defun c:DAI ( / ss )
  (vl-load-com)
  (if (setq ss (ssget '((0 . "LINE,*POLYLINE"))))
    (
      (lambda ( i total / e )
        (while (setq e (ssname ss (setq i (1+ i))))
          (setq total (+ total (vla-get-length (vlax-ename->vla-object e))))
        )
 
        (princ (strcat "\n<< Length: " (rtos total) " >>"))
      )
      -1 0
    )
  )
 
  (princ))
2. Nếu bạn muốn lọc layer thì thêm vào, phần lọc nữa, tùy bạn lọc theo tên layer, hoặc theo đối tượng chọn mẫu... Trong toàn bản vẽ hay khu vực cửa sổ chọn... Sau đó bạn search trên diễn đàn để bổ xung thêm tính toán cho các loại đối tượng khác: ARC; SPLINE; ELIPS...

Chúc vui vẻ!
<<

Filename: 243729_dai.lsp
Tác giả: ketxu
Bài viết gốc: 246149
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

Bạn thử xem, mình k có CAD64 để thử

(vl-load-com)
(setq #doc (vla-get-ActiveDocument (vlax-get-acad-object)))


(defun GetObjectID (obj)
(if
	(eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
	(atoi (vlax-invoke-method
		(vla-get-Utility #doc) 'GetObjectIdString obj :vlax-false
	))
	(vla-get-Objectid obj)
)
)






;;;============================================================================================
;;;-------------------LINK...
>>

Bạn thử xem, mình k có CAD64 để thử

(vl-load-com)
(setq #doc (vla-get-ActiveDocument (vlax-get-acad-object)))


(defun GetObjectID (obj)
(if
	(eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
	(atoi (vlax-invoke-method
		(vla-get-Utility #doc) 'GetObjectIdString obj :vlax-false
	))
	(vla-get-Objectid obj)
)
)






;;;============================================================================================
;;;-------------------LINK GIA TRI CUA DOI TUONG NAY DEN DOI TUONG TEXT KHAC (>=Cad2006)-------
;;;============================================================================================

;;;----------------------------------------
;;;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 "
										(rtos (GetObjectID obn) 2 0)
										">%).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 "
										(rtos (GetObjectID obn) 2 0)
										">%).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 "
											(rtos (GetObjectID (vlax-ename->vla-object obn)) 2 0)
											">%).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 "
											(rtos (GetObjectID (vlax-ename->vla-object obn)) 2 0)
											">%).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 "
											(rtos (GetObjectID (vlax-ename->vla-object ent1)) 2 0)
											">%).TextString>%"
											"-"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(rtos (GetObjectID (vlax-ename->vla-object ent2)) 2 0)
											">%).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 "
											(rtos (GetObjectID (vlax-ename->vla-object ent1)) 2 0)
											">%).TextString>%"
											"/"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(rtos (GetObjectID (vlax-ename->vla-object ent2)) 2 0)
											">%).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 "
											(rtos (GetObjectID (vlax-ename->vla-object ent1)) 2 0)
											">%).TextString>%"
											ptinh
											"%<\\AcObjProp Object(%<\\_ObjId "
											(rtos (GetObjectID (vlax-ename->vla-object ent2)) 2 0)
											">%).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
)

<<

Filename: 246149_ll_lgt_lc_ln_lh_l%2F_lmh.lsp
Tác giả: Namvanvo
Bài viết gốc: 246204
Tên lệnh: cf
tìm lisp xử lý như hình minh họa

Chào bạn, mình mới học viết lisp, với khả năng hiện tại, mình viết đoạn lisp sau để áp dụng cho hình vẽ trên ( chưa ghi kích thước), bạn áp dụng thử nhé. :D  :lol: 
P/s: bạn load lisp vào và dùng lệnh tắt là cf, nếu bạn có thêm yêu cầu gì thì mình sẽ nghiên cứu để viết thêm


Filename: 246204_cf.lsp
Tác giả: Namvanvo
Bài viết gốc: 246310
Tên lệnh: 2 1
tìm lisp xử lý như hình minh họa
Phím tắt 1 (bạn nhập một số) nếu x=y; phím tắt 2 (phải nhập hai số) nếu x # y; nếu bạn nhập x <0, y< 0 thì hình sẽ ngược lại tương ứng với cái hình của bạn ở trên. cái lisp mình viết hơi củ chuối nhưng đã đáp ứng được yêu cầu của bạn ở trên, bạn thử áp dụng với từng trường hợp nhé  :D  :D  :D

Filename: 246310_2_1.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 88560
Tên lệnh: eet
Bản vẽ có vấn đề cần trợ giúp
Hiện tượng này nhiều khả năng là do tồn tại các đối tượng text không có nội dung (text rỗng hoặc toàn dấu cách) trong bản vẽ.

Bạn dùng lisp sau đây để xóa các đối tượng đó đi:

Lệnh là EET (erase empty text)

Filename: 88560_eet.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 246440
Tên lệnh: vv
Yêu cầu-Lisp gắn cao độ vào đỉnh polyline,tra CD tại điểm pick trên 3d polyline

mình co lisp này bạn xem thế nào

lisp điền cao độ và khoảng cách lẻ do mình sưu tầm và chỉnh sửa lisp này dùng để điền trắc ngang

lisp đây:

(command "layer" "n" "Duong giong" "c" "8" "Duong giong" "")
(command "layer" "n" "CDTN" "c" "4" "CDTN" "")
(command "layer" "n" "KCL" "c" "6" "KCL" "")
;
(defun C:VV ()
  (setq eclast (getvar "CMDECHO"))
  (setq lalast (getvar "CLAYER"))
  (setq oslast (getvar...
>>

mình co lisp này bạn xem thế nào

lisp điền cao độ và khoảng cách lẻ do mình sưu tầm và chỉnh sửa lisp này dùng để điền trắc ngang

lisp đây:

(command "layer" "n" "Duong giong" "c" "8" "Duong giong" "")
(command "layer" "n" "CDTN" "c" "4" "CDTN" "")
(command "layer" "n" "KCL" "c" "6" "KCL" "")
;
(defun C:VV ()
  (setq eclast (getvar "CMDECHO"))
  (setq lalast (getvar "CLAYER"))
  (setq oslast (getvar "OSMODE"))
  (setvar "CMDECHO" 0)
;********************************************************************************
  (setvar "osmode" 512)
  (setq po (getpoint "\nDuong ghi cao do <nearest to>_ "))
  (setq yo (cadr po))
  (setq pk (getpoint "\nDuong ghi khoang cach <nearest to>_ "))
  (setq yk (cadr pk))
  (setvar "osmode" 33)
  (setq pc (getpoint "\nDiem chuan <end, int >_ ") )
  (setq xc (car pc) yc (cadr pc))
  ;(setq hc (getreal "\nCao do chuan: "))
  (setq hc (entsel "\ncao do cos chuan"))
	(while
 	 (or
   	 (null hc)
   	 (/= "TEXT" (cdr (assoc 0 (entget (car hc)))))
	 )
	(princ "\nDoi tuong khong phai la text! Chon lai")
 	(setq hc (entsel "\ncao do cos chuan"))
	)
  (setq hc (cdr (assoc 1 (entget (car hc))))) 
  (setq hc (atof hc))
  (setvar "osmode" 33)
  (command "style" "chuso" "" 0.4 "" "" "" "" "" )
  (setq ent (car (entsel "\nChon duong Polyline muon dien:")))
  (if (= (cdr (assoc 0 (entget ent))) "POLYLINE")
    (progn
      (setq ent (entnext ent))
      (setq xx 0)
      (setq toado (cdr (assoc 10 (entget ent)))
	      x (car toado)
	      y (cadr toado)
      )
      (setq h (- y (- yc hc)))
      (setq d (abs (- x xc)))
      (if (< x xc) (setq xx -1))
      (if (> x xc) (setq xx 1))
      (setvar  "osmode" 0)
      (command "layer" "s" "Duong giong" "")
      (command "line" (list x y) (list x yo) "")
      (command "layer" "s" "CDTN" "")
      (command "text" "mr" (list x (- yo 0.2)) 90 (rtos h 2 2))
      (command "layer" "s" "KCL" "")
      (command "line" (list x yk) (list x (- yk 1.4)) "")      
      (setq ent (entnext ent))
	  (setq xc x)
      (while (/= "SEQEND" (cdr (assoc 0 (entget (entnext ent)))))
	(setq toado (cdr (assoc 10 (entget ent)))
	      x (car toado)
	      y (cadr toado)
	)
	(setq h (- y (- yc hc)))
	(setq d (abs (- x xc)))
	(if (< x xc) (setq xx -1))
	(if (> x xc) (setq xx 1))
	(setvar  "osmode" 0)
	(command "layer" "s" "Duong giong" "")
	(command "line" (list x y) (list x yo) "")
	(command "layer" "s" "CDTN" "")
	(if (>= d 1)
	  (progn
	    (command "text" "mr" (list x (- yo 0.2)) 90 (rtos h 2 2))
	    (command "layer" "s" "KCL" "")
	    (command "line" (list x yk) (list x (- yk 1.4)) "")
	    (command "text" "mc" (list (/ (+ x xc) 2) (- yk 0.7)) 0 (rtos d 2 2))
	  )
	  (progn
	    (if (> d 0)
	      (progn
	      (command "layer" "s" "KCL" "")
	      (command "text" "mc" (list (/ (+ x xc) 2) (- yk 0.7)) 90 (rtos d 2 2))
	    ))
	    (command "layer" "s" "KCL" "")
	    (command "line" (list x yk) (list x (- yk 1.4)) "")
	    (if (> d 0.4)
	      (progn
		(command "layer" "s" "CDTN" "")
	      (command "text" "mr" (list x (- yo 0.2)) 90 (rtos h 2 2))
		)
	      (progn
		(command "layer" "s" "KCL" "")
	      (command "text" "mr" (list (+ x (* xx (- 0.4 d))) (- yo 0.2)) 90 (rtos h 2 2))
	    ))
	  )
	)
	(setq xc x)
	(setvar "osmode" 33)
	(setq ent (entnext ent))
      )
	   (while (= "SEQEND" (cdr (assoc 0 (entget (entnext ent)))))
	(setq toado (cdr (assoc 10 (entget ent)))
	      x (car toado)
	      y (cadr toado)
	)
	(setq h (- y (- yc hc)))
	(setq d (abs (- x xc)))
	(if (< x xc) (setq xx -1))
	(if (> x xc) (setq xx 1))
	(setvar  "osmode" 0)
	(command "layer" "s" "Duong giong" "")
	(command "line" (list x y) (list x yo) "")
	(command "layer" "s" "CDTN" "")
	(if (>= d 1)
	  (progn
	    (command "text" "mr" (list x (- yo 0.2)) 90 (rtos h 2 2))
	    (command "layer" "s" "KCL" "")
	    (command "line" (list x yk) (list x (- yk 1.4)) "")
	    (command "text" "mc" (list (/ (+ x xc) 2) (- yk 0.7)) 0 (rtos d 2 2))
	  )
	  (progn
	    (if (> d 0)
	      (progn
	      (command "layer" "s" "KCL" "")
	      (command "text" "mc" (list (/ (+ x xc) 2) (- yk 0.7)) 90 (rtos d 2 2))
	    ))
	    (command "layer" "s" "KCL" "")
	    (command "line" (list x yk) (list x (- yk 1.4)) "")
	    (if (> d 0.4)
	      (progn
		(command "layer" "s" "CDTN" "")
	      (command "text" "mr" (list x (- yo 0.2)) 90 (rtos h 2 2))
		)
	      (progn
		(command "layer" "s" "KCL" "")
	      (command "text" "mr" (list (+ x (* xx (- 0.4 d))) (- yo 0.2)) 90 (rtos h 2 2))
	    ))
	  )
	)
	(setq xc x)
	(setvar "osmode" 33)
	(setq ent (entnext ent))
      )
    )
  )
;-----------------------------------------------------------------------------------
  (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
    (progn
      (command ".convertpoly" "h" ent "")
      (setq ent (entnext ent))
      (setq xx 0)
      (setq toado (cdr (assoc 10 (entget ent)))
	      x (car toado)
	      y (cadr toado)
      )
      (setq h (- y (- yc hc)))
      (setq d (abs (- x xc)))
      (if (< x xc) (setq xx -1))
      (if (> x xc) (setq xx 1))
      (setvar  "osmode" 0)
      (command "layer" "s" "Duong giong" "")
      (command "line" (list x y) (list x yo) "")
      (command "layer" "s" "CDTN" "")
      (command "text" "mr" (list x (- yo 0.2)) 90 (rtos h 2 2))
      (command "layer" "s" "KCL" "")
      (command "line" (list x yk) (list x (- yk 1.4)) "")      
      (setq ent (entnext ent))
	  (setq xc x)
      (while (/= "SEQEND" (cdr (assoc 0 (entget (entnext ent)))))
	(setq toado (cdr (assoc 10 (entget ent)))
	      x (car toado)
	      y (cadr toado)
	)
	(setq h (- y (- yc hc)))
	(setq d (abs (- x xc)))
	(if (< x xc) (setq xx -1))
	(if (> x xc) (setq xx 1))
	(setvar  "osmode" 0)
	(command "layer" "s" "Duong giong" "")
	(command "line" (list x y) (list x yo) "")
	(command "layer" "s" "CDTN" "")
	(if (>= d 1)
	  (progn
	    (command "text" "mr" (list x (- yo 0.2)) 90 (rtos h 2 2))
	    (command "layer" "s" "KCL" "")
	    (command "line" (list x yk) (list x (- yk 1.4)) "")
	    (command "text" "mc" (list (/ (+ x xc) 2) (- yk 0.7)) 0 (rtos d 2 2))
	  )
	  (progn
	    (if (> d 0)
	      (progn
	      (command "layer" "s" "KCL" "")
	      (command "text" "mc" (list (/ (+ x xc) 2) (- yk 0.7)) 90 (rtos d 2 2))
	    ))
	    (command "layer" "s" "KCL" "")
	    (command "line" (list x yk) (list x (- yk 1.4)) "")
	    (if (> d 0.4)
	      (progn
		(command "layer" "s" "CDTN" "")
	      (command "text" "mr" (list x (- yo 0.2)) 90 (rtos h 2 2))
		)
	      (progn
		(command "layer" "s" "KCL" "")
	      (command "text" "mr" (list (+ x (* xx (- 0.4 d))) (- yo 0.2)) 90 (rtos h 2 2))
	    ))
	  )
	)
	(setq xc x)
	(setvar "osmode" 33)
	(setq ent (entnext ent))
      )
	   (while (= "SEQEND" (cdr (assoc 0 (entget (entnext ent)))))
	(setq toado (cdr (assoc 10 (entget ent)))
	      x (car toado)
	      y (cadr toado)
	)
	(setq h (- y (- yc hc)))
	(setq d (abs (- x xc)))
	(if (< x xc) (setq xx -1))
	(if (> x xc) (setq xx 1))
	(setvar  "osmode" 0)
	(command "layer" "s" "Duong giong" "")
	(command "line" (list x y) (list x yo) "")
	(command "layer" "s" "CDTN" "")
	(if (>= d 1)
	  (progn
	    (command "text" "mr" (list x (- yo 0.2)) 90 (rtos h 2 2))
	    (command "layer" "s" "KCL" "")
	    (command "line" (list x yk) (list x (- yk 1.4)) "")
	    (command "text" "mc" (list (/ (+ x xc) 2) (- yk 0.7)) 0 (rtos d 2 2))
	  )
	  (progn
	    (if (> d 0)
	      (progn
	      (command "layer" "s" "KCL" "")
	      (command "text" "mc" (list (/ (+ x xc) 2) (- yk 0.7)) 90 (rtos d 2 2))
	    ))
	    (command "layer" "s" "KCL" "")
	    (command "line" (list x yk) (list x (- yk 1.4)) "")
	    (if (> d 0.4)
	      (progn
		(command "layer" "s" "CDTN" "")
	      (command "text" "mr" (list x (- yo 0.2)) 90 (rtos h 2 2))
		)
	      (progn
		(command "layer" "s" "KCL" "")
	      (command "text" "mr" (list (+ x (* xx (- 0.4 d))) (- yo 0.2)) 90 (rtos h 2 2))
	    ))
	  )
	)
	(setq xc x)
	(setvar "osmode" 33)
	(setq ent (entnext ent))
      )
    )
  (command ".convert" "p" "s" ent "")
  )  
;********************************************************************************
  (setvar "OSMODE" oslast)
  (setvar "CLAYER" lalast)
  (setvar "CMDECHO" eclast)
)
;*****************************************

<<

Filename: 246440_vv.lsp
Tác giả: Thaistreetz
Bài viết gốc: 101459
Tên lệnh: 180%2B
Viết lisp theo yêu cầu [phần 2]

mình viết cho bạn cái lisp 180+ trước. còn lệnh 180- hơi dài dòng loằng ngoằng chút nên mình ngại :D

bạn nghiên cứu code mình viết để tự viết cái lệnh còn lại nhé.
PS: nhưng mình thấy hình như bạn hơi cầu toàn khi sửa cái góc đó. mình đi làm mấy năm rồi cũng chưa gặp trường...
>>

mình viết cho bạn cái lisp 180+ trước. còn lệnh 180- hơi dài dòng loằng ngoằng chút nên mình ngại :D

bạn nghiên cứu code mình viết để tự viết cái lệnh còn lại nhé.
PS: nhưng mình thấy hình như bạn hơi cầu toàn khi sửa cái góc đó. mình đi làm mấy năm rồi cũng chưa gặp trường hợp nào bị yêu cầu phải sửa cái góc này.
<<

Filename: 101459_180%2B.lsp
Tác giả: vantuan18nd
Bài viết gốc: 246878
Tên lệnh: ad tile
[Hỏi] lisp tính diện tích

---------------------------------------tinh dien tich va thay cho tex---------------------ad----------------
(defun c:ad()
(setvar "cmdecho" 0)
(setvar "DIMZIN" 0)
(if (= Ty_le nil) (progn
(setq Ty_le (getreal "\nDrawing scale : "))
(setq He_so (/ 1000 Ty_le))
(setq He_so2 (* He_so He_so))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(print)
(print)
(setq pt1 (getpoint "\nPick internal...

>>

---------------------------------------tinh dien tich va thay cho tex---------------------ad----------------
(defun c:ad()
(setvar "cmdecho" 0)
(setvar "DIMZIN" 0)
(if (= Ty_le nil) (progn
(setq Ty_le (getreal "\nDrawing scale : "))
(setq He_so (/ 1000 Ty_le))
(setq He_so2 (* He_so He_so))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 300 ))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
(setq dtl (/ (/ dtl He_so2) 2))
(setq en (car (entsel "Thay cho so : ")))
(setq elst (entget en))
(setq elstold (assoc 1 elst))
(setq elstnew (cdr elstold))
(setq len (strlen elstnew))
(if (> len 6)
(progn
(setq len (- len 6))
(setq elstnew (substr elstnew 1 len))
(setq elstnew (cons 1 (strcat elstnew " " (rtos dtl 2 2))))
(setq elst (subst elstnew elstold elst))
(entmod elst)
)
(progn
(setq elstnew (cons 1 (rtos dtl 2 2)))
(setq elst (subst elstnew elstold elst))
(entmod elst)
)
)
(princ)
)

(defun c:tile()
(setvar "cmdecho" 0)
(setvar "DIMZIN" 0)
(setq Ty_le (getreal "\nDrawing scale : "))
(setq He_so (/ 1000 Ty_le))
(setq He_so2 (* He_so He_so))
(princ)
)

 

Lisp tính diện tích trên, khi chạy lệnh nó yêu cầu "Drawing scale : ", em không biết phải nhập số nào để lisp tính đúng diện tích. Nhờ các member chỉ giúp .


<<

Filename: 246878_ad_tile.lsp

Trang 139/330

139