Chuyển đến nội dung
Diễn đàn CADViet
ngochavn

Listp bảng tọa độ vn2000

Bởi ngochavn , trong AutoLisp

Các bài được khuyến nghị

nhoclangbat    392

nhoclangbat
Đã đăng

-^^ nói đến chuyên môn thì nhoc còn phải mót nhiều, do hoàn cảnh, tính chất công việc hiện tai của nhoc , mỗi người 1 hoàn cảnh 1 lời khó mà nói hết a ah, chủ yếu là vì nhoc thích tìm tòi ^^, mỗi lần viết thấy vui, tương lai thế nào chưa rõ, cố đc đến đâu hay đến đó.

- Clip anh nhoc xem trước đó rùi ^^, cách biên tập của a nó không giống bên nhoc, bên nhoc nhoc cũng có vài công trình dạng tuyến chỉ rãi lưới đơn giản khổ giấy lớn hơn

- mục đích nhoc thử làm lsp này để hỗ trợ cho chương trình sẵn của cơ quan, nhưng có nhiều khi mình mún xử lý độc lập, còn chương trình nó hay ràng buộc theo nhiều cái khác khó xử lý tính huống nhanh^^

- nhoc ko giỏi hơn anh đâu ^^, nhoc chậm tiu lắm, chỉ cố gắng hết theo sức mình có

- nhoc có xem qua lsp tạo lưới của a, nhưng nó còn hơi cao với nhoc, nhìn lsp của nhoc đơn giản thui, nhưng mất đến 2 ngày nhoc mới làm xong kaka

;hàm tao textstyle
(defun emk_style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;;;;
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil))))) 
;;;;;;--------------------------------------------------------------------------------------------
;================================================================================================
(defun dtr (a)
(* (/ a 180.0) pi)
)
(prompt "LISP TAO LUOI TOA DO BAN DO VI TRI, LENH : KKL")
;;;
(defun c:kkl (/ donvi nx ny pt1 pt2 pt3 pt4 kcx kcy goc1 goc2 x1 x y  heso old ptext1 ptext2 ptext3 ptext4 str str2 goc3 htext num )
(vl-load-com)
(setq old (getvar "osmode"))
(if (null (tblsearch "STYLE" "vusaln"))
    (emk_style "vusaln" "Vaptimn.TTF"))
(if (null (tblsearch "LAYER" "A1-luoik"))
    (_layer2 "A1-luoik" 7))
  (setq donvi (list (cons 1  100) (cons 2  50) (cons 3  25)))
  (setq tyleVT (getvalue tyleVT 1000.0 "Nhap ty le ban do VT: "))
  (setq heso (/ 1000 tyleVT))
  (setq htext (/ 2.0 heso))
;===================================*******************++++++++++++++++++++********************===================================  
(while (and (setvar "osmode" 1)
            (setq pt1 (getpoint "\nChon diem goc duoi trai khung:"))
            (setq pt2 (getpoint pt1 "\nChon diem goc tren phai khung:")))
(progn
(setvar "osmode" 0)
;======================================================================
;=======================================================================
(setq pt3 (inters pt1 (polar pt1 (/ pi 2) 90000) pt2 (polar pt2 pi 90000) nil))
(setq pt4 (inters pt1 (polar pt1 0 90000) pt2 (polar pt2 (dtr 270) 90000) nil))
(setq kcx (distance pt1 pt4) kcy (distance pt1 pt3))
;==============================================================================
(cond 
((and (>= (/ kcx 100) 2) (>= (/ kcy 100) 2))
;==========================================================
(setq nx (fix (/ kcx 100)) ny (fix (/ kcy 100)))
(setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list (cdr (assoc 1 donvi)) 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 (cdr (assoc 1 donvi)) 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y (cdr (assoc 1 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 1 donvi))))
  )
;============================================================
) ;end 100


;========================================================++++++++++**************+++++++++=======================================================
((and (>= (/ kcx 50) 2) (>= (/ kcy 50) 2))
;==========================================================
(setq nx (fix (/ kcx 50)) ny (fix (/ kcy 50)))
(setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list (cdr (assoc 2 donvi)) 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 (cdr (assoc 2 donvi)) 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y (cdr (assoc 2 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 2 donvi))))
  )
;============================================================
) ;end 50
;============================================================******++++++++++++++++++++****************++++++++++++++++++++========================
((and (>= (/ kcx 25) 2) (>= (/ kcy 25) 2))
;==========================================================
(setq nx (fix (/ kcx 25)) ny (fix (/ kcy 25)))
(setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list (cdr (assoc 3 donvi)) 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 (cdr (assoc 3 donvi)) 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y (cdr (assoc 3 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 3 donvi))))
  )
