Jump to content
InfoFile
Tác giả: bach1212
Bài viết gốc: 255806
Tên lệnh: ltt
[Nhờ chỉnh sửa] Thêm chức năng làm tròn số cho lisp tính chiều dài

Hiện tại mình có lisp tính tổng chiều dài các đường thẳng , và kết quả thay vào 1 số có sẵn.

Mình muốn, kết quả đó được làm tròn số luôn thì phải làm như thế nào?

Hiện tại mình có 2 lisp riêng lẻ này: 1 là tính chiều dài, 2 là làm tròn số, không biết kết hợp lại như thế nào để được như ý?

;; free lisp from...
>>

Hiện tại mình có lisp tính tổng chiều dài các đường thẳng , và kết quả thay vào 1 số có sẵn.

Mình muốn, kết quả đó được làm tròn số luôn thì phải làm như thế nào?

Hiện tại mình có 2 lisp riêng lẻ này: 1 là tính chiều dài, 2 là làm tròn số, không biết kết hợp lại như thế nào để được như ý?

;; free lisp from cadviet.com
;;;--------------------------------------------------------------------
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TGL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (+ L (length1 e)))
(ssdel e ss)
)


(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
;;;--------------------------------------------------------------------
;; free lisp from cadviet.com
;;;-------------------------------------------------------
(defun etype (e);;;Entity Type
(cdr (assoc 0 (entget e)))
)
;;;-------------------------------------------------------
(defun C:LTT( / ss n i oldDimzin e d v S)
(if (not n0) (setq n0 2))
(setq
ss (ssget '((0 . "TEXT,MTEXT")))
n (getint (strcat "\nSo chu so thap phan <" (itoa n0) ">:"))
i 0
oldDimzin (getvar "dimzin")
)
(if n (setq n0 n) (setq n n0))
(setvar "dimzin" 8)
(repeat (sslength ss)
(setq e (ssname ss i))
(if (= (etype e) "MTEXT") (progn
(command "explode" e "")
(setq e (entlast))
))
(setq
d (entget e)
v (atof (cdr (assoc 1 d)))
S (rtos v 2 n)
d (subst (cons 1 S) (assoc 1 d) d)
)
(entmod d)
(setq i (1+ i))
)
(setvar "dimzin" oldDimzin)
(princ)
)

http://www.cadviet.com/upfiles/3/40304_ltt_n.lsp

http://www.cadviet.com/upfiles/3/40304_tgl.lsp


<<

Filename: 255806_ltt.lsp
Tác giả: namnhim
Bài viết gốc: 255844
Tên lệnh: bn
Thắc mắc về lệnh "Boundary"

Bạn dùng thử cái này xem có đúng ý không. Trước khi quét vùng cần Boundary thì cần tắt bớt 1 số Layer đối tượng bên trong thửa như là nhà hoặc ao và chỉ để đối tượng là thửa đất thôi nhé!

(defun c:BN (/ boun_lst cnt i ov sec ss time vl)
(command "-layer" "n" "BOUNDARY" "l" "CONTINUOUS" "BOUNDARY" "c" 4 "BOUNDARY" "")
   (command "-layer" "s" "BOUNDARY" "")
  (vl-load-com)
  (command...
>>

Bạn dùng thử cái này xem có đúng ý không. Trước khi quét vùng cần Boundary thì cần tắt bớt 1 số Layer đối tượng bên trong thửa như là nhà hoặc ao và chỉ để đối tượng là thửa đất thôi nhé!

(defun c:BN (/ boun_lst cnt i ov sec ss time vl)
(command "-layer" "n" "BOUNDARY" "l" "CONTINUOUS" "BOUNDARY" "c" 4 "BOUNDARY" "")
   (command "-layer" "s" "BOUNDARY" "")
  (vl-load-com)
  (command "_.undo" "_begin")  
  (if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (setq vl '("DELOBJ" "CMDECHO") ; Sys Var list
	    ov (mapcar 'getvar vl))  ; Get Old values
      (setq time (getvar "millisecs"))
      (mapcar 'setvar vl '( 1 0))
      (setq ss (break_SSLine ss))
      (command "region" ss "")
      (if (setq ss (ssget "x" '((0 . "region"))))
	(progn
	  (setq i 0)
	  (while (< i (sslength ss))
	    (if (> (sslength ss) 50)
	      (princ (strcat "Objects Convert " (itoa i) "\r"))  )
	    (command "explode" (ssname ss i))
	    (command "pedit" "l" "" "j" (ssget "p") "" "")
	    (setq boun_lst (cons (entlast) boun_lst))
	    (setq i (1+ i))    )
	  (setq boun_lst(moveAreaMax boun_lst))
	  (setq sec (/ (- (getvar "MILLISECS") time) 1000.0)  )
	  (if (>(setq cnt (length boun_lst))0)
	    (princ (strcat "\nTao duoc " (itoa cnt)
			   " duong bao voi Th/gian = "(rtos sec 2 2) " s."))
	    (princ (strcat "\nSorry! Khong tao duoc duong bao!")))  ))
      (mapcar 'setvar vl ov)))
  (command "_.undo" "_end")
  (princ))

(defun moveAreaMax (lst / area otmp tmp)
  (setq	tmp 0
	otmp nil)
  (foreach e lst
    (if (> (setq area (vla-get-area (vlax-ename->vla-object e))) tmp)
      (setq tmp area
	    otmp e)) )
  (if otmp
    (progn
      (entdel otmp)
      (vl-remove otmp lst)  )  ))

(defun break_SSLine (ss / ds ent intpts lastentindatabase lst masterlist oc sslst)
  (defun ssget->vla-list (ss / i ename allobj)
    (setq i -1)
    (while (setq  ename (ssname ss (setq i (1+ i))))
      (setq allobj (cons (vlax-ename->vla-object ename) allobj))       )
    allobj  )

  (defun list->3pair (old / new)
    (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
                 old (cdddr old)))
    (reverse new)  )
  
  (defun get_interpts (obj1 obj2 / iplist)
    (if (not (vl-catch-all-error-p
	       (setq iplist (vl-catch-all-apply
                            'vlax-safearray->list
                            (list
                              (vlax-variant-value
                                (vla-intersectwith obj1 obj2 acextendnone) ))))))
    iplist  ))
  
;;====================================
;;  CAB - get last entity in datatbase
(defun GetLastEnt ( / ename result )
  (if (setq result (entlast))
    (while (setq ename (entnext result))
      (setq result ename)    )  )
  result)

(defun GetNewSS (ename / new)
  (setq new (ssadd))
  (cond
    ((null ename) (alert "Ename nil"))
    ((eq 'ENAME (type ename))
      (while (setq ename (entnext ename))
        (if (entget ename) (ssadd ename new)) )    )
    ((alert "Ename wrong type."))  )
  new)

(defun break_line (ent brkptlst / pt1 pt2  x)
  (if brkptlst
    (progn
      (setq brkptlst (mapcar '(lambda(x) (list x (vlax-curve-getdistatparam ent
						   ;; ver 2.0 fix
						   (cond ((vlax-curve-getparamatpoint ent x))
							 ((vlax-curve-getparamatpoint ent
							    (vlax-curve-getclosestpointto ent x))))))
				) brkptlst))
      ;; sort primary list on distance
      (setq brkptlst (vl-sort brkptlst '(lambda (a1 a2) (< (cadr a1) (cadr a2)))))
      (setq pt1 (car(car brkptlst)))
      (foreach e (cdr brkptlst)
	(setq pt2 (car e))
	(entmake (list '(0 . "LINE")(cons 10 pt1)(cons 11 pt2) ))
	(setq pt1 pt2)
	(and *BrkVerbose* (princ (setq *brkcnt* (1+ *brkcnt*))) (princ "\r"))	)      ) ))
  
  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ;;         S T A R T  S U B R O U T I N E   H E R E              
  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  (setq LastEntInDatabase (GetLastEnt))
  (if ss
    (progn
      (setq oc 0
            ssLst (ssget->vla-list ss))
      (if (> (length ssLst) 22) (setq *BrkVerbose* t) )
      (and *BrkVerbose*
	   (princ (strcat "Objects to be Checked: "
			  (rtos (* 0.5(length ssLst)(length ssLst))2 0) "\n")))
      ;;  CREATE a list of entity & it's break points
      (foreach obj ssLst
        (setq lst nil)
	;; check for break pts with other objects in ss2brkwith
	(foreach intobj (vl-remove obj ssLst)
	  (if (and (not (equal obj intobj))
		   (setq intpts (get_interpts obj intobj)))
	    (setq lst (append (list->3pair intpts) lst)) )  )
	(if lst
	  (setq masterlist (cons (cons (vlax-vla-object->ename obj) lst) masterlist)) ) )
      
      (and *BrkVerbose* (princ "\nBreaking Objects.\n"))
      (setq *brkcnt* 0) ; break counter
      (if masterlist
        (foreach obj2brk masterlist
          (break_line (car obj2brk) (cdr obj2brk)) ) ) ) )
;;==============================================================
   (and (zerop *brkcnt*) (princ "\nNone to be broken."))
   (setq *BrkVerbose* nil)
  (GetNewSS LastEntInDatabase) ; return list of enames of new objects
)

<<

Filename: 255844_bn.lsp
Tác giả: KangKung
Bài viết gốc: 256019
Tên lệnh: tre
Lisp sử dụng Osnap khi đang dùng hàm Grread

Góp vui với bác Hạ chút.

http://www.cadviet.com/upfiles/3/71162_lisp_ve_hcn_nghiengosnap_ver10_1.lsp

Đây là Lisp vẽ hình chữ nhật có sử dụng grread và osnap để tạo hiệu ứng động cho đẹp mắt. Mục đích của Lisp này là vẽ hình chữnhật không chỉ theo phương đứng hoặc phương nằm ngang mà còn có thể vẽ theo hướng...

>>

Góp vui với bác Hạ chút.

http://www.cadviet.com/upfiles/3/71162_lisp_ve_hcn_nghiengosnap_ver10_1.lsp

Đây là Lisp vẽ hình chữ nhật có sử dụng grread và osnap để tạo hiệu ứng động cho đẹp mắt. Mục đích của Lisp này là vẽ hình chữnhật không chỉ theo phương đứng hoặc phương nằm ngang mà còn có thể vẽ theo hướng xiên bất kì. Lisp cho phép bắt điểm bằng osnap trong khi đang thực hiện lệnh. Có thể bấm F3 để On/Off chế độ Osnap hoặc chọn chế độ bắt điểm bằng Shift+Rightclick (or Rightclick). Ngoài ra còn có thể On/Off chế độ Orthormode để chuyển HCN từ xiên thành ngang.

;;           Lisp ve Hinh chu nhat (dung, nam ngang, nghieng)                ;;
;;---------------------------------------------------------------------------;;
;;  Author: KangKung 01-10-2013 v1.0                                         ;;
;;  Member of CADMagic Group                                                 ;;
;;---------------------------------------------------------------------------;;
(vl-load-com)
(defun OrthoRound (ang)
  (* (/ pi 2) (fix (/ (+ (/ pi 4) ang) (/ pi 2))))
)
(defun *error* (msg)
  (redraw)
  (setvar "osmode" os)
  )
(defun C:Tre( / os ANG ANG1 GR PT PT1 str LOOP N PO PT X-DIM Y-DIM rightclick batdiem os_pre pt temp)
  (setq temp '(25 0))
  (vla-startundomark (vla-get-activedocument(vlax-get-acad-object)))
  (setq os(getvar "osmode"))
  (setq rightclick 0)
  (initget 1)
  (setq pt1(getpoint "\n Specify first corner point: "))
  (setq ang(getangle pt1 "\n Angle: "))
  (setq ang1 ang)
  (prompt "\n Specify second corner point: ")
  (setq loop T)
  (while (and (setq gr (grread T 12 0)) loop)
    (cond
      ;; Dragging
      ((= 5 (car gr))
       
       (redraw)
       (setq pt (cadr gr))
       (if (and (< 0 (getvar "osmode") 16384)
	     (setq po (vl-remove-if (function null) (mapcar (function (lambda (x / o) (if (setq o (osnap pt x)) (list (distance pt o) o x pt))))
   	(get_osmode)))))
	(setq po (cdar (vl-sort po (function (lambda (a b) (< (car a) (car b)))))) pt (car po))
	(setq po nil))
    (and po (OsMark po))
    (#eMake:Rectang_grvecs pt1 pt nil nil ang nil)
       )
      ;; Picked point = ends loop
      ((= 3 (car gr))
       (#eMake:Rectang pt1 pt nil nil ang nil)
       (redraw)
       (setq loop nil))
      ;; Enter = reads the command line input
      ((or (equal gr '(2 13)) (equal gr '(2 32)))
       (cond
	 ;; valid distance = ends loop
	 ((and str (= (substr str 1 1) "@"))
	  (setq str(vl-string-left-trim "@" str))
	  (setq n(vl-string-search "," str))
	  (setq X-dim(substr str 1 n))
	  (setq Y-dim(substr str (+ n 2)))
	  (if (and (distof X-dim) (distof Y-dim) (/= (+ (distof X-dim) (distof Y-dim)) 0))
	    (progn
	      (#eMake:Rectang pt1 nil (distof X-dim) (distof Y-dim) ang nil)
	      (redraw)
	      (setq loop nil)
	      (grtext)
	      )
	    (princ "\nInvalid Input\n")
	    )
	  )
	 ;; valid point = ends loop
	 ((and str (setq pt (str2pt str)))
	  (#eMake:Rectang pt1 pt nil nil ang nil)
	  (redraw)
	  (setq loop nil)
	  (grtext)
	  )
	 ;; invalid input
	 (T
	  (setq str nil)
	  (princ "\nInvalid Input\n")
	  )
	 )
       )

      ;Right click
      ((= 25 (car gr))
       (setq rightclick(1+ rightclick))
       (if (= rightclick 1) (setq os_pre(getvar "osmode")))
       (setq temp gr)
       (setq batdiem(menu-pop500 gr))
       (foreach a '((1 "_end") (2 "_mid") (4 "_cen") (8 "_nod") (16 "_qua")
		    (32 "_int") (64 "_ins") (128 "_per") (256 "_tan") (512 "_nea")
		    (2048 "_app"))
	 (if (= batdiem (cadr a)) (setvar "osmode" (car a))))
       )

      ;Shift + Right click
      ((equal gr '(11 1000))
       (setq rightclick(1+ rightclick))
       (if (= rightclick 1) (setq os_pre(getvar "osmode")))
       (setq batdiem(menu-pop500 temp))
       (foreach a '((1 "_end") (2 "_mid") (4 "_cen") (8 "_nod") (16 "_qua")
		    (32 "_int") (64 "_ins") (128 "_per") (256 "_tan") (512 "_nea")
		    (2048 "_app"))
	 (if (= batdiem (cadr a)) (setvar "osmode" (car a))))
       )
      ;; F3 = toggles osmode
      ((equal gr '(2 6))
       (if (= (getvar "osmode") 0)
	 (setvar "osmode" (if (/= os 0) os 15359))
	 (setvar "osmode" (if (/= os 0) 0 os))
	 ))
      ;; F8 = toggles orthomode
      ((equal gr '(2 15))
       (setvar "ORTHOMODE" (boole 6 1 (getvar "ORTHOMODE")))
       (if (= (getvar "ORTHOMODE") 1)
	 (setq ang(OrthoRound ang))
	 (setq ang ang1)
	 )
       (princ (chr 8))
       (princ (chr 32))
       )
       ;; getting and printing command line input
      (T
       (if (= (cadr gr) 8) ;_ backspace
	 (or
	   (and str
		(/= str "")
		(setq str (substr str 1 (1- (strlen str))))
		(princ (chr 8))
		(princ (chr 32))
		)
	   (setq str nil)
	   )
	 (or
	   (and str (setq str (strcat str (chr (cadr gr)))))
	   (setq str (chr (cadr gr)))
	   )
	 )
       (and str (princ (chr (cadr gr))))
       )
            
      )
    )
  (if os_pre (setvar "osmode" os_pre))
  (vla-endundomark (vla-get-activedocument(vlax-get-acad-object)))
  (princ)
  )

;--------------------------------------------------------------------------- SUB FUNCTIONS
;----- T&#185;o Icon Osnap v&#181; g&#184;n v&#181;o &#174;i&#211;m po, EX: !po = ((94.4953 17.8586 0.0) "_mid" (94.0427 14.9045 0.0)), l&#202;y pt = (car po).
(defun osMark (o / s osGrv)
  (setq	osGrv (osmode-grvecs-lst
		(vla-get-AutoSnapMarkerColor
		  (vla-get-drafting
		    (vla-get-preferences (vlax-get-acad-object))
		  )
		)
		(vla-get-AutoSnapMarkerSize
		  (vla-get-drafting
		    (vla-get-preferences (vlax-get-acad-object))
		  )
		)
	      )
  )
  (setq	s (/ (getvar "viewsize") (cadr (getvar "screensize")))
	o (cons (trans (car o) 1 3) (cdr o))
  )
  (grvecs (cdr (assoc (cadr o) osGrv))
	  (list	(list s 0. 0. (caar o))
		(list 0. s 0. (cadar o))
		(list 0. 0. s 0.)
		(list 0. 0. 0. 1.)
	  )
  )
)
(defun osmode-grvecs-lst (col ass / -ass ass col) ; By Evgeniy Elpanov (Modified by Lee McDonnell)
  (setq -ass (- ass))
  (list (list "_end"
              col (list -ass -ass) (list -ass  ass)
              col (list (1-  -ass) (1- -ass)) (list (1- -ass) (1+  ass))              
              col (list -ass  ass) (list  ass  ass)
              col (list (1-  -ass) (1+  ass)) (list (1+  ass) (1+  ass))              
              col (list  ass  ass) (list  ass -ass)
              col (list (1+   ass) (1+  ass)) (list (1+  ass) (1- -ass))              
              col (list  ass -ass) (list -ass -ass)
              col (list (1+   ass) (1- -ass)) (list (1- -ass) (1- -ass)))
        (list "_mid"
              col (list -ass -ass) (list    0. ass)
              col (list (1-  -ass) (1- -ass)) (list 0. (1+  ass))
              col (list    0. ass) (list  ass -ass)
              col (list 0. (1+  ass)) (list (1+  ass) (1- -ass))
              col (list  ass -ass) (list -ass -ass)
              col (list (1+   ass) (1- -ass)) (list (1- -ass) (1- -ass)))
        (list "_cen"
              7   (list (* -ass 0.2) 0.)  (list (*  ass 0.2) 0.)
              7   (list  0. (* -ass 0.2)) (list  0.  (*  ass 0.2))
              col (list    -ass   0.) 	(list (* -ass 0.86) (* ass  0.5))
              col (list (* -ass 0.86) (* ass  0.5))  (list (* -ass  0.5) (* ass 0.86))
              col (list (* -ass  0.5) (* ass 0.86))  (list 0. ass)
              col (list 0. ass) (list (* ass 0.5)    (* ass 0.86))
              col (list (* ass 0.5)   (* ass 0.86))  (list (* ass 0.86) (* ass 0.5))
              col (list (* ass 0.86)  (* ass 0.5))   (list ass 0.)
              col (list ass 0.) (list (* ass 0.86)   (* -ass 0.5))
              col (list (* ass 0.86)  (* -ass 0.5))  (list (* ass 0.5) (* -ass 0.86))
              col (list (* ass 0.5)   (* -ass 0.86)) (list 0. -ass)
              col (list 0. -ass)(list (* -ass 0.5)   (* -ass 0.86))
              col (list (* -ass 0.5)  (* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5))
              col (list (* -ass 0.86) (* -ass 0.5))  (list -ass 0.))
        (list "_nod"
              col (list -ass -ass)    (list ass ass)
              col (list -ass ass) 	(list ass -ass)
              col (list -ass 0.)      (list (* -ass 0.86) (* ass 0.5))
              col (list (* -ass 0.86) (* ass 0.5))   (list (* -ass 0.5) (* ass 0.86))
              col (list (* -ass 0.5)  (* ass 0.86))  (list 0. ass)
              col (list 0. ass) (list (* ass 0.5)    (* ass 0.86))
              col (list (* ass 0.5)   (* ass 0.86))  (list (* ass 0.86) (* ass 0.5))
              col (list (* ass 0.86)  (* ass 0.5))   (list ass 0.)
              col (list ass 0.) (list (* ass 0.86)   (* -ass 0.5))
              col (list (* ass 0.86)  (* -ass 0.5))  (list (* ass 0.5) (* -ass 0.86))
              col (list (* ass 0.5)   (* -ass 0.86)) (list 0. -ass)
              col (list 0. -ass)(list (* -ass 0.5)   (* -ass 0.86))
              col (list (* -ass 0.5)  (* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5))
              col (list (* -ass 0.86) (* -ass 0.5))  (list -ass 0.))
        (list "_qua"
              col (list 0. -ass)   (list -ass 0.)
              col (list 0. (1- -ass))   (list (1- -ass) 0.)
              col (list -ass 0.)   (list 0. ass)
              col (list (1- -ass) 0.)   (list 0. (1+ ass))
              col (list 0. ass)    (list ass 0.)
              col (list 0. (1+ ass))    (list (1+ ass) 0.)
              col (list ass 0.)    (list 0. -ass)
              col (list (1+ ass) 0.)    (list 0. (1- -ass)))
        (list "_int"
              col (list -ass -ass) (list ass ass)
              col (list -ass (1+ -ass)) (list ass (1+ ass))
              col (list (1+ -ass) -ass) (list (1+ ass) ass)
              col (list -ass ass)  (list ass -ass)
              col (list -ass (1+ ass))  (list ass (1+ -ass))
              col (list (1+ -ass) ass)  (list (1+ ass) -ass))
        (list "_ins"
              col (list (* -ass 0.1) (* -ass 0.1)) (list -ass (* -ass 0.1))
              col (list -ass (* -ass 0.1)) (list -ass ass)
              col (list -ass ass) (list (* ass 0.1) ass)
              col (list (* ass 0.1) ass)   (list (* ass 0.1) (* ass 0.1))
              col (list (* ass 0.1) (* ass 0.1))   (list ass (* ass 0.1))
              col (list ass (* ass 0.1))   (list ass -ass)
              col (list ass -ass) (list (* -ass 0.1) -ass)
              col (list (* -ass 0.1) -ass) (list (* -ass 0.1) (* -ass 0.1))
              col (list (1- (* -ass 0.1)) (1- (* -ass 0.1))) (list (1- -ass) (1- (* -ass 0.1)))
              col (list (1- -ass) (1- (* -ass 0.1))) (list (1- -ass) (1+ ass))
              col (list (1- -ass) (1+ ass)) (list (1+ (* ass 0.1)) (1+ ass))
              col (list (1+ (* ass 0.1)) (1+ ass)) (list (1+ (* ass 0.1)) (1+ (* ass 0.1)))
              col (list (1+ (* ass 0.1)) (1+ (* ass 0.1))) (list (1+ ass) (1+ (* ass 0.1)))
              col (list (1+ ass) (1+ (* ass 0.1)))   (list (1+ ass) (1- -ass))
              col (list (1+ ass) (1- -ass)) (list (1- (* -ass 0.1)) (1- -ass))
              col (list (1- (* -ass 0.1))   (1- -ass)) (list (1- (* -ass 0.1)) (1- (* -ass 0.1))))
        (list "_tan"
              col (list -ass ass) (list ass ass)
              col (list (1- -ass) (1+ ass)) (list (1+ ass) (1+ ass))
              col (list -ass 0.)  (list (* -ass 0.86) (* ass 0.5))
              col (list (* -ass 0.86) (* ass 0.5)) (list (* -ass 0.5) (* ass 0.86))
              col (list (* -ass 0.5) (* ass 0.86)) (list 0. ass)
              col (list 0. ass) (list  (* ass 0.5) (* ass 0.86))
              col (list (* ass 0.5)  (* ass 0.86)) (list (* ass 0.86) (* ass 0.5))
              col (list (* ass 0.86)  (* ass 0.5)) (list ass 0.)
              col (list ass 0.) (list (* ass 0.86) (* -ass 0.5))
              col (list (* ass 0.86) (* -ass 0.5)) (list (* ass 0.5) (* -ass 0.86))
              col (list (* ass 0.5) (* -ass 0.86)) (list 0. -ass)
              col (list 0. -ass)(list (* -ass 0.5) (* -ass 0.86))
              col (list (* -ass 0.5)(* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5))
              col (list (* -ass 0.86)(* -ass 0.5)) (list -ass 0.))
        (list "_per"
              col (list -ass -ass) (list -ass ass)
              col (list (1- -ass)  (1- -ass)) (list (1- -ass) (1+ ass))
              col (list ass -ass)  (list -ass -ass)
              col (list (1+ ass)   (1- -ass)) (list (1- -ass) (1- -ass))
              col (list -ass 0.)   (list 0. 0.)
              col (list -ass -1.)  (list 0. -1.)
              col (list 0. 0.) 	(list 0. -ass)
              col (list -1. 0.)    (list -1. -ass))
        (list "_nea"
              col (list -ass -ass) (list ass ass)
              col (list -ass ass)  (list ass ass)
              col (list (1- -ass)  (1+ ass)) (list (1+ ass) (1+ ass))
              col (list -ass ass)  (list ass -ass)
              col (list ass -ass)  (list -ass -ass)
              col (list (1+ ass) (1- -ass)) (list (1- -ass) (1- -ass)))
        (list "_app"
              col (list -ass -ass) (list ass ass)
              col (list ass -ass)  (list -ass ass)
              col (list -ass -ass) (list -ass ass)
              col (list (1- -ass)  (1- -ass)) (list (1- -ass) (1+ ass))
              col (list -ass ass)  (list ass ass)
              col (list (1- -ass)  (1+ ass))  (list (1+ ass) (1+ ass))
              col (list ass ass)   (list ass -ass)
              col (list (1+ ass)   (1+ ass))  (list (1+ ass) (1- -ass))
              col (list ass -ass)  (list -ass -ass)
              col (list (1+ ass)   (1- -ass)) (list (1- -ass) (1- -ass)))))

(princ "\n Type TRE to run")

;;;(defun #Rectang(pt)
;;;  (redraw)
;;;  (#eMake:Rectang2 pt1 pt nil nil ang nil)
;;;  )
;; STR2PT
;; Convert a string into a 3d point (input with grread)
;;
;; Argument: a string (ex: "25,63")
;; Return: a 3d point (ex (25.0 63.0 0.0) or nil if invalid string
(defun str2pt (str)
  (setq str (mapcar 'read (str2lst str ",")))
  (if (and (vl-every 'numberp str)
	   (< 1 (length str) 4)
      )
    (trans str 0 0)
  )
)
;; STR2LST
;; Transforms a string with separator into a list of strings
;;
;; Arguments
;; str = the string
;; sep = the separator pattern

(defun str2lst (str sep / pos)
  (if (setq pos (vl-string-search sep str))
    (cons (substr str 1 pos)
	  (str2lst (substr str (+ (strlen sep) pos 1)) sep)
    )
    (list str)
  )
)
;;----------------=={ Entmake a Rectang }==--------------------------------;;
;;                                                                         ;;
;;  Make a Rectang entity by Entmake                                       ;;
;;-------------------------------------------------------------------------;;
;;  Author: KangKung 24-6-2012 v1.0                                        ;;
;;-------------------------------------------------------------------------;;
;;  Arguments: there are 2 options                                         ;;
;;  a) pt1, pt2 - First conner, opposite conner (nil if width and Height)  ;;
;;     Tilt: Tilt angle of Rectang (Radian)                                ;;
;;     lst : List of dxf / nil                                             ;;
;;  b) pt1, Width, Height - First conner point, 2 dimension (nil if pt2)   ;;
;;     Tilt: Tilt angle of Rectang (Radian)                                ;;
;;     lst : List of dxf / nil                                             ;;
;;-------------------------------------------------------------------------;;
;;  Returns:  Rectang Entity                                               ;;
;;-------------------------------------------------------------------------;;
;;  Usage:  						                   ;;
;; a) (#eMake:Rectang '(0.0 0.0 0.0) '(5.0 5.0 0.0) nil nil (/ pi 6) nil)  ;;
;; b) (#eMake:Rectang '(0.0 0.0 0.0) nil 20 40 (/ pi 6) nil)               ;;
;;-------------------------------------------------------------------------;;
(defun #eMake:Rectang (pt1 pt2 Width Heigh Tilt lst / #HEIGH #WIDTH LST_TEMP P1 P2 P3 P4)
  (if (/= nil pt2)
    (progn
      (setq #Width (* (distance pt1 pt2) (cos (- (angle pt1 pt2) Tilt))))
      (setq #Heigh (* (distance pt1 pt2) (sin (- (angle pt1 pt2) Tilt))))
      (setq p1 pt1
	    p2 (list (+ (car pt1) (* #Width (cos Tilt))) (+ (cadr pt1) (* #Width (sin Tilt))))
	    p3 pt2
	    p4 (list (- (car pt1) (* #Heigh (sin Tilt))) (+ (cadr pt1) (* #Heigh (cos Tilt))))
	    )
      )
      (setq p1 pt1
	    p2 (list (+ (car pt1) (* Width (cos Tilt))) (+ (cadr pt1) (* Width (sin Tilt))))
	    p3 (list (+ (car pt1) (* Width (cos Tilt)) (- 0 (* Heigh (sin Tilt)))) (+ (cadr pt1) (* Width (sin Tilt)) (* Heigh (cos Tilt))))
	    p4 (list (- (car pt1) (* Heigh (sin Tilt))) (+ (cadr pt1) (* Heigh (cos Tilt))))
	    )
    )
  (setq lst_Temp (list '(0 . "LWPOLYLINE")
		  '(100 . "AcDbEntity")
		  '(100 . "AcDbPolyline")
		  '(90 . 4)
		  '(70 . 1)
		  (cons 10 p1)
		  (cons 10 p2)
		  (cons 10 p3)
		  (cons 10 p4)
		  )
	)
  (if lst (setq lst_Temp(append lst_Temp lst)))
  (entmake lst_Temp)
  )

(defun #eMake:Rectang_grvecs (pt1 pt2 Width Heigh Tilt lst / #HEIGH #WIDTH LST_TEMP P1 P2 P3 P4)
  (if (/= nil pt2)
    (progn
      (setq #Width (* (distance pt1 pt2) (cos (- (angle pt1 pt2) Tilt))))
      (setq #Heigh (* (distance pt1 pt2) (sin (- (angle pt1 pt2) Tilt))))
      (setq p1 pt1
	    p2 (list (+ (car pt1) (* #Width (cos Tilt))) (+ (cadr pt1) (* #Width (sin Tilt))))
	    p3 pt2
	    p4 (list (- (car pt1) (* #Heigh (sin Tilt))) (+ (cadr pt1) (* #Heigh (cos Tilt))))
	    )
      )
      (setq p1 pt1
	    p2 (list (+ (car pt1) (* Width (cos Tilt))) (+ (cadr pt1) (* Width (sin Tilt))))
	    p3 (list (+ (car pt1) (* Width (cos Tilt)) (- 0 (* Heigh (sin Tilt)))) (+ (cadr pt1) (* Width (sin Tilt)) (* Heigh (cos Tilt))))
	    p4 (list (- (car pt1) (* Heigh (sin Tilt))) (+ (cadr pt1) (* Heigh (cos Tilt))))
	    )
    )
  (grvecs (list 1 p1 p2 2 p2 p3 5 p3 p4 4 p4 p1))
  )

(defun menu-pop500 (d / lst s)
					; Choice function of OSNAP through the shortcut menu.
					; Only, as an example.
					; Is checked up in AutoCad 2004-2007 (En)
					; by ElpanovEvgeniy
					; (2006-10-11)
					; (menu-pop500 (grread t 5))
  (setq
    lst	(reverse
	  (menu-index
	    ((lambda (x) (list (1- (vla-get-count x)) x))
	      (vla-item
		(vla-get-menus
		  (vla-item
		    (vla-get-menugroups
		      (vlax-get-acad-object)
		    ) ;_ vla-get-MenuGroups
		    "ACAD"
		  ) ;_ vla-item
		) ;_ vla-get-Menus
		"&Object Snap Cursor Menu"
	      ) ;_ vla-item
	    )
	  ) ;_ menu-index
	) ;_ reverse
  ) ;_ setq
  (while (and
	   (listp d)
	   (or (= (car d) 5)
	       (= (car d) 11)
	       (= (car d) 12)
	       (= (car d) 25)		; For old version AutoCad
	   ) ;_ or
	 ) ;_ and
    (cond
      ((= (car d) 25) (menucmd "POP500=*")) ; For old version AutoCad
      ((equal d '(11 0)) (menucmd "POP500=*"))
      ((= (car d) 11) (setq s (nth (- (cadr d) 500) lst)))
    ) ;_ cond
    (if	s
      (setq d s)
      (setq d (grread t 5))
    ) ;_ if
  ) ;_ while
  (substr s 1 4)
) ;_ defun
(defun menu-index (l)
					; Creation of the list of choices of choice of OSNAP
					; Is checked up in AutoCad 2004-2007 (En)
					; by ElpanovEvgeniy
					; (2006-10-11)
		  ;|
 (menu-index
 ((lambda (x) (list (1-(vla-get-count x)) x))
 (vla-item
 (vla-get-menus
 (vla-item
 (vla-get-menugroups
 (vlax-get-acad-object)
 ) ;_ vla-get-MenuGroups
 "ACAD"
 ) ;_ vla-item
 ) ;_ vla-get-Menus
 "&Object Snap Cursor Menu"
 ) ;_ vla-item
 )
 ) ;_ menu-index
 |;
  (if (not (minusp (car l)))
    (cond
      ((= (vla-get-type (vla-item (cadr l) (car l))) 0)
       (cons
	 (vla-get-macro (vla-item (cadr l) (car l)))
	 (menu-index (cons (1- (car l)) (cdr l)))
       ) ;_ cons
      )
      ((= (vla-get-type (vla-item (cadr l) (car l))) 1)
       (menu-index (cons (1- (car l)) (cdr l)))
      )
      ((= (vla-get-type (vla-item (cadr l) (car l))) 2)
       (append
	 (menu-index
	   ((lambda (x) (list (1- (vla-get-count x)) x))
	     (vla-get-submenu (vla-item (cadr l) (car l)))
	   ) ;_ menu-index
	 ) ;_ menu-index
	 (menu-index (cons (1- (car l)) (cdr l)))
       ) ;_ append
      )
    ) ;_ cond
  ) ;_ if
) ;_ defun

(defun get_osmode nil
					; Function create list osmode macro
					; for result (getvar "OSMODE")
					; by Evgeniy Elpanov
					; (get_osmode)
  (mapcar
    (function cdr)
    (vl-remove-if
      (function
	(lambda	(x)
	  (zerop (logand (getvar "OSMODE") (car x)))
	) ;_ lambda
      ) ;_ function
      (append
	(if (< 0 (setq cur_mode (getvar "osmode")) 16384)
	  '((1 . "_end")
	    (2 . "_mid")
	    (4 . "_cen")
	    (8 . "_nod")
	    (16 . "_qua")
	    (32 . "_int")
					;(4096 . "_ext") ; Is not realized
	   )
	) ;_ if
	(if (not (zerop (logand (getvar "autosnap") 16)))
	  '((64 . "_ins")
	    (128 . "_per")
	    (256 . "_tan")
	    (512 . "_nea")
					;(1024 . "_qui") ; Is not realized
	    (2048 . "_app")
					;(8192 . "_par") ; Is not realized
	   )
	) ;_ if
      ) ;_ append
    ) ;_ substr
  ) ;_ mapcar
) ;_ defun


<<

Filename: 256019_tre.lsp
Tác giả: phamngoctukts
Bài viết gốc: 110392
Tên lệnh: maaa
Lưu thông số giữa các lần dùng lệnh

Của bạn đây

Filename: 110392_maaa.lsp
Tác giả: hiepttr
Bài viết gốc: 256282
Tên lệnh: vli test d vc
Chương 5.5 : Bài tập

Làm đc vài nhát thế này đây :D

Sẽ update tiếp !

;Bai tap chuong 5
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Bai 1:
;CHUONG TRINH VE LINE TU DIEM A DEN DIEM B, A & b DO NGUOI DUNG CHI DINH:
(defun c:VLI( / pa pb old)
(setq old (mapcar 'getvar '("osmode" "cmdecho")))
(mapcar 'setvar '("osmode" "cmdecho") '(0 0))
(princ "\nBAN DANG CHAY CHUONG TRINH VE LINE TU DIEM A DEN DIEM B !")
(initget 1)
(setq pa (getpoint "\nNhap diem A: "))
(initget 1)
(setq...
>>

Làm đc vài nhát thế này đây :D

Sẽ update tiếp !

;Bai tap chuong 5
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Bai 1:
;CHUONG TRINH VE LINE TU DIEM A DEN DIEM B, A & b DO NGUOI DUNG CHI DINH:
(defun c:VLI( / pa pb old)
(setq old (mapcar 'getvar '("osmode" "cmdecho")))
(mapcar 'setvar '("osmode" "cmdecho") '(0 0))
(princ "\nBAN DANG CHAY CHUONG TRINH VE LINE TU DIEM A DEN DIEM B !")
(initget 1)
(setq pa (getpoint "\nNhap diem A: "))
(initget 1)
(setq pb (getpoint pa "\nNhap diem B: "))
(command ".line" pa pb "")
(mapcar 'setvar '("osmode" "cmdecho") old)
(princ "\nDa ve xong !")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Bai 2:
;VIET HAM (iPos n lst) TRA VE PHAN TU n TRONG LIST lst, GIA TRI AO TINH LA nil
(defun iPos(n lst)
(nth (- n 1) lst)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Bai 3:
;DUNG HAM GETDIST LAY KHOANG CACH, HIEN THONG BAO XEM NGUOI DUNG DA NHAP MOT KHOANG CACH NGUYEN HAY SO THUC
(defun c:test_d( / )
(getdist "\nVao khoang cach: ")
(setq d (getvar "lastprompt"))
(if (= (demptu "." d) 1)
	(princ "\nNguoi dung da nhap so thuc !")
	(princ "\nNguoi dung da nhap so nguyen !")
	)
(princ " Thanks Tue_NV!")
(princ)
)
;;;Ham dem phan tu, copy cua bac Tue_NV
(defun demptu(kitu str)
 (vl-load-com)
 (setq kitu (ascii kitu) str (vl-string->list str))        
 (- (length str) (length (vl-remove kitu str)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Bai 4:
(defun c:VC( / r1 old)
(setq old (mapcar 'getvar '("osmode" "cmdecho")))
(mapcar 'setvar '("osmode" "cmdecho") '(0 0))
(initget 1)
(setq p (getpoint "\nChon tam: "))
(if (not r) (setq r 10))
(if (setq r1 (getdist p (strcat "\nBan kinh <" (rtos r 2 4)">: ")))
	(setq r r1))
(command ".circle" p r)
(mapcar 'setvar '("osmode" "cmdecho") old)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

<<

Filename: 256282_vli_test_d_vc.lsp
Tác giả: hakhoailang
Bài viết gốc: 211427
Tên lệnh: xd1 xd2
hướng dẫn add file *.dll

có phải như thế này o bác

(if (setq fil (findfile "C:\\XDIT\\XDIT1.dll")) (command "_.netLoad" fil) )
(if (setq fil (findfile "C:\\XDIT\\XDIT2.dll")) (command "_.netLoad" fil) )
(defun C:XD1()
(command "netrun" "XDIT1")
)
(defun C:XD2()
(command "netrun" "XDIT2")
)

Filename: 211427_xd1_xd2.lsp
Tác giả: ndtnv
Bài viết gốc: 256158
Tên lệnh: plt
[ yêu cầu ] lisp lọc các đối tượng trên bản vẽ.

Trong bản vẽ phải có đủ 5 layer trong list ll

Bạn thêm vào các hàm tạo layer, bẫy lỗi ...

 

(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 c:plt (/ g h i l5 ll ls p x y) ; Phan Loai Text
    (setq fz 0.1) ; sai so
     (setq ll '("so thua" "loai...
>>

Trong bản vẽ phải có đủ 5 layer trong list ll

Bạn thêm vào các hàm tạo layer, bẫy lỗi ...

 

(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 c:plt (/ g h i l5 ll ls p x y) ; Phan Loai Text
    (setq fz 0.1) ; sai so
     (setq ll '("so thua" "loai dat" "chu su dung" "dia chi" "to ban do"))
     (setq ls (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list '(0 . "TEXT")
   (cons 1 (strcat "DXH,PNK,DNL,DBV,SON,TON,DCS,BCS,ONT,ODT,DGD,NTD,SKK,SKX,MVT,CQP,"
   "DDT,DTL,DGT,TSC,RPK,RDT,RPT,RST,RDN,RPN,RSN,MNC,TSN,TSL,SKC,COC,SKS,"
   "LNK,LNQ,LNC,DVH,BHK,DYT,CAN,DCH,TSK,LMU,TIN,DTT,LUK,LUC,LUN")))))))) ; Liet ke cac loai dat
    ;(setq t1 (getvar "Millisecs"))

    (foreach e ls
        (setq g (entget e) p (dxf 11 g) h (dxf 40 g) x (car p) y (cadr p))
        (setq l5 (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex    (ssget "C" (list (- x h) (- y (* 4.5 h))) (list (+ x h) (+ y h h))
                                             (list '(-4 . "<AND") '(0 . "TEXT")  '(-4 . ">") (cons 11 (list (- x fz) 0 0) ) '(-4 . "<") (cons 11 (list (+ x fz) 0 0) ) '(-4 . "AND>")))))    )
                                                (function (lambda (e1 e2) (> (cadr (dxf 11 (entget e1))) (cadr (dxf 11 (entget e2))))))))
        (if (and (= 5 (length l5 )) (= 1(vl-position e l5)))
            (progn (setq i 0)
                (foreach f l5
                    (ModDxf 8 (nth i ll)(entget f))
                    (setq i (1+ i)))
                )
             (entmake (list (cons 0 "CIRCLE") (cons 10 p) (cons 40 (* 5 h)) (cons 62 6) )) ; Danh dau vi tri sai
            )
        )
    ;(/ (- (getvar "Millisecs") t1) 1000.)
)

<<

Filename: 256158_plt.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 256637
Tên lệnh: xx
Lisp cắt 1 chân Dim !

Copy ra ngoài giúp bạn đây.

(DEFUN C:XX (/ 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 "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1...
>>

Copy ra ngoài giúp bạn đây.

(DEFUN C:XX (/ 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 "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(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 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)
)
 

<<

Filename: 256637_xx.lsp
Tác giả: hiepttr
Bài viết gốc: 256575
Tên lệnh: test d2
Chương 5.5 : Bài tập

Nhờ đc bác Tue_NV chỉ điểm, mình gửi cách 2 lên chờ đá:

(defun c:test_d2( / )
(getdist "\nVao khoang cach: ")
(setq d1 (getvar "lastprompt"))
(cond
	((or (= (xstrcase d1) "COMMAND: TEST_D2") (= (xstrcase d1) "COMMAND:  TEST_D2") (= (xstrcase d1) "TEST_D2")) (princ "\nNguoi dung da pick 2 diem !"))
	((= (type (read (substr d1 18))) 'REAL) (princ "\nNguoi dung da nhap so thuc !"))
	((= (type (read (substr d1 18))) 'INT) (princ "\nNguoi dung da...
>>

Nhờ đc bác Tue_NV chỉ điểm, mình gửi cách 2 lên chờ đá:

(defun c:test_d2( / )
(getdist "\nVao khoang cach: ")
(setq d1 (getvar "lastprompt"))
(cond
	((or (= (xstrcase d1) "COMMAND: TEST_D2") (= (xstrcase d1) "COMMAND:  TEST_D2") (= (xstrcase d1) "TEST_D2")) (princ "\nNguoi dung da pick 2 diem !"))
	((= (type (read (substr d1 18))) 'REAL) (princ "\nNguoi dung da nhap so thuc !"))
	((= (type (read (substr d1 18))) 'INT) (princ "\nNguoi dung da nhap so nguyen !"))
	)
(princ " Thanks Ketxu!")
(princ)
)

 


<<

Filename: 256575_test_d2.lsp
Tác giả: ketxu
Bài viết gốc: 254092
Tên lệnh:
Xin lisp bật tắt lệnh tắt của cad

Nhân tiện tặng OP cái đặt lệnh tắt nhanh, bạn thích thì xài

Nhìn mã chắc bạn hiểu, muốn thêm gì thì bạn làm tương tự, ở chỗ *AliasList* ý.

Dùng On để kích hoạt. Off là loại bỏ nhưng hạn chế dùng thôi (lúc có sếp thôi ^^) vì nó có nhược điểm là loại trừ cả Alias gốc

 

;Free from Member of CadMagic Group
(grtext -1 "Free from CadMagic Group")
(setq...
>>

Nhân tiện tặng OP cái đặt lệnh tắt nhanh, bạn thích thì xài

Nhìn mã chắc bạn hiểu, muốn thêm gì thì bạn làm tương tự, ở chỗ *AliasList* ý.

Dùng On để kích hoạt. Off là loại bỏ nhưng hạn chế dùng thôi (lúc có sếp thôi ^^) vì nó có nhược điểm là loại trừ cả Alias gốc

 

;Free from Member of CadMagic Group
(grtext -1 "Free from CadMagic Group")
(setq *Aliaslst*
	'(
		("C" . "COPY")
		("CC" . "CIRCLE")
		("MM" . "MATCHPROP")
		;...		
	)
)
 
(defun c:on(/)
(mapcar 
	(function
		(lambda(x)
			(eval
				(read
					(strcat 
						"(defun c:"
						(car x)
						"()(command  \""
						(cdr x)
						"\"))"
					)
				)
			)
		)
	)
	*Aliaslst*
)
)
(defun c:off () 
(mapcar 
	(function
		(lambda(x)
			(set
				(read
					(strcat 
						"c:"
						(car x)						
					)
				)
				nil
			)
		)
	)
	*Aliaslst*
)
;(setvar 'RE-INIT 16)
)

<<

Filename: 254092_.lsp
Tác giả: bach1212
Bài viết gốc: 257509
Tên lệnh: dk
Lưu giữ thông số nhập vào trong lisp

Cho mình hỏi, trong lisp này, muốn lưu giữ thông số: khoảng cách "d" giữa các text và bên căn chỉnh text trái hay phải "T or P" cho các lần thực hiện lisp tiếp sau thì cần chỉnh sửa như thế nào để không phải gõ lại ạ:

>>

Cho mình hỏi, trong lisp này, muốn lưu giữ thông số: khoảng cách "d" giữa các text và bên căn chỉnh text trái hay phải "T or P" cho các lần thực hiện lisp tiếp sau thì cần chỉnh sửa như thế nào để không phải gõ lại ạ:

http://www.cadviet.com/upfiles/3/40304_dan_text__dk.lsp

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=57792&st=20
 
;;;;;;Sap xep cac text dung theo khoang cach ngang nhap vao. Co hai lua chon: sap xep tu trai qua phai va nguoc lai
 
 
(defun c:dk (/ oldos p d enlst i ht cn cd ort)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ;;;;; p (getpoint "\n Chon diem chuan ")
        d (getreal "\n Nhap khoang cach giua cac text: ") )
(setq ort (getstring "\n Text co dinh nam ben Trai hay Phai <T or P>: "))
(prompt "\n Chon nhom text can sap xep")
(setq  enlst (acet-ss-to-list (ssget (list (cons 0 "text") ))))
(while enlst
   	(command "undo" "be")
   	(setq i 0)
   	(setq enlst (vl-sort enlst '(lambda (x y) (< (caar (acet-ent-geomextents x)) (caar (acet-ent-geomextents y))))))
   	(if (= (strcase ort) "T")
   	(setq p (if (or (/= (cdr (assoc 72 (entget (car enlst)))) 0) (/= (cdr (assoc 73 (entget (car enlst)))) 0))
                        (cdr (assoc 11 (entget (car enlst)))) (cdr (assoc 10 (entget (car enlst))))  )
       		cn (cdr (assoc 72 (entget (car enlst))))
       		cd (cdr (assoc 73 (entget (car enlst))))
   	)
   	(setq p (if (or (/= (cdr (assoc 72 (entget (last enlst)))) 0) (/= (cdr (assoc 73 (entget (last enlst)))) 0))
                        (cdr (assoc 11 (entget (last enlst)))) (cdr (assoc 10 (entget (last enlst))))  )
       		cn (cdr (assoc 72 (entget (last enlst))))
       		cd (cdr (assoc 73 (entget (last enlst))))
               enlst (reverse enlst)
   	)
   	)
   	(foreach en enlst
            (setq encode (entget en)
                    ht (cdr (assoc 40 encode))                  
                    encode (subst (cons 72 cn) (assoc 72 encode) encode)
                    encode (subst (cons 73 cd) (assoc 73 encode) encode)                  
     		)
     		(if (= (strcase ort) "T")
         		(setq  encode (subst (cons 11 (list (+ (car p)  (* i (+ d ht))) (caddr (assoc 11 encode)))) (assoc 11 encode) encode))
         		(setq  encode (subst (cons 11 (list (- (car p)  (* i (+ d ht))) (caddr (assoc 11 encode)))) (assoc 11 encode) encode))
     		)
     		(entmod encode)
     		(setq  i (1+ i))
        )
   	;;; (setq ans (getstring "\n Ban muon tiep tuc chinh text <Y or N> : "))
   	;;; (if (= (strcase ans) "Y")
   	;;; 	(progn
         		(prompt "\n Hay chon nhom text can sap xep tiep theo")
         		(setq enlst (acet-ss-to-list (ssget (list (cons 0 "text")))))
   	;;; 	)
   	;;; 	(setq enlst nil)
   	;;; )
        (command "undo" "e")
)
(setvar "osmode" oldos)
 
(princ)
)            


 


 


<<

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

Chào bạn violetamuors,
Bạn xài thử cái này coi sao.


Trong đoạn code trên dòng code đầu tiên (defun c:1 () là để định nghĩa một lệnh mới cho cad
dòng code thứ 2 (command "_dimlinear" "pause") là để chỉ cho cad thực hiện việc gọi lệnh dimlinear trong Cad ra và trả quyền điều khiển về cho CAD để bạn tiếp tục thực hiện nốt cái việc bạn muốn.

Bạn có thể tìm...
>>

Chào bạn violetamuors,
Bạn xài thử cái này coi sao.


Trong đoạn code trên dòng code đầu tiên (defun c:1 () là để định nghĩa một lệnh mới cho cad
dòng code thứ 2 (command "_dimlinear" "pause") là để chỉ cho cad thực hiện việc gọi lệnh dimlinear trong Cad ra và trả quyền điều khiển về cho CAD để bạn tiếp tục thực hiện nốt cái việc bạn muốn.

Bạn có thể tìm hiểu thêm về các cú pháp của từng dòng lệnh trong Help Developer của Cad để có thể sử dụng tốt lisp bạn nhé.
Chúc bạn vui
<<

Filename: 88843_1.lsp
Tác giả: ndtnv
Bài viết gốc: 258083
Tên lệnh: c1d
Lisp cắt 1 chân Dim !

Chọn chân dim cần cắt bằng crossing window

 

(load "c1d.fas")

(defun C:C1D ( / ss p)
    (setq ss (ssget '((0 . "DIMENSION")(-4 . "<NOT")(-4 . "&")(70 . 7)(-4 . "NOT>"))))
    (setq p (getpoint))
    (C1D ss p)
)

 

Filename: 258083_c1d.lsp
Tác giả: KangKung
Bài viết gốc: 258357
Tên lệnh: bylayer
Làm sao để chuyển line weight trong block thành bylayer?

Lisp chuyển màu, linetype, lineweight tất cả các đối tượng trong bản vẽ về ByLayer.

(defun C:ByLayer()
  (vl-load-com)
  (vla-startundomark (vla-get-activedocument(vlax-get-acad-object)))
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
    (vlax-for item for-item
      (vla-put-Lineweight item -1)
      (vla-put-color item 256)
      (vla-put-linetype item "ByLayer")
      )
    )
 ...
>>

Lisp chuyển màu, linetype, lineweight tất cả các đối tượng trong bản vẽ về ByLayer.

(defun C:ByLayer()
  (vl-load-com)
  (vla-startundomark (vla-get-activedocument(vlax-get-acad-object)))
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
    (vlax-for item for-item
      (vla-put-Lineweight item -1)
      (vla-put-color item 256)
      (vla-put-linetype item "ByLayer")
      )
    )
  (vla-endundomark (vla-get-activedocument(vlax-get-acad-object)))
  (princ)
  )

<<

Filename: 258357_bylayer.lsp
Tác giả: Tue_NV
Bài viết gốc: 64534
Tên lệnh: tg%3Cspan+clas
Hỏi cách thêm kí tự bất kỳ vào text

Ôi. Cái biến tachcuoi phải đi từ vitri+1 -> đến hết chuỗi
Xin lỗi vì sự nhầm lẫn. Đã sửa lại
Bạn PHUONGANH check thử

:lol2:

Filename: 64534_tg%3Cspan+clas.lsp
Tác giả: thiep
Bài viết gốc: 64522
Tên lệnh: tg%3Cspan+clas
Hỏi cách thêm kí tự bất kỳ vào text

Xin phép Tue_NV, thiep chỉnh sửa lisp tgtext.lsp một chút, với đoạn mã (vl-string-subst new-str pattern string )

:lol2:

Filename: 64522_tg%3Cspan+clas.lsp
Tác giả: Tue_NV
Bài viết gốc: 96343
Tên lệnh: hma hmna
Viết lisp theo yêu cầu [phần 2]


Cải tiến từ Lisp move hatch trong topic này :
http://www.cadviet.com/forum/index.php?showtopic=8121
Tue_NV viết thêm đôi chút cho phù hợp với yêu cầu của bạn :

Filename: 96343_hma_hmna.lsp
Tác giả: Tue_NV
Bài viết gốc: 75182
Tên lệnh: mnh
Lisp đưa đối tượng về vị trí cũ sau khi move?


Rất cảm ơn Nataca.
Chào hai_1401. Bạn sử dụng Code đã chỉnh lại dưới đây xem có đúng ý không nhé.

Còn muốn để đối tượng trở về vị trí cũ thì sử dụng lisp tmn.

Filename: 75182_mnh.lsp
Tác giả: study_forever
Bài viết gốc: 76522
Tên lệnh: cc
Lisp đưa đối tượng về vị trí cũ sau khi move?

Bác Tuệ có thể thừa thắng xông lên bằng cách xem giúp qua cho em 2 yêu cầu nho nhỏ sau đây mà em nghĩ là sẽ tương đồng với cái lisp mà bác đã viết ko ạ, em vô cùng cảm ơn:
- Lisp có nội dung như sau: Sau khi di chuyển rất nhiều đối tượng bằng 1 lệnh MOVE ta lại thấy sót vài đối tượng chưa MOVE cùng, nếu lại nhặt vài đối tượng đó để MOVE tiếp thì rất có thể bản vẽ sẽ...
>>

Bác Tuệ có thể thừa thắng xông lên bằng cách xem giúp qua cho em 2 yêu cầu nho nhỏ sau đây mà em nghĩ là sẽ tương đồng với cái lisp mà bác đã viết ko ạ, em vô cùng cảm ơn:
- Lisp có nội dung như sau: Sau khi di chuyển rất nhiều đối tượng bằng 1 lệnh MOVE ta lại thấy sót vài đối tượng chưa MOVE cùng, nếu lại nhặt vài đối tượng đó để MOVE tiếp thì rất có thể bản vẽ sẽ không còn được như ban đầu. Lisp này có chức năng MOVE các đối tượng còn sót đó theo phương, hướng và khoảng cách như đã MOVE các đối tượng trước (để bản vẽ không bị thay đổi bất cứ 1 thứ j)
- Bác Tuệ đã chính tay viết cái lisp để có thể làm việc với các đối tượng được COPY SAU CÙNG.

Tuy nhiên em thấy lisp này có lệnh COPY bác tự đặt ra có nhiều đặc điểm giống với cái lệnh MOVE mà bác Hai_1401 đã nói ở trên: "tuy nhiên khi em dùng lệnh này thì thấy 1 điều, đó là với lệnh Move của cad, sau khi mình chọn bắt điểm (BASE POINT) và trong lúc chờ điểm đặt (SECOND POINT) thì tại con trỏ sẽ hiện lên ảnh của các đối tượng mình vừa chọn, tuy nhiên khi em dùng lệnh MNH trong lisp trên thì hoàn toàn ko thấy". Do đó, bác Tuệ có thế viết lại giùm em đoạn CODE để có thể biến lệnh COPY trong lisp giống y như lệnh COPY trong Cad ko ạ?
Xin cảm ơn các bác :bigsmile:
<<

Filename: 76522_cc.lsp
Tác giả: huaductiep
Bài viết gốc: 259289
Tên lệnh: m um msot
Lisp đưa đối tượng về vị trí cũ sau khi move?

Bài viết của các bác rất hay, nhưng lisp của bác em làm theo mãi mà ko làm dc?
Em load lisp rồi ấn lệnh M thì move dc, nhưng khi UM hay MSOT đều ko Unknown Command. Các bác có thể chỉ kĩ hơn giúp em được ko ah?

 

Chào 'study_forever'
Đây là Lisp MSOT -> Move các đối tượng còn sót lại (chưa MOVE cùng với đối tượng trước đó)
Tue_NV bổ sung vào Lisp nhé :
1. Lệnh...

>>

Bài viết của các bác rất hay, nhưng lisp của bác em làm theo mãi mà ko làm dc?
Em load lisp rồi ấn lệnh M thì move dc, nhưng khi UM hay MSOT đều ko Unknown Command. Các bác có thể chỉ kĩ hơn giúp em được ko ah?

 

Chào 'study_forever'
Đây là Lisp MSOT -> Move các đối tượng còn sót lại (chưa MOVE cùng với đối tượng trước đó)
Tue_NV bổ sung vào Lisp nhé :
1. Lệnh M : move các đối tượng của bản vẽ : giống lệnh M (Move) của CAD như 2 giọt nước
2. Lệnh UM (Unmove) : đưa các đối tượng Move nhầm về vị trí cũ
3 . Lệnh MSOT : Move các đối tượng còn sót lại (chưa MOVE cùng với đối tượng trước đó)
Các bạn hãy sử dụng thử và cho mình biết ý kiến nhé :


(defun c:m()(setq ss (ssget))(command "line" '(0 0 0) '(1 1 1) "")(setq ss (ssadd (entlast) ss))(command "move" ss "")(while (< 0 (getvar "CMDACTIVE")) (command pause))(setq dc (cdr(assoc 10 (entget (entlast)))))(setq ss (ssdel (entlast) ss))(entdel (entlast))(setq kc (distance '(0 0 0) dc))(setq ang (angle dc '(0 0 0) ))(princ));(defun c:um(/ ssg po lis)(prompt "\n Chon doi tuong Move nham :")(setq ssg (ssget) i 0 j 0)(while (< i (sslength ss))(setq lis (append lis (list (ssname ss i))))(setq i (1+ i)))(while (< j (sslength ssg))(if (/= (member (ssname ssg j) lis) nil) (progn   (setq ss (ssdel (ssname ssg j) ss))   (setq po (polar '(0 0 0) ang kc))   (setq ssg (ssadd (ssname ssg j) ssg)))(princ "\n Doi tuong chon khong phai Move nham"))(setq j (1+ j)))(command "move" ssg "" '(0 0 0) po)(princ));(defun c:msot(/ ssg po lis)(prompt "\n Chon doi tuong Move sot :")(setq ssg (ssget) i 0 j 0)(while (< i (sslength ss))(setq lis (append lis (list (ssname ss i))))(setq i (1+ i)))(while (< j (sslength ssg))(if (= (member (ssname ssg j) lis) nil) (progn   (setq po (polar '(0 0 0) (+ pi ang) kc))   (setq ssg (ssadd (ssname ssg j) ssg)))(princ "\n Doi tuong chon da Move roi"))(setq j (1+ j)))(command "move" ssg "" '(0 0 0) po)(princ))

@study : Với yêu cầu 2 thì Tue_NV yêu cầu bạn post bài đúng chổ. Đây là bài viết về Move chứ không phải bài viết về copy. Mong bạn hiểu. Bạn post đoạn code trên ở chổ nào thì trả về đúng chổ cũ của nó. Mình sẽ trả lời bạn nếu bạn post bài đúng chổ. Bạn đồng ý chứ?
Hãy edit lại bài viết trên của bạn và trả về vị trí của nó


<<

Filename: 259289_m_um_msot.lsp

Trang 144/310

144