Jump to content
InfoFile
Tác giả: Doan Nguyen Van
Bài viết gốc: 433483
Tên lệnh: mtbl
XIN LISP CHÈN TEXT VÀO LINE
Vào lúc 20/2/2019 tại 09:07, hamy2018 đã nói:

Xin chào các bác. hiện...

>>
Vào lúc 20/2/2019 tại 09:07, hamy2018 đã nói:

Xin chào các bác. hiện e làm thiết kế báo cháy cần chèn Text vào các line nối giữa các đầu báo với nội dung:

Text: là text bất kỳ, Text nằm giữa đoạn line và chia line thành 2 đoạn riêng biệt

Lệnh sẽ như thế này ạ

"Gõ lệnh:

Chọn text cần chèn:

Chọn size cho text:

chọn line, pline: ( có thể chọn 1 lúc nhiều line hoặc pline)

kết thuc"

kết quả giống như hình e đính kèm ạ ( Chữ nằm giữa và chia đoạn đó làm 2 đoạn ạ)

Mong mọi người giúp đỡ!

Zalo_ScreenShot_20_2_2019_25270.png

(vl-load-com)
(defun c:mtbl (/ str hight oldth oldos doc space ss e o a c b line ang p1 p2 p3 p4 p5 mt )
  (setq str (getstring "\nNhap text")
	hight (getreal "\nNhap cao chu")
	oldth (getvar "textsize")
	oldos (getvar "osmode")
	doc (vla-get-activedocument (vlax-get-acad-object))
	space (vla-get-modelspace doc))
(setq ss (acet-ss-to-list (ssget '((0 . "LWPOLYLINE,LINE")))))
(SETVAR "textsize" hight)
  (setvar "osmode" 0)
  (foreach e ss
      (setq o (vlax-ename->vla-object e)
            a (vlax-curve-getstartparam e)
            c (vlax-curve-getendparam   e)
            b nil
            Line (wcmatch (vla-get-Objectname o) "AcDbLine")
	    )
    (if Line (progn 
      (if b (setq b (1+ b))
		 (setq b c))
	(maketext a)
	)
	(progn  
	(setq b (1+ a))
		 
      (while (<= b c)
  	(maketext (- b 1))
	(setq b (1+ b))
)
)))
  (setvar "textsize" oldth)
  (setvar "osmode" oldos)
  (vla-regen doc acallviewports)
  )
(defun maketext (a)
	(setq p1 (vlax-curve-getpointatparam e a)
              p2 (vlax-curve-getpointatparam e b)
	      ang (angle p1 p2)
	      p3 (vlax-curve-getpointatparam e (/ (+ b a) 2))
	      p4 (polar p3 (+ ang (/ pi 2)) (/ hight 2))
	      p5 (polar p4 ang 100)
	      )
      (vla-addmtext space (vlax-3d-point p4) hight str)
      (setq mt (entlast))
    (vl-cmdf "rotate" mt "" p4 p5)
      (vla-put-backgroundfill (vlax-ename->vla-object mt) :vlax-true)
  )

Bạn test xem đã đúng ý chưa.

Lệnh MTBL

Lisp: Make Text Between Line (or Polyline)


<<

Filename: 433483_mtbl.lsp
Tác giả: heroproviponline
Bài viết gốc: 410680
Tên lệnh: cd bd
Không cắt được đường kích thước

Đọc chưa hết bài nhưng mình có lsp cắt được dim có chênh cao Z spam lên cho các bạn khì khì.

 

>>

Đọc chưa hết bài nhưng mình có lsp cắt được dim có chênh cao Z spam lên cho các bạn khì khì.

 

(DEFUN C:CD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI
PT13I PT14I PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
;;;(SETQ OLDERR *error*
;;; *error* myerror)
(PRINC "Lam on chon duong kich thuoc bat ky can cat bo Duong oi:")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Con moi bo Duong nhap diem gioi han duong kich thuoc a:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
(PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
(PROGN
(SETQ PT10 (CDR (ASSOC 10 DS)))
(SETQ PT11 (CDR (ASSOC 11 DS)))
(SETQ PT13 (CDR (ASSOC 13 DS)))
(SETQ PT14 (CDR (ASSOC 14 DS)))
(SETQ PT10 (LIST (CAR PT10) (CADR PT10) 0.00))
(SETQ PT11 (LIST (CAR PT11) (CADR PT11) 0.00))
(SETQ PT13 (LIST (CAR PT13) (CADR PT13) 0.00))
(SETQ PT14 (LIST (CAR PT14) (CADR PT14) 0.00))
(SETQ N70 (CDR (ASSOC 70 DS)))
(IF (OR (= N70 0) (= N70 32) (= N70 33) (= N70 160) (= N70 161))
(PROGN
(SETQ GOCY (ANGLE PT10 PT14))
(SETQ GOCX (+ GOCY (/ PI 2)))
)
)
(SETVAR "OSMODE" 0)
(SETQ PTI (POLAR PT GOCX 2))
(SETQ PT13I (POLAR PT13 GOCY 2))
(SETQ PT14I (POLAR PT14 GOCY 2))
(SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
(SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
(SETQ O13 (ASSOC 13 DS))
(SETQ O14 (ASSOC 14 DS))
(SETQ N13 (CONS 13 PT13N))
(SETQ N14 (CONS 14 PT14N))
(SETQ DS (SUBST N13 O13 DS))
(SETQ DS (SUBST N14 O14 DS))
(ENTMOD DS)
)
)
(SETQ DEM (+ DEM 1))
)
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
;;;(setq *error* OLDERR) ; Restore old *error* handler
(PRINC)
)
;******************************************************************************

(DEFUN C:BD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI
PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
;;;(SETQ OLDERR *error*
;;; *error* myerror)
(PRINC "Chon diem dau bo Duong oi")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Diem ket thuc nua bo Duong a:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
(PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
(PROGN
(SETQ PT13 (CDR (ASSOC 13 DS)))
(SETQ PT14 (CDR (ASSOC 14 DS)))
(SETQ PT10 (CDR (ASSOC 10 DS)))
(SETQ PT11 (CDR (ASSOC 11 DS)))
(SETQ N70 (CDR (ASSOC 70 DS)))
(IF (OR (= N70 0) (= N70 32) (= N70 33) (= N70 160) (= N70 161))
(PROGN
(SETQ GOCY (ANGLE PT10 PT14))
(SETQ GOCX (+ GOCY (/ PI 2)))
)
)
(SETVAR "OSMODE" 0)
(SETQ PTI (POLAR PT GOCX 2))
(SETQ PT10I (POLAR PT10 GOCY 2))
(SETQ PT10N (INTERS PT PTI PT10 PT10I NIL))
(SETQ KC (DISTANCE PT10 PT10N))
(SETQ O10 (ASSOC 10 DS))
(SETQ N10 (CONS 10 PT10N))
(SETQ DS (SUBST N10 O10 DS))
(SETQ PT11N (POLAR PT11 (ANGLE PT10 PT10N) KC))
(SETQ O11 (ASSOC 11 DS))
(SETQ N11 (CONS 11 PT11N))
(SETQ DS (SUBST N11 O11 DS))
(ENTMOD DS)
)
)
(SETQ DEM (+ DEM 1))
)
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
;;;(setq *error* OLDERR)
(PRINC)
)

Thanks bác nhé. Hehe. Em cũng bị như vậy mà không biết làm sao. May mà gặp đc bài của bác. Đội ơn bác  :D   :D  :D


<<

Filename: 410680_cd_bd.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 433508
Tên lệnh: mtbl
XIN LISP CHÈN TEXT VÀO LINE
1 giờ trước, hamy2018 đã nói:

Cảm ơn bạn đã giúp. lisp hoạt...

>>
1 giờ trước, hamy2018 đã nói:

Cảm ơn bạn đã giúp. lisp hoạt động rất tốt. tuy nhiên mình muốn chèn 1 ký tự vào giữa đoạn Line hoặc Pline thôi. 

Bạn có thể sửa lại giúp mình được không.

Cảm ơn rất nhiều!

Zalo_ScreenShot_1_3_2019_1027345.png

(vl-load-com)
(defun c:mtbl (/ str hight oldth oldos doc space ss e o a c b line ang p1 p2 p3 p4 mt )
  (setq str (getstring "\nNhap text")
	hight (getreal "\nNhap cao chu")
	oldth (getvar "textsize")
	oldos (getvar "osmode")
	doc (vla-get-activedocument (vlax-get-acad-object))
	space (vla-get-modelspace doc))
(setq ss (acet-ss-to-list (ssget '((0 . "LWPOLYLINE,LINE")))))
(SETVAR "textsize" hight)
  (setvar "osmode" 0)
  (foreach e ss
      (setq o (vlax-ename->vla-object e)
            a (vlax-curve-getstartparam e)
            c (vlax-curve-getendparam   e)
            b nil
            Line (wcmatch (vla-get-Objectname o) "AcDbLine")
	    )
    (if Line (progn 
      (if b (setq b (1+ b))
		 (setq b c))
	(maketext a)
	)
	(progn
(setq demo (rtos (/ c 2)))
(if (vl-string-search "." demo)(setq b c)(setq b (- c 1)))
  	(maketext a)
)))
  (setvar "textsize" oldth)
  (setvar "osmode" oldos)
  (vla-regen doc acallviewports)
  )
(defun maketext (a)
	(setq p1 (vlax-curve-getpointatparam e a)
              p2 (vlax-curve-getpointatparam e b)
	      ang (angle p1 p2)
	      p3 (vlax-curve-getpointatparam e (/ (+ b a) 2))
	      p4 (polar p3 (+ ang (/ pi 2)) (/ hight 2))
	      )
      (vla-addmtext space (vlax-3d-point p4) hight str)
  (setq mt (entlast))
      (vla-put-backgroundfill (vlax-ename->vla-object mt) :vlax-true)
  )

Sorry, do mình nhìn hình ban đầu của bạn nên lại làm bài toán thêm phức tạp. Lisp của bạn đây


<<

Filename: 433508_mtbl.lsp
Tác giả: duy782006
Bài viết gốc: 15304
Tên lệnh: mk
Giao diện hộp thoại trong AutoLisp

Chương trình tạo hàng loạt file *.sld:

 

(defun C:MK( / fn d L i dwg f fnb fsld)
(setq
   fn (getfiled "Select a Drawing File in Library" "" "dwg" 0)
   d...
>>
Chương trình tạo hàng loạt file *.sld:

 

(defun C:MK( / fn d L i dwg f fnb fsld)
(setq
   fn (getfiled "Select a Drawing File in Library" "" "dwg" 0)
   d (vl-filename-directory fn)
   L (vl-directory-files d "*.dwg")
   i 0
)
(foreach dwg L
   (setq
       f (strcat d "\\" dwg)
       fnb (vl-filename-base dwg)
       fsld (strcat d "\\" fnb)
   )
   (if (not (findfile (strcat fsld ".sld")))
       (progn
           (command "insert" f (list 0 0 0) 1 1 0)
           (command "zoom" "e")
           (command "mslide" fsld)
           (command "erase" (entlast) "")
           (setq i (1+ i))
       )
   )
)
(alert (strcat (itoa i) " slide files created")))
(princ)
)

 

Hoạt động:

1) Lệnh MK, chọn 1 file *.dwg bất kỳ trong thư mục

2) Chương trình duyệt toàn bộ *.dwg trong thư mục đó. Cái nào chưa có *.sld thì tự tạo, đặt cùng tên và thư mục với *.dwg. Báo cáo kết quả tổng số file *.sld đã tạo được.

3) Bạn muốn lập danh sách các file *.sld thì tự bổ sung thêm vào chương trình. OK?

 

Cám ơn. Sao mình lại không nghĩ ra cách này nhỉ. Do cứ chăm chú tìm cách open lên chứ không nghỉ inert ra rồi lại xóa. Đúng là nhiều khi lú lẩn thật.


<<

Filename: 15304_mk.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 433574
Tên lệnh: mtbl
XIN LISP CHÈN TEXT VÀO LINE
25 phút trước, Danh Cong đã nói:

+

25 phút trước, Danh Cong đã nói:

+ @Doan Nguyen Van , sao không xài trong trường hợp này. (vlax-curve-getpointatdist)  ? Text không cần xoay thì cứ chèn thẳng cẳng thôi, không cần quan tâm góc gủng gì hết :)))

Còn bài của ông thớt này hình như tôi cho bay 1 nick  rồi thì phải, vì tội đăng quảng cáo vô diễn đàn . Thảo nào dùng nick khắc đăng bài tôi thấy quen quen  :v :v

Có vẻ cách của bác hợp lý hơn: Thank bác, em mới học nên chưa biết nhiều.

(vl-load-com)
(defun c:mtbl (/ str hight oldth doc space ss e o a c ang p1 p2 p3 p4 mt dis)
  (setq str (getstring "\nNhap text")
	hight (getreal "\nNhap cao chu")
	oldth (getvar "textsize")
	doc (vla-get-activedocument (vlax-get-acad-object))
	space (vla-get-modelspace doc))
(setq ss (acet-ss-to-list (ssget '((0 . "LWPOLYLINE,LINE")))))
(SETVAR "textsize" hight)
  (foreach e ss
      (setq o (vlax-ename->vla-object e)
            a (vlax-curve-getstartparam e)
            c (vlax-curve-getendparam   e))
  	(maketext)
)
  (setvar "textsize" oldth)
  (vla-regen doc acallviewports)
  )
(defun maketext ()
	(setq p1 (vlax-curve-getpointatparam e a)
              p2 (vlax-curve-getpointatparam e c)
	      dis (vlax-curve-getdistatparam e c)
	      ang (angle p1 p2)
	      p3 (vlax-curve-getpointatdist e (/ dis 2))
	      p4 (polar p3 (+ ang (/ pi 2)) (/ hight 2))
	      )
      (vla-addmtext space (vlax-3d-point p4) hight str)
  (setq mt (entlast))
      (vla-put-backgroundfill (vlax-ename->vla-object mt) :vlax-true)
  )

 


<<

Filename: 433574_mtbl.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 433612
Tên lệnh: da dd
XIN LISP TỰ ĐỘNG ĐIỀN CHIỀU CAO DIM
(defun c:DA (/ p1 p2 p3 p4 ang ang2 ang3 anmin anmax oldos)
  (setq p1 (getpoint "\nDiem Dat 1"
>>
(defun c:DA (/ p1 p2 p3 p4 ang ang2 ang3 anmin anmax oldos)
  (setq p1 (getpoint "\nDiem Dat 1")
	p2 (getpoint p1 "\nDiem dat 2")
	ang (angle p1 p2)
	ang2 (angle p2 p1)
	anmin (min ang ang2)
	anmax (+ anmin pi)
	p3 (getpoint "\nPick huong dat dim")
	ang3 (angle p1 p3))
  (if (and (> ang3 anmin)
	   (< ang3 anmax))
    (setq p4 (polar p1 (+ anmin (/ pi 2)) 800))
    (setq p4 (polar p1 (- anmin (/ pi 2)) 800))
    )
    
(setq oldos (getvar 'osmode))
  (setvar "osmode" 0)
  (command "DIMALIGNED" p1 p2 p4)
   (setvar "osmode" oldos )
  )
(defun c:DD (/ p1 p2 p3 p4 osmode)
  (setq p1 (getpoint "\nDiem Dat 1")
	p2 (getpoint p1 "\nDiem dat 2")
	p3 (getpoint "\nPick huong dat dim")
)
(if (and (> (car p3) (car p1))
	   (> (car p3) (car p2)) ) 
(setq p4 (list (+ (max (car p1) (car p2)) 800) (/ (+ (cadr p1) (cadr p2)) 2) (caddr p1)))
	)
  (if (and (< (car p3) (car p1))
	   (< (car p3) (car p2)) ) 
(setq p4 (list (- (min (car p1) (car p2)) 800) (/ (+ (cadr p1) (cadr p2)) 2) (caddr p1)))
	)
   (if (and (> (cadr p3) (cadr p1))
	   (> (cadr p3) (cadr p2)) ) 
(setq p4 (list (/ (+ (car p1) (car p2)) 2) (+ (max (cadr p1) (cadr p2)) 800) (caddr p1)))
	)
     (if (and (< (cadr p3) (cadr p1))
	   (< (cadr p3) (cadr p2)) ) 
(setq p4 (list (/ (+ (car p1) (car p2)) 2) (- (min (cadr p1) (cadr p2)) 800) (caddr p1)))
	)
(if p4 (progn
(setq oldos (getvar 'osmode))
  (setvar "osmode" 0)
  (command "dimlinear" p1 p2 p4)
   (setvar "osmode" oldos )
) (Alert "\nPick huong chua dung"))
  )

Bạn test thử xem, Lệnh DA cho DIMALGNED, DD cho DIMLINEAR 


<<

Filename: 433612_da_dd.lsp
Tác giả: TRUNGNGAMY
Bài viết gốc: 73281
Tên lệnh: exx
Lisp xóa toàn bộ đối tượng được ngăn bởi đường thẳng
Theo em thì không nên viết lại. Mình chỉ thay đổi, thêm thắt một chút trong lisp express là có thể khắc phục được lỗi gây ra

Ví dụ:

(defun C:EXX...
>>
Theo em thì không nên viết lại. Mình chỉ thay đổi, thêm thắt một chút trong lisp express là có thể khắc phục được lỗi gây ra

Ví dụ:

(defun C:EXX ()
(setq ss (ssget "X"))
(vl-cmdf "CHPROP" ss "" "LT" "Continuous" "")
(C:EXTRIM)
(vl-cmdf "CHPROP" ss "" "LT" "bylayer" "")
)

Đảm bảo là lệnh EXX luôn cắt được. Việc Bylayer chỉ là một ví dụ. Mình có thể lưu lại kiểu đường nét rồi gán lại sau. Đây là một cách để chữa cháy

Mục đích là đạt đc mục đích, cách nào càng ngắn gọn càng tốt. Cách của bạn cũng đc, nhưng nếu đối tượng có linetype kg phải là bylayer thì sẽ làm sai tính chất của nó. Việc lưu lại đg nét chỉ đúng khi đối tượng kg thay đổi ename, nếu đg tg bị cắt thành nhiều đọan thì sẽ sinh ra dt mới do đó mình kg thể theo dõi đc


<<

Filename: 73281_exx.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 433640
Tên lệnh: da dd st
XIN LISP TỰ ĐỘNG ĐIỀN CHIỀU CAO DIM

1 giờ} trướ}c, kha1212 đã nói:

Bạn có thể thêm vào giúp mình 1...

>>
1 giờ} trướ}c, kha1212 đã nói:

Bạn có thể thêm vào giúp mình 1 mục setting để hiểu chỉnh số 800 được không . Ví dụ như bản vẽ muốn DIM tất cả cách trục 1000 thì mình có thể điều chỉnh số 800 đó thành 1000 được không ?

(defun c:DA (/ p1 p2 p3 p4 ang ang2 ang3 anmin anmax oldos)
  (or const (setq const (Getreal "\nNhap so:")))
  (setq p1 (getpoint "\nDiem Dat 1")
	p2 (getpoint p1 "\nDiem dat 2")
	ang (angle p1 p2)
	ang2 (angle p2 p1)
	anmin (min ang ang2)
	anmax (+ anmin pi)
	p3 (getpoint "\nPick huong dat dim")
	ang3 (angle p1 p3))
  (if (and (> ang3 anmin)
	   (< ang3 anmax))
    (setq p4 (polar p1 (+ anmin (/ pi 2)) const))
    (setq p4 (polar p1 (- anmin (/ pi 2)) const))
    )
    
(setq oldos (getvar 'osmode))
  (setvar "osmode" 0)
  (command "DIMALIGNED" p1 p2 p4)
   (setvar "osmode" oldos )
  )
(defun c:DD (/ p1 p2 p3 p4 osmode)
    (or const (setq const (Getreal "\nNhap so:")))
  (setq p1 (getpoint "\nDiem Dat 1")
	p2 (getpoint p1 "\nDiem dat 2")
	p3 (getpoint "\nPick huong dat dim")
)
(if (and (> (car p3) (car p1))
	   (> (car p3) (car p2)) ) 
(setq p4 (list (+ (max (car p1) (car p2)) const) (/ (+ (cadr p1) (cadr p2)) 2) (caddr p1)))
	)
  (if (and (< (car p3) (car p1))
	   (< (car p3) (car p2)) ) 
(setq p4 (list (- (min (car p1) (car p2)) const) (/ (+ (cadr p1) (cadr p2)) 2) (caddr p1)))
	)
   (if (and (> (cadr p3) (cadr p1))
	   (> (cadr p3) (cadr p2)) ) 
(setq p4 (list (/ (+ (car p1) (car p2)) 2) (+ (max (cadr p1) (cadr p2)) const) (caddr p1)))
	)
     (if (and (< (cadr p3) (cadr p1))
	   (< (cadr p3) (cadr p2)) ) 
(setq p4 (list (/ (+ (car p1) (car p2)) 2) (- (min (cadr p1) (cadr p2)) const) (caddr p1)))
	)
(if p4 (progn
(setq oldos (getvar 'osmode))
  (setvar "osmode" 0)
  (command "dimlinear" p1 p2 p4)
   (setvar "osmode" oldos )
) (Alert "\nPick huong chua dung"))
  )

(defun c:st ()
  (setq const (Getreal "\nNhap So:")))

Theo ý bạn, Load lệnh lần đầu sẽ yêu cầu nhập số, muốn thay đổi thì lệnh ST để nhập số khác


<<

Filename: 433640_da_dd_st.lsp
Tác giả: kuarambo
Bài viết gốc: 322196
Tên lệnh: dlb
Nhờ viết lisp thay các đối tượng chọn bằng 1 block khác

 

Bạn thử cái này xem. Máy phải có cài express.

 

(defun c:dlb (/ blk d0 d1 ss)
  (setq blk (car (entsel...
>>

 

Bạn thử cái này xem. Máy phải có cài express.

 

(defun c:dlb (/ blk d0 d1 ss)
  (setq blk (car (entsel "\nChon Block : "))
d0 (car (acet-ent-geomextents blk)))
  (prompt "\nChon doi tuong de thay bang block : ")
  (while (setq ss (ssget))
    (setq d1 (car (acet-geom-ss-extents ss nil)))    
    (command "copy" blk "" "non" d0 "non" d1 "erase" ss "")
  )
  (princ)
)

Cách này cũng được nhưng chưa làm chủ được điểm thay thế và chưa thay cùng lúc n hiều đối tượng được. Khắc phục được 2 lỗi đó là ok!!!


<<

Filename: 322196_dlb.lsp
Tác giả: Kieu Tan
Bài viết gốc: 378500
Tên lệnh: tkt
cho em xin lisp đếm text

Đúng rồi, 2 dòng bạn phát hiện chưa hoàn chỉnh.

Update :

(defun c:tkt (/ lst msp pt ss...
>>

Đúng rồi, 2 dòng bạn phát hiện chưa hoàn chỉnh.

Update :

(defun c:tkt (/ lst msp pt ss str txtsiz)  (vl-load-com)    (if (setq ss (ssget(list (cons 0 "TEXT"))))    (progn      (foreach e (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))	(setq str (vla-get-TextString e))	(if (not (assoc str lst))	  (setq lst (cons (cons str 1) lst))	  (setq lst (subst (cons str (1+ (cdr (assoc str lst))))			   (assoc str lst) lst)))	)      (setq lst (vl-sort lst '(lambda (x y) (< (cdr x) (cdr y))))	    pt (getpoint "\nDiem dat Bang :" )	    txtsiz (* (getvar "dimtxt")(getvar "dimscale"))	    msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))      (foreach e lst	(vla-addtext msp (cdr e) (vlax-3d-point pt) txtsiz )	(vla-addtext msp (car e) (vlax-3d-point (polar pt 0 (* 5 txtsiz))) txtsiz )	(setq pt (polar pt (/ pi -2) (* 1.5 txtsiz)))	)      )    (alert "Khong chon duoc Text.")    )  (princ))

Bạn gia_bach có thể sửa sao cho lsp chạy được trong môi trường làm việc model và layout luôn giúp mình với

Lsp này chỉ chạy được trong môi trường làm việc model mà thôi, có những lúc mình cần thống kê bên môi trường làm việc layout. Thanks bạn! 


<<

Filename: 378500_tkt.lsp
Tác giả: khanhcang2
Bài viết gốc: 433658
Tên lệnh: zt
Chỉnh sửa lisp cad tính diện tích về đơn vị m2

(defun c:zt()
(defun ctext (diem gt / lst)
(setq lst
(list
(cons 0 "TEXT")
(cons 1 gt)
(cons 10 diem)
(cons 40 (getdist p "\Text heigh: "))
)
)
(entmake lst)
)
(defun dtdoituong (entdt /)
(command ".area" "o" entdt)
(command ".erase" entdt "")
(getvar "area")
)
(defun getbound(p)
(setq ent (entlast))
(command ".boundary" "A" "B" "E" "I" "Y" "" p "")
(setq ent1 (entlast))
(cond
((eq ent ent1) nil)
(t ent1)
)
)
(princ...
>>
(defun c:zt()
(defun ctext (diem gt / lst)
(setq lst
(list
(cons 0 "TEXT")
(cons 1 gt)
(cons 10 diem)
(cons 40 (getdist p "\Text heigh: "))
)
)
(entmake lst)
)
(defun dtdoituong (entdt /)
(command ".area" "o" entdt)
(command ".erase" entdt "")
(getvar "area")
)
(defun getbound(p)
(setq ent (entlast))
(command ".boundary" "A" "B" "E" "I" "Y" "" p "")
(setq ent1 (entlast))
(cond
((eq ent ent1) nil)
(t ent1)
)
)
(princ "\nCADViet.com (c) 2007")
(setq
p (getpoint "\Select area place by click a point: ")
entpl (getbound p)
)
(if entpl
(ctext p (rtos (dtdoituong entpl)))
(alert "Fail!")
)
(princ)
)

(princ "\ndtm - free lisp from www.cadviet.com")
(princ)

Em muốn nhờ mọi người chỉnh sửa kết quả giúp em xuống đơn vị 10^-6 và thêm chữ m2 vào sau kết quả với ạ. Em cảm ơn ạ.


<<

Filename: 433658_zt.lsp
Tác giả: tuananhdo
Bài viết gốc: 420084
Tên lệnh: cpt
Nhờ Viết Lisp Rải Text Dạng Số

 

Chắc bạn cần là truy bắt điểm Nearest (OSMODE = 512)

(defun c:cpt(/ ss pt1)
 (seqt oldosmode...
>>

 

Chắc bạn cần là truy bắt điểm Nearest (OSMODE = 512)

(defun c:cpt(/ ss pt1)
 (seqt oldosmode (getvar "OSMODE"));Lay che do truy bat hien tai
;Gan truy bat diem Nearest
(setvar "OSMODE" 512)
(setq pt1 (getpoint "\nChon diem goc copy : "))
  (setq ss (car (entsel "\n Chon Text:")))
 
  (while (and ss pt1)
    (command "._copy" ss "" pt1 (setq pt1 (getpoint pt1 "\n diem dich copy :")))
    (setq ss (entlast))
    (command "_.ddedit" "L" "") 
  )
;Tra lai che do truy bat ban dau
(setvar "OSMODE" oldosmode )
)

Cảm ơn dinhvantrang đã giúp mình. Mình chưa sử dụng qua lisp bạn sửa, nhưng mình xin nêu ra cái mình cần để bạn giúp đỡ cũng dễ dàng: Mình cần đa số là bắt điểm endpoint, intersection, nearest, apparent intersection. 

Lúc đầu theo lisp của anh Tue_NV, thì mình rải text được copy lên 1 đoạn line bằng các osnap mình vừa nêu ở trên ( mình bắt điểm chọn điểm gốc copy đúng ô vuông xanh dương), lúc đầu vẫn ok, nhưng vài line sau thì text được copy không còn nằm trên line dù mình copy thả vào đúng trên line ( ô vuông xanh dương nằm sai vị trí mình thả ).


<<

Filename: 420084_cpt.lsp
Tác giả: phuongkq
Bài viết gốc: 185683
Tên lệnh: btk
Đo chiều dài và ghi ra text

Mình nói rõ bên trên rồi, mà bạn lại nói khác đi. Máy hiểu điểm đầu - cuối theo thứ tự khi bạn vẽ ra đối tượng, tức thứ tự bạn...

>>

Mình nói rõ bên trên rồi, mà bạn lại nói khác đi. Máy hiểu điểm đầu - cuối theo thứ tự khi bạn vẽ ra đối tượng, tức thứ tự bạn click chuột lúc Pick ra cái hình đó ấy.

Bây giờ bạn phải quy định cho Lisp biết cách nhận biết đâu là đầu, đâu là cuối - THEO Ý BẠN (quy luật)

Ở đây mình viết 1 cái cho phép khi xuất đỉnh sẽ xác định xem có đỉnh nào trùng với đỉnh của Đoạn trước không, nếu có thì coi như đoạn bắt đầu từ đó

(defun c:btk ( / cao rong iText vla_table 2t e i length1 lsttmp lstCol lst lstAll fw fn p1 p2)
(defun Length1(e) (* (getvar "dimlfac")(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))))
(defun ReLst (pt lstPt fuzz)
(if (vl-member-if '(lambda(x)(equal pt x fuzz)) lstPt)
 (list pt (car (vl-remove pt lstPt)))
 lstPt))
(vl-load-com)
(command "undo" "be")
(setq  cao 1.2 rong 5.5 iText (lambda(x y)(vla-settext vla_table i x y)) hText (/ cao 6)
 vla_table (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (getpoint "\nChon diem dat BTK :")) 2 4 cao rong)
 2t (lambda(x)(rtos x 2 4))
 i 1 lstAll ""
 lstCol '(0 1 2 3))
(vla-SetTextHeight vla_table acDataRow hText)
(vla-SetTextHeight vla_table acTitleRow (* 1.2 hText))
(vla-settext vla_table 0 0 "BANG THONG KE")
(mapcar 'iText lstCol '("TT" "FROM" "TO" "LENGTH"))
(prompt "\nChon doan can thong ke")
(while (setq e (ssget "_+.:E:S" (list (cons 0 "LINE,*PLINE,ARC,*POLYLINE"))))
(setq
e (vlax-ename->vla-object (ssname e 0))
lsttmp (list  (vlax-curve-getStartPoint e)(vlax-curve-getEndPoint e))
lsttmp (ReLst p2 lsttmp 0.1)
lsttmp (ReLst p1 lsttmp 0.1)
lst
(append
 (list (itoa i))
 (list (strcat "X = "  (2t (caar lstTmp)) "  Y = " (2t (cadar lsttmp))))
 (list (strcat "X = "  (2t (caadr lstTmp)) "  Y = " (2t (cadadr lstTmp))))
 (list (2t (length1 e)))
)
p1 (last lstTmp)
p2 (car lstTmp)
lstAll (strcat lstAll (vl-string-right-trim  "," (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) lst))) "\n")
)
(vla-InsertRows vla_table (setq i (1+ i)) cao 1)
(mapcar '(lambda(x)(vla-SetCellAlignment vla_table i x acMiddleCenter ))lstCol)
(mapcar 'iText lstCol lst)
)
(if (= (strcase (getstring "\n Ban muon luu sang file cvs khong?? <Y or N>: ")) "Y")
(progn
		(setq   fn (getfiled "Chon file de save" "" "csv" 1)
fw (open fn "w"))
  (princ  "BANG XUAT TOA DO RA FILE CSV \n" fw)
  (princ lstAll fw)
  (close fw)
  )
)
(command "undo" "end")
(princ)
)

Nếu được vậy thì quá tốt. Thanks bạn nhiều !


<<

Filename: 185683_btk.lsp
Tác giả: thanh1401
Bài viết gốc: 117752
Tên lệnh: ttt hh hscale d1 w1 ff llo lllo w2 h1 v1 h2 v2 oo
Vấn đề Lisp cửa đi, cửa sổ và 1 vài lisp khác..

Hiện mình đang sửa dụng Lisp cửa đi (D1), cửa sổ (W1), opset 2 bên (oo)....Những Lisp này hỗ trợ làm đồ án rất tốt, nhưng nhược điểm của nó là chỉ sử dụng đc với đối tượng vuông góc (song song) với trục ox,oy. còn chéo thì chịu.. :iluvyousmiley:

Càng ngày yêu cầu của Đồ án càng khù khằm..có mấy khi vuông đâu, toàn xiên xẹo lung tung--> hết dùng lisp này. Ai có cách nào giúp mình...

>>

Hiện mình đang sửa dụng Lisp cửa đi (D1), cửa sổ (W1), opset 2 bên (oo)....Những Lisp này hỗ trợ làm đồ án rất tốt, nhưng nhược điểm của nó là chỉ sử dụng đc với đối tượng vuông góc (song song) với trục ox,oy. còn chéo thì chịu.. :iluvyousmiley:

Càng ngày yêu cầu của Đồ án càng khù khằm..có mấy khi vuông đâu, toàn xiên xẹo lung tung--> hết dùng lisp này. Ai có cách nào giúp mình trường hợp này đc không ?

Đây là lisp mình đang dùng :

Lisp cửa đi (D1) :

 

 

(defun ai_undo_on ()
 (setq undo_setting (getvar "undoctl"))
 (cond
   ((= 2 (logand undo_setting 2))     ; Undo is one
     (command "_.undo" "_control" "_all" "_.undo" "_auto" "_off")
   )
   ((/= 1 (logand undo_setting 1))    ; Undo is disabled
     (command "_.undo" "_all" "_.undo" "_auto" "_off")
   )
 )
)

;;;f
;;; Return UNDO to the initial setting.  Do not use with new routines as they 
;;; should be designed to operate with any UNDO setting.
;;;
(defun ai_undo_off ()
 (cond 
   ((/= 1 (logand undo_setting 1))
     (command "_.undo" "_control" "_none")
   )
   ((= 2 (logand undo_setting 2))
     (command "_.undo" "_control" "_one")
   )
 )
)

(defun ai_undo_push()
 (setq undo_init (getvar "undoctl"))
 (cond
   ((and (= 1 (logand undo_init 1))   ; enabled
         (/= 2 (logand undo_init 2))  ; not ONE (ie ALL is ON)
         (/= 8 (logand undo_init 8))   ; no GROUP active
    )
     (command "_.undo" "_group")
   )
   (T)
 )  
 ;; If Auto is ON, turn it off.
 (if (= 4 (logand 4 undo_init))
     (command "_.undo" "_auto" "_off")
 )
)

;;;
;;; Add an END to UNDO and return to initial state.
;;;
(defun ai_undo_pop()
 (cond 
   ((and (= 1 (logand undo_init 1))   ; enabled
         (/= 2 (logand undo_init 2))  ; not ONE (ie ALL is ON)
         (/= 8 (logand undo_init 8))   ; no GROUP active
    )
     (command "_.undo" "_end")
   )
   (T)
 )  
 ;; If it has been forced off, turn it back on.
 (if (= 4 (logand undo_init 4))
   (command "_.undo" "_auto" "_on")
 )  
)

;;;======== COMMAND FOR TEXT =========
;Change string
(defun c:ttt (/ OBJ NEWVAL DXF NT OT m n E)
 (setq olderr *error* *error* err)
 (defun entry()
 (princ "Copyright © 1998 by Han Ngoc Duc, DHXD")
)
(command"undo""g")
 (prompt "\nSelect text to be changed: ")
 (setq OBJ (ssget))
 (if (null OBJ) (exit))
 (setq n (sslength OBJ))
 (setq m 0)
 (setq NEWVAL (entsel "\nSelect target text: "))
 (if (/= NEWVAL nil)
    (progn
       (setq NEWVAL (entget (car NEWVAL)))
       (setq NT (assoc 1 NEWVAL))
(repeat n
  (setq E (ssname OBJ m))
         (setq E (entget E))
  (setq OT (assoc 1 E))
  (setq E (subst NT OT E))
  (entmod E)
  (setq m (1+ m))
       )
    )
    (progn
  (setq DXF 1 
	NEWVAL (getstring "\nInput new text: ") )
  (while (< m n)
    (if (= "TEXT" (cdr (assoc 0 (setq E (entget (ssname OBJ m))))))
      (progn
        (setq T2 (assoc DXF E) E (subst (cons DXF NEWVAL) T2 E))
        (entmod E)
        (setq m (1+ m) )
      )
    )
  )
    )  
 )  
  (command"undo""e")
 (setq *error* olderr)
 (princ)
)

;===== AUTO HATCH (hh) ========

(defun mkhatch(v_hatchtp v_scale v_angle data_m / i)
(command "hatch" v_hatchtp v_scale v_angle)
(setq i 0)
(while (< i (length data_m)) (progn
	(command (nth i data_m))
	(setq i (+ i 1))
))
(command "")  
)

(defun c:hh(/ data_m check)


(defun ah_import(/ p1 p2 old1 ent1 ent2 axa)
 (if (= nil hscale_d) (setq hscale_d 1))  
 (setq old1 (getvar "osmode") check 1)
 (setvar "osmode" 0)
 (setq p1 '(0 0 0) p2 p1)
 (command "line"  p1 p2 "")

 (setq data_m '())
 (setq ent1 (entlast) ent2 ent1)

 (princ ent1)

 (setvar "osmode" old1)

 (command "boundary")
 (setq p1 (getpoint))
 (while (not (= nil p1)) (progn

(command p1)


(setq p1 (getpoint))

 ))
 (command "")

 (setq ent1 (entnext ent1))

 (princ ent1)
 (if (= nil ent1) (setq check 0) (progn
(while (not (= nil ent1)) (progn
	(setq data_m (append data_m (list ent1)))
	(setq ent1 (entnext ent1))
))
 ))
 (command "erase" ent2 "")
 (princ)
)

(defun ah_procced(/ i s1)

 (if (= 0 check) (princ "\ninvalid data") (progn
(initget 1 "WALL W CONCRETE C GROUND G FLOOR F")
 	(setq s1 (getkword "\nWall/Concrete/Ground/Floor : "))
(if (not (= nil s1)) (progn
	(cond
	  ((or (= "W" (strcase s1)) (= "WALL" (strcase s1))) (mkhatch "ansi31" (* 750 hscale_d) 0 data_m))
	  ((or (= "C" (strcase s1)) (= "CONCRETE" (strcase s1))) (progn
			(mkhatch "ansi31" (* 200 hscale_d) 0 data_m)
   			(mkhatch "ar-conc" (* 20 hscale_d) 0 data_m)

	  ))
	  ((or (= "G" (strcase s1)) (= "GROUND" (strcase s1))) (mkhatch "ansi38" (* 600 hscale_d) 0 data_m))
	  ((or (= "F" (strcase s1)) (= "FLOOR" (strcase s1))) (mkhatch "ar-conc" (* 20 hscale_d) 0 data_m))
	)
   ))						 

(command "erase")
(setq i 0)
(while (< i (length data_m)) (progn
	(command (nth i data_m))
	(setq i (+ i 1))
))
(command "")
 ))

 (princ)
)
 (ai_undo_push)	
 (ah_import)

 (ah_procced)
 (ai_undo_pop)
)


(defun c:hscale(/ i)
 (ai_undo_push)
 (if (= nil hscale_d) (setq hscale_d 1))
 (setq i (getreal (strcat (strcat "enter new hatch scale <" (rtos hscale_d 2 5)) "> ")))
 (if (not (= nil i)) (setq hscale_d i))
 (ai_undo_pop)
 (princ)
)
;===== AUTO DRAW DOOR-WINDOW (d1,w1,w2) ========

(defun moveent(ls1 post1 post2 / ls2 ent1 ent2 ent3 i)
   (setq ent1 (nth post1 ls1) ent2 (nth post2 ls1) i 0 ls2 '())
   (while (< i (length ls1)) (progn
       (if (= i post1) (setq ent3 ent2)
           (if (= i post2) (setq ent3 ent1) (setq ent3 (nth i ls1))
           )
       )
       (if (= nil ls2) (setq ls2 (list ent3))
           (setq ls2 (append ls2 (list ent3)))
       )
       (setq i (+ i 1))
   ))
   (setq ls1 ls2)
)

(defun arlst(ls1 / ls2 i j k)
;    (princ ls1)
   (setq i 0 ls2 ls1)
   (if (> (length ls2) 1) (progn
       (while (< i (- (length ls2) 1) ) (progn
           (setq j (+ i 1) k 0)
           (while (and (= 0 k) (< j (length ls2) )) (progn
               (if (< (nth j ls2) (nth i ls2)) (progn
                   ;(setq k 1)
                   (setq ls2 (moveent ls2 i j))
               ))
               (setq j (+ j 1))
           ))
           (setq i (+ i 1))
       ))
   ))
   (setq ls1 ls2)
)

(defun mkline(point1 point2 line1 / line2 i)
   (setq i 0 line2 '())
   (while (< i (length line1)) (progn
       (if (and (not (= 10 (car (nth i line1))) )
                (not (= 11 (car (nth i line1))))) (progn
                   (if (= nil line2) (setq line2 (list (nth i line1)))
                       (setq line2 (append line2 (list (nth i line1))))
                   )
                ))
       (setq i (+ i 1))
   ))
   (setq point1 (list 0 (nth 0 point1) (nth 1 point1) (nth 2 point1)))
   (setq point2 (list 0 (nth 0 point2) (nth 1 point2) (nth 2 point2)))
   (setq line2 (append line2 (list (cons 10 (cdr point1)))))
   (setq line2 (append line2 (list (cons 11 (cdr point2)))))
;    (princ line2)
   (entmake line2)
   (princ)
)

(defun drawrec (point1 point2 l1 / point3 point4)
   (setq point3 (list (nth 0 point1) (nth 1 point2) 0))
   (mkline point1 point3 l1) (mkline point2 point3 l1)
   (setq point3 (list (nth 0 point2) (nth 1 point1) 0))
   (mkline point1 point3 l1) (mkline point2 point3 l1)

)

(defun drawrt (point1 point2 / point3 point4 x l1)
   (setq l1 (list
       (cons 0 "line")
       (cons 8 (getvar "clayer"))
   ))

   (drawrec point1 point2 l1)
   (setq x (abs (- (nth 0 point1) (nth 0 point2))))
   (setq point3 (list (+ (nth 0 point1) (* 0.15 x) ) (nth 1 point1) 0))
   (setq point4 (list (nth 0 point3) (nth 1 point2) 0))
   (mkline point3 point4 l1)

   (setq point3 (list (- (nth 0 point2) (* 0.15 x) ) (nth 1 point1) 0))
   (setq point4 (list (nth 0 point3) (nth 1 point2) 0))
   (mkline point3 point4 l1)

   (setq point3 (list (+ (nth 0 point1) (* 0.15 x) ) (* 0.5 (+(nth 1 point1) (nth 1 point2))) 0))
   (setq point4 (list (- (nth 0 point2) (* 0.15 x) ) (nth 1 point3) 0))
   (mkline point3 point4 l1)

   (princ)
)

(defun drawrt1 (point1 point2 / point3 point4 x l1)
   (setq l1 (list
       (cons 0 "line")
       (cons 8 (getvar "clayer"))
   ))

   (drawrec point1 point2 l1)
   (setq x (abs (- (nth 1 point1) (nth 1 point2))))
   (setq point3 (list (nth 0 point1) (+ (nth 1 point1) (* 0.15 x) ) 0))
   (setq point4 (list (nth 0 point2) (nth 1 point3) 0))
   (mkline point3 point4 l1)

   (setq point3 (list (nth 0 point1) (- (nth 1 point2) (* 0.15 x) ) 0))
   (setq point4 (list (nth 0 point2) (nth 1 point3) 0))
   (mkline point3 point4 l1)

   (setq point3 (list (* 0.5 (+ (nth 0 point1) (nth 0 point2))) (+ (nth 1 point1) (* 0.15 x) ) 0))    (setq point4 (list (nth 0 point3) (- (nth 1 point2) (* 0.15 x) ) 0))
   (mkline point3 point4 l1)

   (princ)
)

(defun drawrt2(pt1 pt2 l1 / pt3 pt4 i dy1 dy2 qt)
   (setq pt3 (list (nth 0 pt1) (nth 1 pt2) 0))
   (mkline pt1 pt3 l1)
   (setq pt3 (list (nth 0 pt2) (nth 1 pt1) 0))
   (mkline pt2 pt3 l1)
   (if (< 150 (- (nth 1 pt2) (nth 1 pt1))) (setq dy1 40)
       (setq dy1 (* 0.3 (- (nth 1 pt2) (nth 1 pt1)))) )
   (setq qt (fix (/ (- (- (nth 1 pt2) (nth 1 pt1)) dy1) (+ 650 dy1))))
   (if (= 0 qt) (setq dy2 (- (- (nth 1 pt2) (nth 1 pt1)) (* 2 dy1))) 
   (setq dy2 (/ (- (- (nth 1 pt2) (nth 1 pt1)) (* (+ qt 1) dy1)) qt))
   )
   (if (= 0 qt) (setq qt 1))
   (setq i 0)
   (while (< i qt) (progn
       (setq pt3 (list (nth 0 pt1) (+ (nth 1 pt1) (+ dy1 (* (+ dy1 dy2) i))) 0))
       (setq pt4 (list (nth 0 pt2) (nth 1 pt3) 0))
       (mkline pt3 pt4 l1)

       (setq pt3 (list (nth 0 pt1) (+ (nth 1 pt3) dy2) 0))
       (setq pt4 (list (nth 0 pt2) (nth 1 pt3) 0))
       (mkline pt3 pt4 l1)

       (setq pt3 (list (+ (nth 0 pt1) (* 0.38 (- (nth 0 pt2) (nth 0 pt1)))) (nth 1 pt3) 0))
       (setq pt4 (list (nth 0 pt3) (- (nth 1 pt3) dy2) 0))
       (mkline pt3 pt4 l1)

       (setq pt3 (list (- (nth 0 pt2) (* 0.38 (- (nth 0 pt2) (nth 0 pt1)))) (nth 1 pt3) 0))
       (setq pt4 (list (nth 0 pt3) (- (nth 1 pt3) dy2) 0))
       (mkline pt3 pt4 l1)

       (setq i (+ i 1))
   ))
;    (princ qt)
   (princ)
)

(defun drawrt3(pt1 pt2 l1 / pt3 pt4 i dy1 dy2 qt)
   (setq pt3 (list (nth 0 pt2) (nth 1 pt1) 0))
   (mkline pt1 pt3 l1)
   (setq pt3 (list (nth 0 pt1) (nth 1 pt2) 0))
   (mkline pt2 pt3 l1)
   (if (< 150 (- (nth 0 pt2) (nth 0 pt1))) (setq dy1 60)
       (setq dy1 (* 0.3 (- (nth 0 pt2) (nth 0 pt1)))) )
   (setq qt (fix (/ (- (- (nth 0 pt2) (nth 0 pt1)) dy1) (+ 650 dy1))))
   (if (= 0 qt) (setq dy2 (- (- (nth 0 pt2) (nth 0 pt1)) (* 2 dy1))) 
   (setq dy2 (/ (- (- (nth 0 pt2) (nth 0 pt1)) (* (+ qt 1) dy1)) qt))
   )
   (if (= 0 qt) (setq qt 1))
   (setq i 0)
   (while (< i qt) (progn
       (setq pt3 (list (+ (nth 0 pt1) (+ dy1 (* (+ dy1 dy2) i))) (nth 1 pt1) 0))
       (setq pt4 (list (nth 0 pt3) (nth 1 pt2) 0))
       (mkline pt3 pt4 l1)

       (setq pt3 (list (+ (nth 0 pt3) dy2) (nth 1 pt1) 0))
       (setq pt4 (list (nth 0 pt3) (nth 1 pt2) 0))
       (mkline pt3 pt4 l1)

       (setq pt3 (list (nth 0 pt3) (+ (nth 1 pt1) (* 0.38 (- (nth 1 pt2) (nth 1 pt1)))) 0))
       (setq pt4 (list (- (nth 0 pt3) dy2) (nth 1 pt3) 0))
       (mkline pt3 pt4 l1)

       (setq pt3 (list (nth 0 pt3) (- (nth 1 pt2) (* 0.38 (- (nth 1 pt2) (nth 1 pt1)))) 0))
       (setq pt4 (list (- (nth 0 pt3) dy2) (nth 1 pt3) 0))
       (mkline pt3 pt4 l1)

       (setq i (+ i 1))
   ))
;    (princ qt)
   (princ)
)





(defun c:d1(/ data_m l1 l2 p1 p2 check)

(defun dw_import(/ p3 p4 p5 p6)
   (setq data_m (ssget))
   (setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :"))
   (setq l1 nil l2 nil check 1)
   (if (not (= nil data_m)) (progn
       (setq l1 (entget (ssname data_m 0)))
       (setq l2 (entget (ssname data_m 1)))
       (if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0))
       (if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0))
       (if (not (= 0 (-(sslength data_m) 2))) (setq check 0))
       (if (= 1 check) (progn
           (setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3)))
           (setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4)))
           (setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5)))
           (setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6)))
           (if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0))
       ))
   ) (setq check 0))
   (princ)
)

(defun dw_procced()

(defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom)

   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 
   (if (> (abs (- (nth 1 p1) (nth 1 p3)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p1) (nth 1 p4)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p5)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p6)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (= 0 check) (princ "\ninvalid data") (progn
       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p3) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p5) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p5) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 0 p3) (nth 1 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 2 ls1) 0))
       (mkline p7 p8 l1)

       (setq getom (getvar "osmode"))
       (setvar "osmode" 0)
       (if (< (nth 1 p1) (nth 1 p2)) (progn
           (setq ls2 (arlst (list (nth 0 p1) (nth 0 p3) (nth 0 p5) )))
           ;(princ ls2)
           (if (= (nth 0 p1) (nth 0 ls2)) (progn
               (setq p7 (list (nth 1 ls2) (nth 1 ls1) 0))

               (setq p8 (list (- (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) ))) )
                                 (+ (nth 1 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0))
               ;(princ p8)
               (drawrt p8 p7)
               (setq p9 p7) 
               (setq p7 (list (nth 0 p7) (nth 1 p8) 0))
               (setq p9 (list (nth 1 ls2) (nth 2 ls1) 0))
               (setvar "cmdecho" 0)
               (command "arc" "c" p7 p9 p8)
               (setvar "cmdecho" 1)
           )(progn
               (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5) )))
               (setq p7 (list (nth 1 ls2) (nth 1 ls1) 0))
               (setq p8 (list (+ (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) ))) )
                                 (+ (nth 1 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0))
               (drawrt p7 p8)
               (setq p9 p7) 
               (setq p7 (list (nth 0 p7) (nth 1 p8) 0))
               (setq p9 (list (nth 1 ls2) (nth 2 ls1) 0))
               (setvar "cmdecho" 0)
               (command "arc" "c" p7 p8 p9)
               (setvar "cmdecho" 1)
           ))
       ) (progn
           (setq ls2 (arlst (list (nth 0 p1) (nth 0 p3) (nth 0 p5) )))
           (if (= (nth 0 p1) (nth 0 ls2)) (progn
               (setq p7 (list (nth 1 ls2) (nth 2 ls1) 0))

               (setq p8 (list (- (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) ))) )
                                 (- (nth 2 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0))
               ;(princ p8)
               (drawrt p8 p7)
               (setq p9 p7) 
               (setq p7 (list (nth 0 p7) (nth 1 p8) 0))
               (setq p9 (list (nth 1 ls2) (nth 1 ls1) 0))
               (setvar "cmdecho" 0)
               (command "arc" "c" p7 p8 p9)
               (setvar "cmdecho" 1)
           )(progn
               (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5) )))
               (setq p7 (list (nth 1 ls2) (nth 2 ls1) 0))
               (setq p8 (list (+ (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) ))) )
                                 (- (nth 2 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0))
               (drawrt p7 p8)
               (setq p9 p7) 
               (setq p7 (list (nth 0 p7) (nth 1 p8) 0))
               (setq p9 (list (nth 1 ls2) (nth 1 ls1) 0))
               (setvar "cmdecho" 0)
               (command "arc" "c" p7 p9 p8)
               (setvar "cmdecho" 1)
           ))

       ))
       (setvar "osmode" getom)
       (setvar "cmdecho" 0)
       (command "erase" data_m "")
       (setvar "cmdecho" 1)
   ))
   (princ)
)



(defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom)
   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 

   (if (> (abs (- (nth 0 p1) (nth 0 p3)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p1) (nth 0 p4)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p5)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p6)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))

   (if (= 0 check) (princ "\ninvalid data") (progn
       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 1 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 2 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

       (setq getom (getvar "osmode"))
       (setvar "osmode" 0)
       (if (< (nth 0 p1) (nth 0 p2)) (progn
           (setq ls2 (arlst (list (nth 1 p1) (nth 1 p3) (nth 1 p5) )))
           ;(princ ls2)
           (if (= (nth 1 p1) (nth 0 ls2)) (progn
               (setq p7 (list (nth 1 ls1) (nth 1 ls2) 0))

               (setq p8 (list (+ (nth 1 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) ))))
                               (- (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0))
               ;(princ p8)
               (drawrt1 p8 p7)
               (setq p9 p7) 
               (setq p7 (list (nth 0 p8) (nth 1 p7) 0))
               (setq p9 (list (nth 2 ls1) (nth 1 ls2) 0))
               (setvar "cmdecho" 0)
               (command "arc" "c" p7 p8 p9)
               (setvar "cmdecho" 1)
           )(progn
               (setq ls2 (arlst (list (nth 1 p3) (nth 1 p5) )))
               (setq p7 (list (nth 1 ls1) (nth 1 ls2) 0))

               (setq p8 (list (+ (nth 1 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) ))))
                               (+ (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0))
;                (princ p7)
;                (princ p8)
               (drawrt1 p7 p8)    
               (setq p9 p7) 
               (setq p7 (list (nth 0 p8) (nth 1 p7) 0))
               (setq p9 (list (nth 2 ls1) (nth 1 ls2) 0))
               (setvar "cmdecho" 0)
               (command "arc" "c" p7 p9 p8)
               (setvar "cmdecho" 1)
           ))
       ) (progn
           (setq ls2 (arlst (list (nth 1 p1) (nth 1 p3) (nth 1 p5) )))
           ;(princ ls2)
           (if (= (nth 1 p1) (nth 0 ls2)) (progn
               (setq p7 (list (nth 2 ls1) (nth 1 ls2) 0))

               (setq p8 (list (- (nth 2 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) ))))
                               (- (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0))
               ;(princ p8)
               (drawrt1 p8 p7)
               (setq p9 p7) 
               (setq p7 (list (nth 0 p8) (nth 1 p7) 0))
               (setq p9 (list (nth 1 ls1) (nth 1 ls2) 0))
               (setvar "cmdecho" 0)
               (command "arc" "c" p7 p9 p8)
               (setvar "cmdecho" 1)
           )(progn
               (setq ls2 (arlst (list (nth 1 p3) (nth 1 p5) )))
               (setq p7 (list (nth 2 ls1) (nth 1 ls2) 0))

               (setq p8 (list (- (nth 2 ls1) (* 0.05 (abs (- (nth 1 ls1) (nth 2 ls1) ))))
                               (+ (nth 1 ls2) (* 0.95 (abs (- (nth 1 ls1) (nth 2 ls1) )))) 0))
;                (princ p7)
;                (princ p8)
               (drawrt1 p7 p8)    
               (setq p9 p7) 
               (setq p7 (list (nth 0 p8) (nth 1 p7) 0))
               (setq p9 (list (nth 1 ls1) (nth 1 ls2) 0))
               (setvar "cmdecho" 0)
               (command "arc" "c" p7 p8 p9)
               (setvar "cmdecho" 1)

           ))

       ))
       (setvar "osmode" getom)
       (setvar "cmdecho" 0)
       (command "erase" data_m "")
       (setvar "cmdecho" 1)
   ))



   (princ) 
)
   (setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1)
   (if (= 0 check) (princ "\ninvalid data") (progn
       (if (< (abs (- (nth 0 (cdr (assoc 10 l1)))
                      (nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv))
       (if (< (abs (- (nth 1 (cdr (assoc 10 l1)))
                      (nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh))


   ))

   (princ)
)

   (dw_import)
 	(ai_undo_push)
   (dw_procced)
 	(ai_undo_pop)

)


(defun c:w1(/ data_m l1 l2 p1 p2 check)
(defun c:ff ()
 (command "fillet" "r" "0")
)
(Defun C:LLO (/ LAY)

 (setq LAY (entsel "\nChon 1 doi tuong tren Layer May muon Khoa: "))

 (if LAY
   (progn
     (setq LAY (cdr (assoc 8 (entget (car LAY)))))
     (Command "_.-LAYER" "_LOCK" LAY "")
     (prompt (strcat "\nLayer " LAY " Vua duoc Khoa. Xin cam on!."))
   )
 )



 (princ)
)


; -------------------- LAYER UNLOCK FUNCTION ---------------------
; Bá kho¸ 1 layer cÇn chän
; ----------------------------------------------------------------

(Defun C:LLLO (/ LAY)

 (if (not (setq SS (ssget "i")))
   (progn
 (setq LAY (entsel "\nChon 1 doi tuong tren Layer May muon Mo Khoa: "))

     (Command "_.-LAYER" "_UNLOCK" LAY "")
     (prompt (strcat "\nLayer " LAY " Vua Duoc May mo Khoa. Ke ra May cung kha."))
   )
 )



 (princ)
)
(defun wd_import(/ p3 p4 p5 p6)
   (setq data_m (ssget))
   (setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :"))
   (setq l1 nil l2 nil check 1)
   (if (not (= nil data_m)) (progn
       (setq l1 (entget (ssname data_m 0)))
       (setq l2 (entget (ssname data_m 1)))
       (if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0))
       (if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0))
       (if (not (= 0 (-(sslength data_m) 2))) (setq check 0))
       (if (= 1 check) (progn
           (setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3)))
           (setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4)))
           (setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5)))
           (setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6)))
           (if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0))
       ))
   ) (setq check 0))
   (princ)
)