;============================================================
) ;end  25
;==================================================*********************++++++++++++++++++++*************===========================
((and (< (/ kcx 25) 2) (< (/ kcy 25) 2))
(alert "Ban chon Khung KiBo qua\nVe Khung Lai Hen!!!^^")) ; end nho hon 25
) ;end cond
;==================================================================++++++++++**************+++++++++=======================================
) ;end progn of while pt1 pt2
) ; end  while
(setvar "osmode" old)
(princ)
)
;==============================================================================================
;;;;;;;;;;;;;;;;;;;;
(defun lamtron (n / sodu)
  (setq sodu (rem n 100))
  (if (/= sodu 0)
    (setq n (+ (- n sodu) 100))
  )
  n
)
;=================================
(defun vediem (xx yy r / left right top bot)
  (setq top (+ yy r))
  (setq bot (- yy r))
  (setq right (+ xx r))
  (setq left (- xx r))
  (makeline (list left yy) (list right yy) "A1-luoik" nil nil nil)
  (makeline (list xx top) (list xx bot) "A1-luoik" nil nil nil)
)
;============================
;=================================================================================
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;=====================================================================================
;; ham luu gia tri
(defun getvalue ( a giatri dongnhac / astr) 
(or a (setq a giatri))
(cond
	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 0) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;
;;ham tao text 2
(defun mktext (point height string justify layer textstyle mau / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 (if textstyle textstyle (getvar "textstyle")))
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
				)
	(entmakex Lst)
  )	;end mktext
;;--------------------------------------
(defun them0(chuoi)
  (setq len (strlen chuoi))
  (if (= len 1)
    (strcat "00" chuoi)
    (if (= len 2)
      (strcat "0" chuoi)
      chuoi
    )  
  )
 ) 

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ndtnv    481

ndtnv
Đã đăng

Chương trình quá dài, 3 đoạn code gần giống nhau có thể gom làm 1
 

    (setq kcx (- (car pt2) (car pt1)) kcy (- (cadr pt2) (cadr pt1)))
;;; ...
    (cond
            ((and (>= (/ kcx 100) 2) (>= (/ kcy 100) 2))
             (setq donvi 100))
            ((and (>= (/ kcx 50) 2) (>= (/ kcy 50) 2))
             (setq donvi 50))
            ((and (>= (/ kcx 25) 2) (>= (/ kcy 25) 2))
             (setq donvi 25))
            )
 (if donvi
     (progn
         (setq nx (fix (/ kcx donvi)) ny (fix (/ kcy donvi)))
         ;;;
        )
     (alert "Ban chon Khung KiBo qua\nVe Khung Lai Hen!!!^^")) ; end nho hon 25
  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

nhoclangbat    392

nhoclangbat
Đã đăng

- hi hi thank a nhoc nghĩ tới đâu viết tới đó nên nó dài vậy chưa tóm gọn đc ^^, để nhoc thử cách của a, chỉ sợ nhoc ko biet chỉnh lại thế nào ^^

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ketxu    2.984

ketxu
Đã đăng

Nhìn video của nhoc mới nhớ ra đã viết 1 cái na ná từ lâu tặng bác thanhduan247 rồi. Ở đây này . Code vẫn luộm thuộm, nhưng được cái làm với boundary xiên vẹo đủ hình, thêm được cái toạ độ toạ đủng. K thuộc chuyên ngành nên k nhớ yêu cầu lắm, nhoclangbat thử ngó xem có lấy được gì không. Code vẫn vẽ từng thằng, nhoc thích thì cho vào vòng lặp mà quét nhé

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

thanhduan2407    272

thanhduan2407
Đã đăng

Nhìn video của nhoc mới nhớ ra đã viết 1 cái na ná từ lâu tặng bác thanhduan247 rồi. Ở đây này . Code vẫn luộm thuộm, nhưng được cái làm với boundary xiên vẹo đủ hình, thêm được cái toạ độ toạ đủng. K thuộc chuyên ngành nên k nhớ yêu cầu lắm, nhoclangbat thử ngó xem có lấy được gì không. Code vẫn vẽ từng thằng, nhoc thích thì cho vào vòng lặp mà quét nhé

Hê hê. Từ năm 2011 rùi. Lâu phết rùi ấy nhở?

Vậy mà em vẫn mò được Topic này. ^^

Ngày ấy có 2 cao thủ trợ giúp. Mình lúc ấy gà mờ. Chả biết viết cái gì. :)

Thanks Ketxu 1 lần nữa nhé!

P/s: Klq, cơ mà tình yêu tình báo đến đâu rồi, cưới đê, chả có nhẽ đợi anh lấy vợ trước à?  :wub:

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

tientracdia    16

tientracdia
Đã đăng

 

-^^ nói đến chuyên môn thì nhoc còn phải mót nhiều, do hoàn cảnh, tính chất công việc hiện tai của nhoc , mỗi người 1 hoàn cảnh 1 lời khó mà nói hết a ah, chủ yếu là vì nhoc thích tìm tòi ^^, mỗi lần viết thấy vui, tương lai thế nào chưa rõ, cố đc đến đâu hay đến đó.

- Clip anh nhoc xem trước đó rùi ^^, cách biên tập của a nó không giống bên nhoc, bên nhoc nhoc cũng có vài công trình dạng tuyến chỉ rãi lưới đơn giản khổ giấy lớn hơn

- mục đích nhoc thử làm lsp này để hỗ trợ cho chương trình sẵn của cơ quan, nhưng có nhiều khi mình mún xử lý độc lập, còn chương trình nó hay ràng buộc theo nhiều cái khác khó xử lý tính huống nhanh^^

- nhoc ko giỏi hơn anh đâu ^^, nhoc chậm tiu lắm, chỉ cố gắng hết theo sức mình có

- nhoc có xem qua lsp tạo lưới của a, nhưng nó còn hơi cao với nhoc, nhìn lsp của nhoc đơn giản thui, nhưng mất đến 2 ngày nhoc mới làm xong kaka

;hàm tao textstyle
(defun emk_style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;;;;
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil))))) 
;;;;;;--------------------------------------------------------------------------------------------
;================================================================================================
(defun dtr (a)
(* (/ a 180.0) pi)
)
(prompt "LISP TAO LUOI TOA DO BAN DO VI TRI, LENH : KKL")
;;;
(defun c:kkl (/ donvi nx ny pt1 pt2 pt3 pt4 kcx kcy goc1 goc2 x1 x y  heso old ptext1 ptext2 ptext3 ptext4 str str2 goc3 htext num )
(vl-load-com)
(setq old (getvar "osmode"))
(if (null (tblsearch "STYLE" "vusaln"))
    (emk_style "vusaln" "Vaptimn.TTF"))
(if (null (tblsearch "LAYER" "A1-luoik"))
    (_layer2 "A1-luoik" 7))
  (setq donvi (list (cons 1  100) (cons 2  50) (cons 3  25)))
  (setq tyleVT (getvalue tyleVT 1000.0 "Nhap ty le ban do VT: "))
  (setq heso (/ 1000 tyleVT))
  (setq htext (/ 2.0 heso))
;===================================*******************++++++++++++++++++++********************===================================  
(while (and (setvar "osmode" 1)
            (setq pt1 (getpoint "\nChon diem goc duoi trai khung:"))
            (setq pt2 (getpoint pt1 "\nChon diem goc tren phai khung:")))
(progn
(setvar "osmode" 0)
;======================================================================
;=======================================================================
(setq pt3 (inters pt1 (polar pt1 (/ pi 2) 90000) pt2 (polar pt2 pi 90000) nil))
(setq pt4 (inters pt1 (polar pt1 0 90000) pt2 (polar pt2 (dtr 270) 90000) nil))
(setq kcx (distance pt1 pt4) kcy (distance pt1 pt3))
;==============================================================================
(cond 
((and (>= (/ kcx 100) 2) (>= (/ kcy 100) 2))
;==========================================================
(setq nx (fix (/ kcx 100)) ny (fix (/ kcy 100)))
(setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list (cdr (assoc 1 donvi)) 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 (cdr (assoc 1 donvi)) 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y (cdr (assoc 1 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 1 donvi))))
  )
;============================================================
) ;end 100


;========================================================++++++++++**************+++++++++=======================================================
((and (>= (/ kcx 50) 2) (>= (/ kcy 50) 2))
;==========================================================
(setq nx (fix (/ kcx 50)) ny (fix (/ kcy 50)))
(setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list (cdr (assoc 2 donvi)) 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 (cdr (assoc 2 donvi)) 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y (cdr (assoc 2 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 2 donvi))))
  )
;============================================================
) ;end 50
;============================================================******++++++++++++++++++++****************++++++++++++++++++++========================
((and (>= (/ kcx 25) 2) (>= (/ kcy 25) 2))
;==========================================================
(setq nx (fix (/ kcx 25)) ny (fix (/ kcy 25)))
(setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list (cdr (assoc 3 donvi)) 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 (cdr (assoc 3 donvi)) 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y (cdr (assoc 3 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 3 donvi))))
  )