(defun wd_procced()

(defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 
   (if (> (abs (- (nth 1 p1) (nth 1 p3)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p1) (nth 1 p4)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p5)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p6)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (= 0 check) (princ "\ninvalid data") (progn
       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p3) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p5) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p5) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 0 p3) (nth 1 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 2 ls1) 0))
       (mkline p7 p8 l1)

       (setq getom (getvar "osmode"))
       (setvar "osmode" 0)

       (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5))))
       (setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))
       (setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))

       (setq ll1 (list
           (cons 0 "line")
           (cons 8 (getvar "clayer"))
       ))

       (drawrt2 p7 p8 ll1)

       (setvar "osmode" getom)
       (command "erase" data_m "")

   ))
   (princ)
)

(defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 

   (if (> (abs (- (nth 0 p1) (nth 0 p3)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p1) (nth 0 p4)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p5)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p6)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))

   (if (= 0 check) (princ "\ninvalid data") (progn

       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 1 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 2 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

       (setq getom (getvar "osmode"))
       (setvar "osmode" 0)

       (setq ls2 (arlst (list (nth 1 p3) (nth 1 p5))))
       (setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))
       (setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))

       (setq ll1 (list
           (cons 0 "line")
           (cons 8 (getvar "clayer"))
       ))

       (drawrt3 p7 p8 ll1)

       (setvar "osmode" getom)
       (command "erase" data_m "")


   ))
   (princ)
)

   (setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1)
   (if (= 0 check) (princ "\ninvalid data") (progn
       (if (< (abs (- (nth 0 (cdr (assoc 10 l1)))
                      (nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv))
       (if (< (abs (- (nth 1 (cdr (assoc 10 l1)))
                      (nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh))


   ))

   (princ)

)
   (wd_import)
 	(ai_undo_push)
   (wd_procced)
 	(ai_undo_pop)	
)


(defun c:w2(/ data_m l1 l2 p1 p2 check)

(defun wd_import(/ p3 p4 p5 p6)
   (setq data_m (ssget))
   (setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :"))
   (setq l1 nil l2 nil check 1)
   (if (not (= nil data_m)) (progn
       (setq l1 (entget (ssname data_m 0)))
       (setq l2 (entget (ssname data_m 1)))
       (if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0))
       (if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0))
       (if (not (= 0 (-(sslength data_m) 2))) (setq check 0))
       (if (= 1 check) (progn
           (setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3)))
           (setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4)))
           (setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5)))
           (setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6)))
           (if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0))
       ))
   ) (setq check 0))
   (princ)
)