;============================================================
) ;end  25
;==================================================*********************++++++++++++++++++++*************===========================
((and (< (/ kcx 25) 2) (< (/ kcy 25) 2))
(alert "Ban chon Khung KiBo qua\nVe Khung Lai Hen!!!^^")) ; end nho hon 25
) ;end cond
;==================================================================++++++++++**************+++++++++=======================================
) ;end progn of while pt1 pt2
) ; end  while
(setvar "osmode" old)
(princ)
)
;==============================================================================================
;;;;;;;;;;;;;;;;;;;;
(defun lamtron (n / sodu)
  (setq sodu (rem n 100))
  (if (/= sodu 0)
    (setq n (+ (- n sodu) 100))
  )
  n
)
;=================================
(defun vediem (xx yy r / left right top bot)
  (setq top (+ yy r))
  (setq bot (- yy r))
  (setq right (+ xx r))
  (setq left (- xx r))
  (makeline (list left yy) (list right yy) "A1-luoik" nil nil nil)
  (makeline (list xx top) (list xx bot) "A1-luoik" nil nil nil)
)
;============================
;=================================================================================
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;=====================================================================================
;; ham luu gia tri
(defun getvalue ( a giatri dongnhac / astr) 
(or a (setq a giatri))
(cond
	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 0) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;
;;ham tao text 2
(defun mktext (point height string justify layer textstyle mau / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 (if textstyle textstyle (getvar "textstyle")))
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
				)
	(entmakex Lst)
  )	;end mktext
;;--------------------------------------
(defun them0(chuoi)
  (setq len (strlen chuoi))
  (if (= len 1)
    (strcat "00" chuoi)
    (if (= len 2)
      (strcat "0" chuoi)
      chuoi
    )  
  )
 ) 

Trong lsp kkl có thông báo

(alert "Ban chon Khung KiBo qua\nVe Khung Lai Hen!!!^^"))

vậy khung KiBo là gì vậy bạn ? Có thể cho mình một khung với.

 

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

nhoclangbat    392

nhoclangbat
Đã đăng

- @@ sao lại có vụ ngộ nhận danh tính ở đây nhỉ ^^, ôi "t" với "c"

- khung Kibi đó nghĩa là, khung nhỏ hơn khoảng cách mắt lưới tối thiểu tạo phải từ 2 mắt trở lên, ở đây nhoc set nhỏ nhất là 25, nếu kich thước khung chia cho 25 nhỏ hơn 2 thì nó ko tạo mắt lưới đc ^^

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Về Đầu Trang AutoLisp
×