(defun wd_procced()

(defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 
   (if (> (abs (- (nth 1 p1) (nth 1 p3)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p1) (nth 1 p4)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p5)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p6)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (= 0 check) (princ "\ninvalid data") (progn
       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p3) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p5) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p5) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 0 p3) (nth 1 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 2 ls1) 0))
       (mkline p7 p8 l1)

       (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5))))

       (setq ll1 (list
           (cons 0 "line")
           (cons 8 (getvar "clayer"))
       ))

	(if (< (nth 0 p1) (nth 0 ls2)) (progn
       	(setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))
		(setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))
		(setq p7 (list (* (+ (nth 0 p7) (nth 0 p8)) 0.5) (nth 1 p7) 0))
       	(drawrt2 p7 p8 ll1)

		(setq p7 (list (- (nth 0 ls2) 70) (- (nth 1 ls1) 100) 0))
		(setq p8 (list (- (nth 0 ls2) 70) (+ (nth 2 ls1) 100) 0))
		(mkline p7 p8 ll1)

		(setq p9 (list (+ (nth 0 p7) 70) (nth 1 p7) 0))
		(mkline p7 p9 ll1)

		(setq p9 (list (+ (nth 0 p8) 70) (nth 1 p8) 0))
		(mkline p8 p9 ll1)
    )(progn
	   	(setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))
		(setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))
		(setq p8 (list (* (+ (nth 0 p7) (nth 0 p8)) 0.5) (nth 1 p8) 0))
       	(drawrt2 p7 p8 ll1)

		(setq p7 (list (+ (nth 1 ls2) 70) (- (nth 1 ls1) 100) 0))
		(setq p8 (list (+ (nth 1 ls2) 70) (+ (nth 2 ls1) 100) 0))
		(mkline p7 p8 ll1)

		(setq p9 (list (- (nth 0 p7) 70) (nth 1 p7) 0))
		(mkline p7 p9 ll1)

		(setq p9 (list (- (nth 0 p8) 70) (nth 1 p8) 0))
		(mkline p8 p9 ll1)
	))


       (command "erase" data_m "")

   ))
   (princ)
)

(defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 

   (if (> (abs (- (nth 0 p1) (nth 0 p3)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p1) (nth 0 p4)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p5)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p6)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))

   (if (= 0 check) (princ "\ninvalid data") (progn

       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 1 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 2 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

	(setq getom (getvar "osmode"))
       (setvar "osmode" 0)

	(setq ll1 (list
            (cons 0 "line")
            (cons 8 (getvar "clayer"))
        ))
	(setq ls2 (arlst (list (nth 1 p3) (nth 1 p5))))
	;(princ ls2)

	(if (> (nth 1 p1) (nth 1 ls2)) (progn

       	(setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))
       	(setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))
		(setq p8 (list (nth 2 ls1) (* (+ (nth 1 p7) (nth 1 p8)) 0.5) 0))

       	(drawrt3 p7 p8 ll1)

		(setq p7 (list (- (nth 1 ls1) 100) (+ (nth 1 ls2) 70) 0))
		(setq p8 (list (+ (nth 2 ls1) 100) (+ (nth 1 ls2) 70) 0))
		(mkline p7 p8 ll1)

		(setq p9 (list (nth 0 p7) (- (nth 1 p7) 70) 0))
		(mkline p7 p9 ll1)

		(setq p9 (list (nth 0 p8) (- (nth 1 p8) 70) 0))
		(mkline p8 p9 ll1)
	)(progn
	  	(setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))
       	(setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))
		(setq p7 (list (nth 1 ls1) (* (+ (nth 1 p7) (nth 1 p8)) 0.5) 0))

		(drawrt3 p7 p8 ll1)


		(setq p7 (list (- (nth 1 ls1) 100) (- (nth 0 ls2) 70) 0))
		(setq p8 (list (+ (nth 2 ls1) 100) (- (nth 0 ls2) 70) 0))
		(mkline p7 p8 ll1)

		(setq p9 (list (nth 0 p7) (+ (nth 1 p7) 70) 0))
		(mkline p7 p9 ll1)

		(setq p9 (list (nth 0 p8) (+ (nth 1 p8) 70) 0))
		(mkline p8 p9 ll1)


	))

	(setvar "osmode" getom)

       (command "erase" data_m "")


   ))
   (princ)
)

   (setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1)
   (if (= 0 check) (princ "\ninvalid data") (progn
       (if (< (abs (- (nth 0 (cdr (assoc 10 l1)))
                      (nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv))
       (if (< (abs (- (nth 1 (cdr (assoc 10 l1)))
                      (nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh))


   ))

   (princ)

)
   (wd_import)
   (wd_procced)
)

;======= AUTO DIM (h1,v1,h2,v2) =======

(defun c:h1(/ data_m ls1 p1 p2)

(defun import(/ i ent p3 p4)

(defun putnum(/ j k l ls3)
;    (princ p3)
   (if (= nil ls1) (setq ls1 (list (nth 0 p3))) (progn
       (setq ls3 '() j 0 k 0)
       (while (and (< j (length ls1)) (= k 0)) (progn
           (if (< (nth 0 p3) (nth j ls1)) (setq k 1) (progn
               (if (= nil ls3) (setq ls3 (list (nth j ls1)) )
                   (setq ls3 (append ls3 (list (nth j ls1)))))
               (setq j (+ j 1))
;                (princ *x*)
           ))
       ))
;        (princ j)
       (if (= nil ls3) (progn
           (setq k nil l nil)
           (if (< j (length ls1)) 
           (setq k (abs (- (nth 0 p3) (nth j ls1)))) )
           (if (or (= nil k) (> k 0.0001))
           (setq ls3 (list (nth 0 p3)))
;            (princ "a")
       )) (progn
           (setq k nil l nil)
           (if (< j (length ls1)) 
           (setq k (abs (- (nth 0 p3) (nth j ls1)))) )
           (if (> j 0) 
           (setq l (abs (- (nth 0 p3) (nth (- j 1) ls1)))) ) 
;            (princ k) (princ l)
           (if (and (or (= nil k) (> k 0.0001)) (or (= nil l) (> l 0.0001))) 
           (setq ls3 (append ls3 (list (nth 0 p3)))) )
;            (princ "b")
       ))
;        (princ ls3)
       (while (< j (length ls1)) (progn
           (setq ls3 (append ls3 (list (nth j ls1))))
           (setq j (+ j 1))
;            (princ ls3)
       ))
       (setq ls1 ls3)
   ))
;    (princ ls1)
   (princ)
)

   (setq data_m (ssget) ls1 '())
   (setq p1 (getpoint "\nfirst point") p2 (getpoint "\nsecond point"))

   (setq i 0)
   (while (< i (sslength data_m)) (progn
       (setq ent (entget (ssname data_m i)))
       ;(princ ent)
       (if (= "LINE" (cdr (assoc 0 ent))) (progn
           (setq p3 (cdr (assoc 10 ent))) (putnum)
           (setq p3 (cdr (assoc 11 ent))) (putnum)
           ;(princ p3)
           ;(princ p4)
           ;(if (and (>  0.00001 (- (nth 0 p3) (nth 0 p4)))
           ;         (< -0.00001 (- (nth 0 p3) (nth 0 p4)))) (putnum))
       ))
       (setq i (+ i 1))
   ))
   (princ)
)

(defun procced(/ p3 p4 p5 i omd)
 	(setq omd (getvar "osmode"))
 	(setvar "osmode" 0)
 	(setvar "cmdecho" 0)
   (if (> (length ls1) 1) (progn
       (setq i 0)
       (command "dim")
       (while (< i (- (length ls1) 1)) (progn
           (setq p3 (list (nth i ls1) (nth 1 p1) (nth 2 p1) ))
           (setq p4 (list (nth (+ i 1) ls1) (nth 1 p1) (nth 2 p1)))
           (setq p5 (list (nth 0 p1) (nth 1 p2) (nth 2 p1)) )
           (if (> (abs (- (nth i ls1) (nth (+ i 1) ls1))) 0.0001)
           (command "hor" p3 p4 p5 ""))
           (setq i (+ i 1))

       ))
       (command "exit")
   ))
 	(setvar "osmode" omd)
 	(setvar "cmdecho" 1)
   (princ)
)

   (import)
 	(ai_undo_push)
   (procced)
   (ai_undo_pop)
 	(princ)
)

(defun c:v1(/ data_m ls1 p1 p2 omd)

(defun import(/ i ent p3 p4)

(defun putnum(/ j k l ls3)
;    (princ p3)
   (if (= nil ls1) (setq ls1 (list (nth 1 p3))) (progn
       (setq ls3 '() j 0 k 0)
       (while (and (< j (length ls1)) (= k 0)) (progn
           (if (< (nth 1 p3) (nth j ls1)) (setq k 1) (progn
               (if (= nil ls3) (setq ls3 (list (nth j ls1)) )
                   (setq ls3 (append ls3 (list (nth j ls1)))))
               (setq j (+ j 1))
;                (princ *x*)
           ))
       ))
;        (princ j)
       (if (= nil ls3) (progn
           (setq k nil l nil)
           (if (< j (length ls1)) 
           (setq k (abs (- (nth 1 p3) (nth j ls1)))) )
           (if (or (= nil k) (> k 0.0001))
           (setq ls3 (list (nth 1 p3)))
;            (princ "a")
       )) (progn
           (setq k nil l nil)
           (if (< j (length ls1)) 
           (setq k (abs (- (nth 1 p3) (nth j ls1)))) )
           (if (> j 0) 
           (setq l (abs (- (nth 1 p3) (nth (- j 1) ls1)))) ) 
;            (princ k) (princ l)
           (if (and (or (= nil k) (> k 0.0001)) (or (= nil l) (> l 0.0001))) 
           (setq ls3 (append ls3 (list (nth 1 p3)))) )
;            (princ "b")
       ))
;        (princ ls3)
       (while (< j (length ls1)) (progn
           (setq ls3 (append ls3 (list (nth j ls1))))
           (setq j (+ j 1))
;            (princ ls3)
       ))
       (setq ls1 ls3)
   ))
;    (princ ls1)
   (princ)
)

   (setq data_m (ssget) ls1 '())
   (setq p1 (getpoint "\nfirst point") p2 (getpoint "\nsecond point"))

   (setq i 0)
   (while (< i (sslength data_m)) (progn
       (setq ent (entget (ssname data_m i)))
       ;(princ ent)
       (if (= "LINE" (cdr (assoc 0 ent))) (progn
           (setq p3 (cdr (assoc 10 ent))) (putnum)
           (setq p3 (cdr (assoc 11 ent))) (putnum)
           ;(princ p3)
           ;(princ p4)
           ;(if (and (>  0.00001 (- (nth 1 p3) (nth 1 p4)))
           ;         (< -0.00001 (- (nth 1 p3) (nth 1 p4)))) (putnum))
       ))
       (setq i (+ i 1))
   ))
   (princ)
)

(defun procced(/ p3 p4 p5 i)
   (if (> (length ls1) 1) (progn
       (setq i 0)
       (command "dim")
       (while (< i (- (length ls1) 1)) (progn
           (setq p3 (list (nth 0 p1) (nth i ls1) 0 ))
           (setq p4 (list (nth 0 p1) (nth (+ i 1) ls1) 0 ))
           (setq p5 (list (nth 0 p2) (nth 1 p2) (nth 2 p1)) )
           (if (> (abs (- (nth i ls1) (nth (+ i 1) ls1))) 0.0001)
           (command "ver" p3 p4 p5 ""))
           (setq i (+ i 1))

       ))
       (command "exit")
   ))
   (princ)
)

   (import)
 	(ai_undo_push)
   (setq omd (getvar "osmode"))
   (setvar "osmode" 0)
   (procced)
   (setvar "osmode" omd)
 	(ai_undo_pop)
   (princ)
)




(defun c:h2(/ data_m ls1 p1 omd)

(defun import(/ i ent p3 p4)

(defun putnum(/ j k l ls3)
;    (princ p3)
   (if (= nil ls1) (setq ls1 (list (nth 0 p3))) (progn
       (setq ls3 '() j 0 k 0)
       (while (and (< j (length ls1)) (= k 0)) (progn
           (if (< (nth 0 p3) (nth j ls1)) (setq k 1) (progn
               (if (= nil ls3) (setq ls3 (list (nth j ls1)) )
                   (setq ls3 (append ls3 (list (nth j ls1)))))
               (setq j (+ j 1))
;                (princ *x*)
           ))
       ))
;        (princ j)
       (if (= nil ls3) (progn
           (setq k nil l nil)
           (if (< j (length ls1)) 
           (setq k (abs (- (nth 0 p3) (nth j ls1)))) )
           (if (or (= nil k) (> k 0.0001))
           (setq ls3 (list (nth 0 p3)))
;            (princ "a")
       )) (progn
           (setq k nil l nil)
           (if (< j (length ls1)) 
           (setq k (abs (- (nth 0 p3) (nth j ls1)))) )
           (if (> j 0) 
           (setq l (abs (- (nth 0 p3) (nth (- j 1) ls1)))) ) 
;            (princ k) (princ l)
           (if (and (or (= nil k) (> k 0.0001)) (or (= nil l) (> l 0.0001))) 
           (setq ls3 (append ls3 (list (nth 0 p3)))) )
;            (princ "b")
       ))
;        (princ ls3)
       (while (< j (length ls1)) (progn
           (setq ls3 (append ls3 (list (nth j ls1))))
           (setq j (+ j 1))
;            (princ ls3)
       ))
       (setq ls1 ls3)
   ))
;    (princ ls1)
   (princ)
)

   (setq data_m (ssget) ls1 '())
   (setq p1 (getpoint "\nPick point"))

   (setq i 0)
   (while (< i (sslength data_m)) (progn
       (setq ent (entget (ssname data_m i)))
       ;(princ ent)
       (if (= "LINE" (cdr (assoc 0 ent))) (progn
           (setq p3 (cdr (assoc 10 ent)))
           (setq p4 (cdr (assoc 11 ent)))
           (if (and (>  0.00001 (- (nth 0 p3) (nth 0 p4)))
                    (< -0.00001 (- (nth 0 p3) (nth 0 p4)))) (putnum))
       ))
       (setq i (+ i 1))
   ))
   (princ)
)

(defun procced(/ s1)

(defun putnumber(/ i p2)
;    (princ ls1)
   (if (= nil startnb) (setq startnb 1))
   (setq i (getint "\nEnter first number : "))
   (if (not (= nil i)) (setq startnb i))
   (setq i 0)
   (while (< i (- (length ls1) 1)) (progn
       (setq p2 (list (nth i ls1) (nth 1 p1) 0))
       (if (> (abs (- (nth i ls1) (nth (+ i 1) ls1))) 0.0001) (progn
           (command "circle" p2 300)
           (command "text" "j" "mc" p2 300 0 (itoa (+ i startnb)))
       ))
       (setq i (+ i 1))
   ))
   (if (< i (length ls1)) (progn
       (setq p2 (list (nth i ls1) (nth 1 p1) 0))
       (command "circle" p2 300)
       (command "text" "j" "mc" p2 300 0 (itoa (+ i startnb)))

   ))
   (princ)
)

(defun putchar(/ i)
;    (princ ls1)
   (if (= nil startnb) (setq startnb 0))
   (setq i "asd")
   (while (or (= nil i) (or (= " " i) (< 1 (strlen i)) ) ) 
       (setq i (getstring "\nEnter charater : ")))
   (if (not (= nil i)) (setq startnb (ascii (strcase i))))
   (setq i 0)
   (while (< i (- (length ls1) 1)) (progn
       (setq p2 (list (nth i ls1) (nth 1 p1) 0))
       (if (> (abs (- (nth i ls1) (nth (+ i 1) ls1))) 0.0001) (progn
           (command "circle" p2 300)
           (command "text" "j" "mc" p2 300 0 (chr (+ i startnb)))
       ))
       (setq i (+ i 1))
   ))
   (if (< i (length ls1)) (progn
       (setq p2 (list (nth i ls1) (nth 1 p1) 0))
       (command "circle" p2 300)
       (command "text" "j" "mc" p2 300 0 (chr (+ i startnb)))
   ))
   (princ)
)

   (if (> (length ls1) 0) (progn
       (initget 1 "Number Charater N C n c")
       (setq s1 (getkword "\nNumber/Charater : "))
       (if (not (= nil s1)) (progn
           (if (or (= (strcase s1) "NUMBER") (= (strcase s1) "N") ) 
           (putnumber) (putchar))
       ))
   ))
)

   (import)

   (setq omd (getvar "osmode"))
   (setvar "osmode" 0)
 	(ai_undo_push)
   (procced)
 	(ai_undo_pop)
   (setvar "osmode" omd)

   (princ)
)



(defun c:v2(/ data_m ls1 p1 omd)

(defun import(/ i ent p3 p4)

(defun putnum(/ j k l ls3)
;    (princ p3)
   (if (= nil ls1) (setq ls1 (list (nth 1 p3))) (progn
       (setq ls3 '() j 0 k 0)
       (while (and (< j (length ls1)) (= k 0)) (progn
           (if (< (nth 1 p3) (nth j ls1)) (setq k 1) (progn
               (if (= nil ls3) (setq ls3 (list (nth j ls1)) )
                   (setq ls3 (append ls3 (list (nth j ls1)))))
               (setq j (+ j 1))
;                (princ *x*)
           ))
       ))
;        (princ j)
       (if (= nil ls3) (progn
           (setq k nil l nil)
           (if (< j (length ls1)) 
           (setq k (abs (- (nth 1 p3) (nth j ls1)))) )
           (if (or (= nil k) (> k 0.0001))
           (setq ls3 (list (nth 1 p3)))
;            (princ "a")
       )) (progn
           (setq k nil l nil)
           (if (< j (length ls1)) 
           (setq k (abs (- (nth 1 p3) (nth j ls1)))) )
           (if (> j 0) 
           (setq l (abs (- (nth 1 p3) (nth (- j 1) ls1)))) ) 
;            (princ k) (princ l)
           (if (and (or (= nil k) (> k 0.0001)) (or (= nil l) (> l 0.0001))) 
           (setq ls3 (append ls3 (list (nth 1 p3)))) )
;            (princ "b")
       ))
;        (princ ls3)
       (while (< j (length ls1)) (progn
           (setq ls3 (append ls3 (list (nth j ls1))))
           (setq j (+ j 1))
;            (princ ls3)
       ))
       (setq ls1 ls3)
   ))
;    (princ ls1)
   (princ)
)

   (setq data_m (ssget) ls1 '())
   (setq p1 (getpoint "\nPick point"))

   (setq i 0)
   (while (< i (sslength data_m)) (progn
       (setq ent (entget (ssname data_m i)))
       ;(princ ent)
       (if (= "LINE" (cdr (assoc 0 ent))) (progn
           (setq p3 (cdr (assoc 10 ent)))
           (setq p4 (cdr (assoc 11 ent)))
           (if (and (>  0.00001 (- (nth 1 p3) (nth 1 p4)))
                    (< -0.00001 (- (nth 1 p3) (nth 1 p4)))) (putnum))
       ))
       (setq i (+ i 1))
   ))
   (princ)
)

(defun procced(/ s1)

(defun putnumber(/ i p2)
;    (princ ls1)
   (if (= nil startnb) (setq startnb 1))
   (setq i (getint "\nEnter first number : "))
   (if (not (= nil i)) (setq startnb i))
   (setq i 0)
   (while (< i (- (length ls1) 1)) (progn
       (setq p2 (list (nth 0 p1) (nth i ls1) 0))
       (if (> (abs (- (nth i ls1) (nth (+ i 1) ls1))) 0.0001) (progn
           (command "circle" p2 300)
           (command "text" "j" "mc" p2 300 0 (itoa (+ i startnb)))
       ))
       (setq i (+ i 1))
   ))
   (if (< i (length ls1)) (progn
       (setq p2 (list (nth 0 p1) (nth i ls1) 0))
       (command "circle" p2 300)
       (command "text" "j" "mc" p2 300 0 (itoa (+ i startnb)))

   ))
   (princ)
)

(defun putchar(/ i)
;    (princ ls1)
   (if (= nil startnb) (setq startnb 0))
   (setq i "asd")
   (while (or (= nil i) (or (= " " i) (< 1 (strlen i)) ) ) 
       (setq i (getstring "\nEnter charater : ")))
   (if (not (= nil i)) (setq startnb (ascii (strcase i))))
   (setq i 0)
   (while (< i (- (length ls1) 1)) (progn
       (setq p2 (list (nth 0 p1) (nth i ls1) 0))
       (if (> (abs (- (nth i ls1) (nth (+ i 1) ls1))) 0.0001) (progn
           (command "circle" p2 300)
           (command "text" "j" "mc" p2 300 0 (chr (+ i startnb)))
       ))
       (setq i (+ i 1))
   ))
   (if (< i (length ls1)) (progn
       (setq p2 (list (nth 0 p1) (nth i ls1) 0))
       (command "circle" p2 300)
       (command "text" "j" "mc" p2 300 0 (chr (+ i startnb)))

   ))
   (princ)
)

   (if (> (length ls1) 0) (progn
       (initget 1 "Number Charater N C n c")
       (setq s1 (getkword "\nNumber/Charater : "))
       (if (not (= nil s1)) (progn
           (if (or (= (strcase s1) "NUMBER") (= (strcase s1) "N") ) 
           (putnumber) (putchar))
       ))
   ))
)

   (import)
 	(ai_undo_push)
   (setq omd (getvar "osmode"))
   (setvar "osmode" 0)
   (procced)
   (setvar "osmode" omd)
 	(ai_undo_pop)
   (princ)
)


;====== OO (oo) =======

(defun c:OO(/ data_m)

(defun import_data(/ i)
   (setq data_m (ssget))
   (if (= nil distan_m) (setq distan_m 110.0))
   (princ "Distance (")
   (princ distan_m)
   (princ "):")
   (setq i (getreal ))
   (if (not (= nil i)) (setq distan_m i))
)

(defun process(/ ent check)

(defun p_check()
   (setq check 0)
   (if (= "LINE" (cdr (assoc 0 ent))) (setq check 1))
   (princ)
)

(defun p_d_offset(/ p1 p2 p3 p4)

(defun makeline(/ e2 e5)
;    (princ ent)
;    (setq e5 nil)
;    (setq e5 (cdr (assoc 5 ent)))
;    (princ e5)
;    (if (= nil e5) (setq e5 ))

   (setq la (list (cons 0 "LINE")
       (cons 5 (cdr (assoc 5 ent)) )
       (cons 8 (cdr (assoc 8 ent)) )
       (cons 10 p3)
       (cons 11 p4)
   ))
;    (princ la)
   (entmake la)
   (princ)
)

   (setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)) )
   (if (not (= p1 p2)) (progn
       (if (< (abs (- (nth 0 p1) (nth 0 p2))) 0.000001) (progn
           (setq p3 (list (+ (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
           (setq p4 (list (+ (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
           (makeline)
           (setq p3 (list (- (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
           (setq p4 (list (- (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
           (makeline)
       ))
       (if (< (abs (- (nth 1 p1) (nth 1 p2))) 0.000001) (progn
           (setq p3 (list (nth 0 p1) (+ (nth 1 p1) distan_m) (nth 2 p1) ) )
           (setq p4 (list (nth 0 p2) (+ (nth 1 p2) distan_m) (nth 2 p2) ) )
           (makeline)
           (setq p3 (list (nth 0 p1) (- (nth 1 p1) distan_m) (nth 2 p1) ) )
           (setq p4 (list (nth 0 p2) (- (nth 1 p2) distan_m) (nth 2 p2) ) )
           (makeline)
       ))

   ))
   (princ)
)

   (if (not (= nil data_m)) (progn
       (setq i 0)
       (while (< i (sslength data_m)) (progn
           (setq ent (entget (ssname data_m i)))
           (p_check)
           (if (= 1 check) (p_d_offset))
           (setq i (+ i 1))
       ))
   ))
   (princ)
)
   (import_data)
 	(ai_undo_push)
   (process)
 	(ai_undo_pop)
   (princ)
)

 

 

Lisp OFFSET 2 BÊN (OO) :

 

(defun c:oo(/ data_m)

(defun import_data(/ i)
(setq data_m (ssget))
(if (= nil distan_m) (setq distan_m 110.0))
(princ "Distance (")
(princ distan_m)
(princ "):")
(setq i (getreal ))
(if (not (= nil i)) (setq distan_m i))
)

(defun process(/ ent check)

(defun p_check()
(setq check 0)
(if (= "LINE" (cdr (assoc 0 ent))) (setq check 1))
(princ)
)

(defun p_d_offset(/ p1 p2 p3 p4)

(defun makeline(/ e2 e5)
; (princ ent)
; (setq e5 nil)
; (setq e5 (cdr (assoc 5 ent)))
; (princ e5)
; (if (= nil e5) (setq e5 ))

(setq la (list (cons 0 "LINE")
(cons 5 (cdr (assoc 5 ent)) )
(cons 8 (cdr (assoc 8 ent)) )
(cons 10 p3)
(cons 11 p4)
))
; (princ la)
(entmake la)
(princ)
)

(setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)) )
(if (not (= p1 p2)) (progn
(if (< (abs (- (nth 0 p1) (nth 0 p2))) 0.000001) (progn
(setq p3 (list (+ (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
(setq p4 (list (+ (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
(makeline)
(setq p3 (list (- (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
(setq p4 (list (- (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
(makeline)
))
(if (< (abs (- (nth 1 p1) (nth 1 p2))) 0.000001) (progn
(setq p3 (list (nth 0 p1) (+ (nth 1 p1) distan_m) (nth 2 p1) ) )
(setq p4 (list (nth 0 p2) (+ (nth 1 p2) distan_m) (nth 2 p2) ) )
(makeline)
(setq p3 (list (nth 0 p1) (- (nth 1 p1) distan_m) (nth 2 p1) ) )
(setq p4 (list (nth 0 p2) (- (nth 1 p2) distan_m) (nth 2 p2) ) )
(makeline)
))

))
(princ)
)

(if (not (= nil data_m)) (progn
(setq i 0)
(while (< i (sslength data_m)) (progn
(setq ent (entget (ssname data_m i)))
(p_check)
(if (= 1 check) (p_d_offset))
(setq i (+ i 1))
))
))
(princ)
)
(import_data)
(ai_undo_push)
(process)
(ai_undo_pop)
(princ)
)

 


<<

Filename: 117752_ttt_hh_hscale_d1_w1_ff_llo_lllo_w2_h1_v1_h2_v2_oo.lsp
Tác giả: duy267
Bài viết gốc: 198421
Tên lệnh: lpa
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Bạn thử Code này nhé!

Quick code

(defun c:LPA(/ ssc)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun...
>>

Bạn thử Code này nhé!

Quick code

(defun c:LPA(/ ssc)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)

 (mapcar 'set '(ssg vlaobj) L-ss-vlaobj)
 (setq L (sslength ssg))
 (Repeat L
   	(setq ename (ssname ssg (setq L (1- L))))
   (setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))
 )
)
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
 (if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
 (setq i -1)
 (Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
 )
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
 (setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)

 (setq ssc (ssadd))
 (if (setq ss (ssget '((0 . "*POLYLINE"))))
(Progn
 	(command "zoom" "e")
 	(foreach x (Tue-ss-list (list ss))
(if (ssget "cp" (Tue-ent-Lpoint x) (list (cons 0 "*TEXT") (cons 1 "*A*")))
  	(setq ssc (ssadd x ssc))
)
 	)
 	(if (= (sslength ssc) 0) (alert "\n Khong co PLINE nao co chua *TEXT ki tu A"))
)
 )
 (command "zoom" "p")
 (sssetfirst ssc ssc)
)

@DoanVanHa: Sorry bác! Tue_NV có sự nhầm lẫn trong các lệnh của CAD :blush:

Cảm ơn bác. Lisp rất tuyệt. Thì ra nó nằm ở cái đoạn

(if (ssget "cp" (Tue-ent-Lpoint x) (list (cons 0 "*TEXT") (cons 1 "*A*"))) (setq ssc (ssadd x ssc)))

Dựa vào lisp của bác em viết lại

(defun c:Chon (/ lstent khung lst1 ssc ent)
(setq lstent (acet-ss-to-list (setq khung (ssget '((0 . "LWPOLYLINE") (70 . 1))))))
(command "regenauto" "ON")
(command "zoom" "e")
(setq ssc (ssadd))
(foreach ent lstent
 (setq lst1 (acet-geom-vertex-list ent))
 (if (ssget "cp" lst1 (list (cons 0 "*TEXT") (cons 1 "*A*")))
  (setq ssc (ssadd ent ssc))
 )
)
(if (= (sslength ssc) 0) (alert "\n Khong co PLINE nao co chua *TEXT ki tu A"))
(command "zoom" "p")
(sssetfirst ssc ssc)
)

Em chỉ cần thế thôi. Không biết có cách nào viết ngắn hơn không.


<<

Filename: 198421_lpa.lsp
Tác giả: Tue_NV
Bài viết gốc: 114659
Tên lệnh: tlt
Nhờ sửa LISP ghi độ dốc đường thẳng
Bạn thử cái này xem sao nhé.

;; free lisp from cadviet.com

;; free lisp from cadviet.com
(defun c:TLT ()
  (setq os (getvar "osmode"))
  (setq caochu (getreal...
>>
Bạn thử cái này xem sao nhé.

;; free lisp from cadviet.com

;; free lisp from cadviet.com
(defun c:TLT ()
  (setq os (getvar "osmode"))
  (setq caochu (getreal "\nnhap cao chu: "))
  (setvar "osmode" 0)
(while (setq name (car (entsel "\nChon line can tinh do doc")))
  (setq ent (entget name))
(if (= (cdr (assoc 0 ent)) "LINE")
(progn
  (setq p (cdr (assoc 10 ent))
       p1 (cdr (assoc 11 ent)))
(if (> (car p) (car p1))
(progn
  (setq p (cdr (assoc 11 ent))
       p1 (cdr (assoc 10 ent)))
)
)
)
)
(if (= (cdr (assoc 0 ent)) "LWPOLYLINE")
(progn
  (setq listp (acet-geom-vertex-list name))
  (setq p (car listp)
       p1 (cadr listp))
(if (> (car p) (car p1))
(progn
  (setq p (cadr listp)
       p1 (car listp))
)
)
)
)
   (cond ((null tphan) (setq tphan 2)))
   (setq dau1 (car p))
   (setq cuoi1 (cadr p))
   (setq dau2 (car p1))
   (setq cuoi2 (cadr p1))
   (setq lx (abs (- dau1 dau2)))
   (setq ly (abs (- cuoi1 cuoi2)))
   (setq i (/ lx ly))
  (setq pt1 (polar p (angle p p1) (/ (distance p p1) 2)))
          (setq dau1 (+ 5 (car pt1)))
          (setq cuoi1 (cadr pt1))
          (setq goc (/ (* (angle p p1) 180) pi))
  (setq pt2 (polar pt1 (+ (angle p p1) (/ pi 2)) caochu))
          (setq chuoi (strcat "1/" (rtos i 2 tphan)))
          (command "text" "J" "M" pt2 caochu goc chuoi )
)
(setvar "osmode" os)         
)

Tue_NV có cái này muốn nhắc bạn :

Tên biến không để trùng với tên hàm :

 

(setq listp (acet-geom-vertex-list name))

(setq p (car listp)

p1 (cadr listp))

(if (> (car p) (car p1))

(progn

(setq p (cadr listp)

p1 (car listp))

)

)


<<

Filename: 114659_tlt.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 433852
Tên lệnh: test
Nhờ các bác tạo giúp lisp cộng trừ số của TEXT OVERRIDE DIm
Vào lúc 10/3/2019 tại 08:57, vanhuyou đã nói:

Chào các bác, em có...

>>
Vào lúc 10/3/2019 tại 08:57, vanhuyou đã nói:

Chào các bác, em có download được 1 dim ghi số lượng đai vào TEXT OVERRIDE của DIM, nhờ các bác giúp tạo cái lisp để cộng lại số lượng của các TEXT OVERRIDE đó vì mỗi lần cộng phải bấm máy mất thời gian. Mong các bác giúp đỡ, cụ thể là:

- Chọn DIM cần cộng

- Đưa ra số lượng lên bảng thông báo hoặc chọn text để ghi với cú pháp: 13∅6a200

Mong các bác giúp đỡ.

image.png.062a3868690fff995ca630b4ed6906df.png

 

Drawing1.dwg

(vl-load-com)
(defun c:test (/ ss tong ent ovr a b c text)
  (setq ss (acet-ss-to-list (ssget (list (cons 0 "*DIM*")))))
  (setq tong 0)
  (foreach ent ss
    (setq ovr (vla-get-textoverride (vlax-ename->vla-object ent)))
 (if  (setq a (vl-string-search "X" ovr)
 	    b (vl-string-search "%%" ovr)) (progn
  (setq	c (substr ovr (+ a 2) (- b (1+ a)))
	tong (+ tong (atoi c)))
  ))
    )
    (if (and (setq text (car (entsel "\n Pick Text")))
	     (Wcmatch (cdr (assoc 0 (entget text))) "*TEXT"))
      (vla-put-textstring (vlax-ename->vla-object text) (itoa tong))
    (alert (itoa tong)) )
  )

Không hiểu rõ ý yêu cầu lắm, viết thế này chủ thớt xem được chưa


<<

Filename: 433852_test.lsp
Tác giả: jangboko
Bài viết gốc: 414696
Tên lệnh: adjustdim selfadjustdim
Lisp dim khoảng cách liên tiếp trên Polyline - Pline

Cái này có lẽ phải dùng lisp thôi

Bạn dùng thử

lệnh là :

- SelfAdjustDim : dùng khi chiều dài 2 chân dim = nhau, dim nằm...

>>

Cái này có lẽ phải dùng lisp thôi

Bạn dùng thử

lệnh là :

- SelfAdjustDim : dùng khi chiều dài 2 chân dim = nhau, dim nằm trong cùng

- AdjustDim : dùng khi định vị trí dimline với 1 điểm cho trước

Đã sửa phần đổi hệ tọa độ

 

(defun Dxf(n e) (cdr (assoc n e)))

(defun ModDxf(n v e)

    (if (Dxf n e)

        (entmod (subst (cons n  v) (assoc n e) e))

        (entmod (append e (list (cons n  v))))

    )

)

(defun TSel(et ms)     (if ms (princ ms))    (ssget (if et (list (cons 0  et))))    )



(defun DimSpace () (* (getvar "DIMSCALE") (getvar "dimscale")))



(defun AdjustDim1 (p l e / a)

    (if (= 0 (logand 92 (Dxf 70 e)))

        (progn

            (setq a (angle (Dxf 14 e) (Dxf 10 e)))

            (ModDxf 10 (polar p a  (if (= 1 (rem  (Dxf 70 e) 2)) l (/ l (abs (sin (- a (Dxf 50 e))))))) e )    )

    )

)

 

(defun AdjustDim(ss l / i p)

  (if ss

        (progn

            (setq p (trans (getpoint "\nBase point:")1 0) i -1)

      (repeat (sslength ss)

            (setq i (1+ i) )    (AdjustDim1 p l (entget (ssname ss i)))

    )    ) )(princ)

)



(defun C:AdjustDim()    (AdjustDim (TSel "DIMENSION" "\nSelect Dimensions :") (DimSpace)))



(defun C:SelfAdjustDim( / e)

  (setq i -1 ss (TSel "DIMENSION" "\nSelect Dimensions :") )

  (if ss

    (repeat (sslength ss)

            (setq i (1+ i) e (entget (ssname ss i))  )

            (AdjustDim1 (Dxf 14 e) (DimSpace) e)

  ) )(princ)

)

chào bạn,  lisp của bạn rất hay, mình sử dụng trong model thi ổn, nhưng khi sử dụng trong môi trường layout, sử dụng loại dim cho nhiều tỉ lệ thì nó lại ko dùng được. Vậy bạn ( hay bác nào đi ngang qua) giúp mình chỉnh cho lisp có thể sử dụng được ở trong môi trường layout. Cám ơn bạn nhiều.


<<

Filename: 414696_adjustdim_selfadjustdim.lsp
Tác giả: thanhduan2407
Bài viết gốc: 433992
Tên lệnh: 00
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Với ý tưởng tạo đường bao tối ưu chứa tập hợp các điểm Point và khoảng cách giữa các đoạn không vượt quá con số a nào đó nhằm tìm kiếm đường bao tối ưu bám sát các điểm nhất. Em đã cố gắng nghiên cứu rất lâu rồi nhưng chưa tìm ra cách. Mong các Pro chỉ giáo, viết hoặc gợi ý cho em với ạ! Em có sưu tầm được lisp của Lee-Mac về đường bao lồi Convex Hull nhưng chưa chỉnh...

>>

Với ý tưởng tạo đường bao tối ưu chứa tập hợp các điểm Point và khoảng cách giữa các đoạn không vượt quá con số a nào đó nhằm tìm kiếm đường bao tối ưu bám sát các điểm nhất. Em đã cố gắng nghiên cứu rất lâu rồi nhưng chưa tìm ra cách. Mong các Pro chỉ giáo, viết hoặc gợi ý cho em với ạ! Em có sưu tầm được lisp của Lee-Mac về đường bao lồi Convex Hull nhưng chưa chỉnh sửa được theo đúng ý mình. Em xin gửi code tham khảo lên đây và hình ảnh.

Cảm ơn các bác đã quan tâm.

(defun C:00 (/ LST LTSPOINT SSPOINT X )
  (setq ssPoint (ssget '((0 . "POINT"))))
  (if ssPoint
    (progn
      (setq LtsPoint (LM:ss->ent ssPoint))
      (setq lst (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) LtsPoint))
      (setq lst (LM:ConvexHull lst))
      (entmakex
	(append
	  (list
	    '(000 . "LWPOLYLINE")
	    '(100 . "AcDbEntity")
	    '(100 . "AcDbPolyline")
	    (cons 90 (length lst))
	    '(070 . 1)
	  )
	  (mapcar '(lambda (x) (cons 10 x)) lst)
	)
      )
    )
  )
  (princ)
)




;; Convex Hull  -  Lee Mac
;; Implements the Graham Scan Algorithm to return the Convex Hull of
;; a
;; list of
;; points.

(defun LM:ConvexHull (lst  / ch p0)
  (cond
    ((< (length lst) 4) lst)
    ((setq p0 (car lst))
     (foreach p1 (cdr lst)
       (if (or (< (cadr p1) (cadr p0))
	       (and (equal (cadr p1) (cadr p0) 1e-8)
		    (< (car p1) (car p0))
	       )
	   )
	 (setq p0 p1)
       )
     )
     (setq lst
	    (vl-sort
	      lst
	      (function
		(lambda	(a b / c d)
		  (if
		    (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
		     (< (distance p0 a) (distance p0 b))
		     (< c d)
		  )
		)
	      )
	    )
     )
     (setq ch (list (caddr lst) (cadr lst) (car lst)))
     (foreach pt (cdddr lst)
       (setq ch (cons pt ch))
       (while
	 (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
	  (setq ch (cons pt (cddr ch)))
       )
     )
     ch
    )
  )
)

;; Clockwise-p  -  Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented or collinear

(defun LM:Clockwise-p (p1 p2 p3)
  (< (-	(* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
	(* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))
     )
     1e-8
  )
)




(defun LM:ss->ent (ss / i l)
  (if ss
    (repeat (setq i (sslength ss))
      (setq l (cons (ssname ss (setq i (1- i))) l))
    )
  )
)

 

https://s844.photobucket.com/user/thanhduan2407/media/sssss_zpsxbqp2zsn.png.html

 


<<

Filename: 433992_00.lsp
Tác giả: 790312
Bài viết gốc: 68879
Tên lệnh: sd
Viết Lisp theo yêu cầu
Lệnh là SD (sắp dim)

 

Chương trình sẽ yêu cầu người sử dụng chọn đường Dim chuẩn. Sau đó, yêu cầu người sử dụng chọn các đường Dim cần sắp...

>>
Lệnh là SD (sắp dim)

 

Chương trình sẽ yêu cầu người sử dụng chọn đường Dim chuẩn. Sau đó, yêu cầu người sử dụng chọn các đường Dim cần sắp xếp. Chương trình sẽ tự động dàn các Dim theo hàng đều.

sapdim.gif

(defun c:sd ()
 (defun ss2ent	(ss / sodt index lstent)
   (setq
     sodt  (cond
      (ss (sslength ss))
      (t 0)
    )
     index 0
   )
   (repeat sodt
     (setq ent	   (ssname ss index)
    index  (1+ index)
    lstent (cons ent lstent)
     )
   )
   (reverse lstent)
 )
 (defun hoanh_newerror	(msg)
   (if	(and (/= msg "Function cancelled")
     (/= msg "quit / exit abort")
)
     (princ (strcat "\n" msg))
   )
   (done)
 )
 ;;----------
 (defun init ()
   (setq
     HOANH_CMD	     (getvar "CMDECHO")
     HOANH_OLDERROR *error*
     *error*	     hoanh_newerror

   )
   (setvar "CMDECHO" 0)
   (command ".undo" "BE")
 )
 ;;----------
 (defun done ()
   (command ".redraw")
   (command ".undo" "E")
   (if	HOANH_CMD
     (setvar "CMDECHO" HOANH_CMD)
   )
   (if	HOANH_OLDERROR
     (setq *error* HOANH_OLDERROR)
   )
   (princ)
 )
 ;;----------

 (defun cdim (entdt	pchan	 pduong	  /	   tt	    old10
       old13	old14	 new10	  new13	   new14    p10n
       p13n	p14n	 p10o	  p13o	   p14o	    gocduong
       gocchan	pchanb	 pduongb  loaidim
      )
   (defun chanvuonggoc	(ph p1 p2 / ptemp pkq goc)
     (setq
goc   (+ (angle p1 p2) (/ pi 2.0))
ptemp (polar ph goc 1000.0)
pkq   (inters ph ptemp p1 p2 nil)
     )
     pkq
   )
   (setq
     tt       (entget entdt)
     old10    (assoc '10 tt)
     old13    (assoc '13 tt)
     old14    (assoc '14 tt)
     p10o     (cdr old10)
     p13o     (cdr old13)
     p14o     (cdr old14)
     loaidim  (logand (cdr (assoc '70 tt)) 7)
     gocduong (cond
	 ((= loaidim 1) (angle p13o p14o))
	 ((= loaidim 0) (cdr (assoc '50 tt)))
	 (t nil)
       )
     pchan    (cond
	 (pchan (list (car pchan) (cadr pchan) 0.0))
	 (t pchan)
       )
     pduong   (cond
	 (pduong (list (car pduong) (cadr pduong) 0.0))
	 (t pduong)
       )

   )
   (if	gocduong
     (progn
(if pchan
  (setq
    pchanb (polar pchan gocduong 1000.0)
    p13n   (chanvuonggoc
	     (list (car p13o) (cadr p13o) 0.0)
	     pchan
	     pchanb
	   )
    p14n   (chanvuonggoc
	     (list (car p14o) (cadr p14o) 0.0)
	     pchan
	     pchanb
	   )
    new13  (cons 13 p13n)
    new14  (cons 14 p14n)
    tt	   (subst new13 old13 tt)
    tt	   (subst new14 old14 tt)
  )
)
(if pduong
  (setq
    pduongb (polar pduong gocduong 1000.0)
    p10n    (chanvuonggoc
	      (list (car p10o) (cadr p10o) 0.0)
	      pduong
	      pduongb
	    )
    new10   (cons 10 p10n)
    tt	    (subst new10 old10 tt)
  )
)
(entmod tt)
     )
   )
   gocduong
 )

 (defun textdimheight (ent / tmp)
   (command ".copy" ent "" (list 0.0 0.0 0.0) "@")
   (command ".explode" (entlast) "")
   (setq tmp (cdr (assoc 40 (entget (entlast)))))
   (command ".erase" "p" "")
   tmp
 )
 (defun phia (p1 p2 p3 / x1 y1 z1 x2 y2 z2 x3 y3 z3)
   (setq
     x1  (car p1)
     y1  (cadr p1)
     z1  (caddr p1)
     x2  (car p2)
     y2  (cadr p2)
     z2  (caddr p2)
     x3  (car p3)
     y3  (cadr p3)
     z3  (caddr p3)
     tmp (+ (* (- x1 x2) x3)
     (* (- y1 y2) y3)
     (* (- z1 z2) z3)
  )
   )
   (cond
     ((= tmp 0.0) 0.0)
     (t (/ tmp (abs tmp)))
   )
 )
 (defun khoangcachdim (p1 ent goc / tt p2 A B D)
   (setq tt (entget ent)
  p2 (cdr (assoc 10 tt))
  B  (cdr (assoc 50 tt))
  A  (angle p1 p2)
  D  (distance p1 p2)
   )
   (* (* D (sin (- A B ))) (phia p1 (polar p1 goc 1.0) p2))
 )

 (defun phanloai (ent)
   (setq
     kc   (khoangcachdim pgoc ent goc)
     loai (fix (/ kc heightdimgoc 0.93))
   )
   (cons loai ent)
 )

 (init)
 (princ "\nSap xep dim © CADViet.com")
 (while (not (setq entgoc (car (entsel "\nChon duong dim goc: "))))
 )
 (setq
   ttgoc	 (entget entgoc)
   p13goc	 (cdr (assoc 13 ttgoc))
   pgoc	 (cdr (assoc 10 ttgoc))
   goc		 (cdr (assoc 50 ttgoc))
   heightdimgoc (textdimheight entgoc)
   ssd		 (ssget	(list
		  (cons 0 "DIMENSION")
		  (cons -4 "			  (cons 70 32)
		  (cons 70 64)
		  (cons 70 96)
		  (cons 70 128)
		  (cons 70 160)
		  (cons 70 196)
		  (cons 70 224)
		  (cons -4 "OR>")
		  (cons -4 "			  (cons 50 goc)
		  (cons 50 (+ goc pi))
		  (cons 50 (- goc pi))
		  (cons -4 "OR>")
		)
	 )
   lstd	 (ss2ent ssd)
   lstd	 (mapcar 'phanloai lstd)
   lstlevel	 nil
 )
 (foreach pp lstd
   (if	(not (member (car pp) lstlevel))
     (setq lstlevel (append lstlevel (list (car pp))))
   )
 )
 (setq	lstlevel    (vl-sort lstlevel '(lambda (x1 x2) (< x1 x2)))
lstam	    nil
lstduong    nil
lstamtmp    nil
lstduongtmp nil
 )
 (foreach pp lstlevel
   (if	(< pp 0.0)
     (setq lstam (append lstam (list pp)))
   )
   (if	(> pp 0.0)
     (setq lstduong (append lstduong (list pp)))
   )
 )
 (setq index 0)
 (foreach pp (reverse lstam)
   (setq
     index    (1+ index)
     lstamtmp (append lstamtmp (list (cons pp index)))
   )
 )
 (setq
   lstam lstamtmp
   index 0
 )
 (foreach pp lstduong
   (setq
     index	  (1+ index)
     lstduongtmp (append lstduongtmp (list (cons pp index)))
   )
 )
 (setq lstduong lstduongtmp)
 (setq lstlevel (append lstduong lstam (list (cons 0.0 0))))

 (setq kcdimstandard (* 3.0 heightdimgoc))
 (foreach pp lstd
   (setq plht (car pp))
   (progn
     (setq
kcdimht	   (khoangcachdim pgoc (cdr pp) goc)
duongthu   (cdr (assoc plht lstlevel))
heso	   (cond
	     ((/= 0 kcdimht)
	      (abs (* (/ kcdimstandard kcdimht) duongthu))
	     )
	     (t 0.0)
	   )
diemchenht (cdr (assoc 10 (entget (cdr pp))))
pmoi	   (polar pgoc
		  (angle pgoc diemchenht)
		  (* heso (distance pgoc diemchenht))
	   )
     )

     (cdim (cdr pp) p13goc pmoi)
   )
 )
 (done)
)
(princ "\nSap xep dim, SD - free lisp from www.cadviet.com")
(princ)

Bác Hoành ơi,sau khi e đánh chữ SD vào nó kêu chọn đường dim goc,sau đó kêu chọn đối tượng,sau khi thực hiện thì cuối cùng báo lỗi là:

bad argument type: numberp: nil.Mong bác giúp em.Thanks


<<

Filename: 68879_sd.lsp

Trang 286/330

286