Jump to content
InfoFile
Tác giả: mrphuocvie
Bài viết gốc: 393229
Tên lệnh: ss%C2%A0
List Tất Cả Layer, Teststyle, Dimstyle Trong Bản Vẽ Hiện Hành

Gửi bạn lsp đã sửa:

;;; GETSTYLE - SETSTYLE
(defun C:SS  (/ dcl_id ddiag dim dsts fname lay lst lyrs sty...
>>

Gửi bạn lsp đã sửa:

;;; GETSTYLE - SETSTYLE
(defun C:SS  (/ dcl_id ddiag dim dsts fname lay lst lyrs sty table_dst table_lyr table_tst tsts)
 (setvar "cmdecho" 0)
 ;;Get list of all Layer-Textstyle-Dimstyle
 (vlax-for lyr  (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
  (setq table_lyr (cons (vla-get-name lyr) table_lyr)))
 (vlax-for tst  (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object)))
  (setq table_tst (cons (vla-get-name tst) table_tst)))
 (vlax-for dst  (vla-get-dimstyles (vla-get-activedocument (vlax-get-acad-object)))
  (setq table_dst (cons (vla-get-name dst) table_dst)))
 ;; Get-current style
 (setq lst (mapcar 'getvar '("CLAYER" "TEXTSTYLE" "DIMSTYLE"))
       lay (itoa (vl-position (car lst) table_lyr))
       sty (itoa (vl-position (cadr lst) table_tst))
       dim (itoa (vl-position (caddr lst) table_dst)))
 ;; Create Dialog
 (create_dialog)
 ;; Load dialog
 (if (not (new_dialog "getstyle" (setq dcl_id (load_dialog fname))))
  (exit))
 ;;Layer
 (set_tile "sel_lyr" lay)
 (start_list "sel_lyr")
 (mapcar 'add_list table_lyr)
 (end_list)
 ;;Textstyles
 (set_tile "sel_tst" sty)
 (start_list "sel_tst")
 (mapcar 'add_list table_tst)
 (end_list)
 ;;Dimstyles
 (set_tile "sel_dst" dim)
 (start_list "sel_dst")
 (mapcar 'add_list table_dst)
 (end_list)
 ;;Action
 (action_tile "accept" "(setq ddiag 2)(Assign_value)(done_dialog)")
 (action_tile "cancel" "(setq ddiag 1)(done_dialog)")
 (start_dialog)
 (unload_dialog dcl_id)
 (if (= ddiag 1)
  (princ "\n Cancelled!"))
 (if (= ddiag 2)
  (progn (alert (strcat "\nYou Selected Layer: " lyrs ", Textstyle: " tsts ", Dimstyle: " dsts))))
 ;; Delete DCL
 (vl-file-delete fname)
 (princ))
;;;----------------
(defun Assign_value  ()
 (setq lyrs (nth (atoi (get_tile "sel_lyr")) table_lyr)
       tsts (nth (atoi (get_tile "sel_tst")) table_tst)
       dsts (nth (atoi (get_tile "sel_dst")) table_dst))
 (mapcar 'setvar '("CLAYER" "TEXTSTYLE") (list lyrs tsts))
 (vla-put-activeDimstyle (vla-get-ActiveDocument (vlax-get-acad-object))
                         (vla-item (vla-get-Dimstyles (vla-get-ActiveDocument (vlax-get-acad-object))) dsts)))
;;;----------------
(defun create_dialog  (/ lst-dia fn)
 (setq lst-dia (list "getstyle: dialog {" "label = \"Select Layer, Textstyle, Dimstyle\";"
                     ": column { "
                      ": popup_list {"
                       "key = \"sel_lyr\";
     label = \"Select layer\";
     }"
                      ": popup_list {" "key = \"sel_tst\";
     label = \"Select textstyle\";
     }"
                      ": popup_list {" "key = \"sel_dst\";
     label = \"Select dimstyle\";
     }" "}" "ok_cancel ;}"))
 (setq fname (vl-filename-mktemp "getstyle.dcl")
       fn    (open fname "w"))
 (foreach x lst-dia (write-line x fn))
 (close fn))

1. Như trên.

2. Lỗi trong file của bạn: ở hàm Assign_value -> (get_tile key), key ở đây nằm phải trong "", xem lsp đã sửa.

3. DCL nằm trong file .lsp:

+ Nguyên tắc chung:

- dùng lsp tạo ra 1 file DCL nằm đâu đó trong máy mà Cad tự tìm đến được và load khi cần.

- dùng xong thì lsp xóa DCL đi.

+ Tham khảo: http://www.afralisp.net/dialog-control-language/tutorials/dcl-without-the-dcl-file-part-2.php

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


<<

Filename: 393229_ss%C2%A0.lsp
Tác giả: only102
Bài viết gốc: 129676
Tên lệnh: cdc
Hỏi cách chuyển đổi vị trí tọa độ đầu cuối của 1 polyline

Bạn hãy sử dụng lại lệnh Align xem sao. Bạn binharch77 nói đúng đó.

Nếu sử dụng Lisp thì Code đây :

(defun...
>>

Bạn hãy sử dụng lại lệnh Align xem sao. Bạn binharch77 nói đúng đó.

Nếu sử dụng Lisp thì Code đây :

(defun c:Cdc()
(vl-load-com)
(prompt "\n Chon polyline :")
(setq curve (car(entsel "\n Chon Polyline :")))
(setq dau (vlax-curve-getStartPoint curve))
(setq cuoi (vlax-curve-getEndPoint curve))
(Command "Align" curve "" dau cuoi cuoi dau "" "")
(princ)
)


<<

Filename: 129676_cdc.lsp
Tác giả: noname281
Bài viết gốc: 18104
Tên lệnh: m2c
Lisp move text vào chính giữa một rectang

lệnh là M2C (move to center) move đối tượng bất kỳ vào chính giữa đối tượng bất kỳ khác.:

 

(defun c:m2c ()
 (defun mid (ent / p1 p2)
  ...
>>
lệnh là M2C (move to center) move đối tượng bất kỳ vào chính giữa đối tượng bất kỳ khác.:

 

(defun c:m2c ()
 (defun mid (ent / p1 p2)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
   (setq p1 (vlax-safearray->list p1)
  p2 (vlax-safearray->list p2)
  pt (mapcar '+ p1 p2)
  pt (mapcar '* pt '(0.5 0.5 0.5))
   )
   pt
 )
 (setq src (car (entsel "\nDoi tuong can di chuyen: ")))
 (redraw src 3)
 (setq des (car (entsel "\nDoi tuong dich: ")))
 (redraw src 4)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (command ".move" src "" (mid src) (mid des))
 (setvar "osmode" oldos)
 (princ)
)
(vl-load-com)

em thử lệnh này rồi, nhưng mà chỉ di chuyển được đối tượng đó thôi, chứ copy đối tượng rồi sửa text chẳng hạn thì lại không còn là center nữa


<<

Filename: 18104_m2c.lsp
Tác giả: lysamtanhaccs4
Bài viết gốc: 17400
Tên lệnh: m2c
Lisp move text vào chính giữa một rectang
lệnh là M2C (move to center) move đối tượng bất kỳ vào chính giữa đối tượng bất kỳ khác.:

 

(defun c:m2c ()
 (defun mid (ent / p1 p2)
  ...
>>
lệnh là M2C (move to center) move đối tượng bất kỳ vào chính giữa đối tượng bất kỳ khác.:

 

(defun c:m2c ()
 (defun mid (ent / p1 p2)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
   (setq p1 (vlax-safearray->list p1)
  p2 (vlax-safearray->list p2)
  pt (mapcar '+ p1 p2)
  pt (mapcar '* pt '(0.5 0.5 0.5))
   )
   pt
 )
 (setq src (car (entsel "\nDoi tuong can di chuyen: ")))
 (redraw src 3)
 (setq des (car (entsel "\nDoi tuong dich: ")))
 (redraw src 4)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (command ".move" src "" (mid src) (mid des))
 (setvar "osmode" oldos)
 (princ)
)
(vl-load-com)

sao em tải cái này về chạy ko được bác Hoành ạ khi load song máy báo lisp này ko được định hình Bác có cách nào giúp em với nếu cái này mà sài đc thì rất hữu ích đối với em đó (em sài cad 2004 máy ở cty ko thể nâng cấp hơn đc nữa)


<<

Filename: 17400_m2c.lsp
Tác giả: gp14
Bài viết gốc: 33433
Tên lệnh: layiso lai lai layoff lo lo layon loo loo oll laylck lk lk layulk lkk lkk ll layset layset
Em cần Lisp bật tắt layer... (layon, layoff, layiso)

;;; =========================== Layer Iso ===================================
(Defun LAYISO (/ SS CNT LAY LAYLST VAL)  (setvar "cmdecho" 0)
 (if (not (setq SS (ssget "i")))    (progn
     (prompt "\nTuan Giap hay chon doi tuong tren layer(s) muon lam viec doc lap: ")
     (setq SS (ssget))    )  )
 (if SS    (progn      (setq CNT 0)
     (while (setq LAY (ssname SS CNT))
       (setq LAY (cdr (assoc 8 (entget LAY))))
       (if (not (member LAY LAYLST))
        ...
>>

;;; =========================== Layer Iso ===================================
(Defun LAYISO (/ SS CNT LAY LAYLST VAL)  (setvar "cmdecho" 0)
 (if (not (setq SS (ssget "i")))    (progn
     (prompt "\nTuan Giap hay chon doi tuong tren layer(s) muon lam viec doc lap: ")
     (setq SS (ssget))    )  )
 (if SS    (progn      (setq CNT 0)
     (while (setq LAY (ssname SS CNT))
       (setq LAY (cdr (assoc 8 (entget LAY))))
       (if (not (member LAY LAYLST))
         (setq LAYLST (cons LAY LAYLST))        )
       (setq CNT (1+ CNT))      )
     (if (member (getvar "CLAYER") LAYLST)
       (setq LAY (getvar "CLAYER"))
       (setvar "CLAYER" (setq LAY (last LAYLST)))      )
     (command "_.LAYER" "_OFF" "*" "_Y")
     (foreach VAL LAYLST (command "_ON" VAL))
     (command "")            (if (= (length LAYLST) 1)
       (prompt (strcat "\nLayer " (car LAYLST) " da tach ra."))
       (prompt (strcat "\n" (itoa (length LAYLST)) " layers da tach ra. "
                       "Layer " LAY " la hien hanh."   )  )  )  )  )  (princ) )
(defun c:LAYISO () (layiso)) (defun c:LAI () (layiso))

;;; ============================ Layer OFF =================================
(DEFUN LAYOFF (/ SSET SSL ENT LAY I MODE) (setvar "cmdecho" 0) 
 (prompt "\nTuan Giap hay chon doi tuong tren layer(s) muon OFF: ")
 (SETQ SSET (SSGET))   (IF (/= NIL SSET) (PROGN
    (SETQ SSL (SSLENGTH SSET))  (SETQ LAY "") (SETQ I 0) (SETQ MODE 0) 
    (WHILE (       (SETQ ENT (ENTGET (SSNAME SSET I)))
      (IF (= (CDR (ASSOC '8 ENT)) (GETVAR "CLAYER")) (SETQ MODE 1) )
      (SETQ LAY (STRCAT LAY "," (CDR (ASSOC '8 ENT)) ))  (SETQ I (+ I 1)))
    (COMMAND "LAYER" "OFF" LAY "")
    (IF (= MODE 1) (COMMAND ""))))
(setq Loff6 Loff5) (setq Loff5 Loff4) (setq Loff4 Loff3) (setq Loff3 Loff2) (setq Loff2 Loff1) (setq Loff1 LAY)
(princ (strcat "\n      Layer : " LAY " da OFF.")) (setvar "cmdecho" 1)   (princ))
(defun c:LAYOFF () (layoff)) (defun c:LO     () (layoff))
;;; ================================ Layer ON ==============================
(Defun LAYON ()  (setvar "cmdecho" 0)
(setq Lay loff1) (setq Loff1 Loff2) (setq Loff2 Loff3) (setq Loff3 Loff4) (setq Loff4 Loff5) (setq Loff5 Loff6) (setq Loff6 "0")
 (Command "LAYER" "ON" Lay "") (princ (strcat "\n      Layer : " LAY " da ON."))  (princ))
(defun c:LAYON () (layon)) (defun c:LOO   () (layon))
(Defun C:OLL () (setvar "cmdecho" 0)  (Command "_.LAYER" "_ON" "*" "") (princ "\nDa ON toan bo cac Layer !") (princ))

;;; ============================== Layer Lock ==============================
(Defun LAYLCK (/ LAY)
 (setvar "cmdecho" 0)
 (setq LAY (entsel "\n>Tuan Giap hay pick doi tuong tren layer muon LOCK: "))
 (if LAY
   (progn
     (setq LAY (cdr (assoc 8 (entget (car LAY)))))
     (Command "_.LAYER" "_LOCK" LAY "")
     (princ (strcat "\nLayer " LAY " da LOCK."))    )  )  (princ) )
(defun c:LAYLCK () (laylck)) (defun c:LK     () (laylck))
;;; ============================== Layer Lock ==============================
(Defun LAYULK (/ LAY)
 (setvar "cmdecho" 0)
 (setq LAY (entsel "\n>Tuan Giap hay pick doi tuong tren layer muon UNLOCK: "))
 (if LAY
   (progn
     (setq LAY (cdr (assoc 8 (entget (car LAY)))))
     (Command "_.LAYER" "_UNLOCK" LAY "")
     (princ (strcat "\nLayer " LAY " da UNLOCK."))    )  )  (princ) )
(defun c:LAYULK () (layulk)) (defun c:LKK    () (layulk))

;;; =========================== Layer hien hanh =============================
(defun layset (/ LAY) (setvar "cmdecho" 0)
(setq LAY (entsel "\nPick vao doi tuong muon Layer hien hanh la Layer cua doi tuong do : "))
(if LAY     (progn     
 (setq LAY (cdr (assoc 8 (entget (car LAY)))))
 (command "_.layer" "set" LAY "") (princ (strcat "\nLayer : " LAY " da la hien hanh."))  )
            (progn
     (if (not ddlop) (load "ddlop"))  (if (setq LAY (ddlop)) 
            (progn
           (command "_.LAYER" "ON" LAY "THAW" LAY "SET" LAY "")  (princ (strcat "\nLayer : " LAY " da la hien hanh.")) ) ) ) )(princ) )
(defun c:LL     () (layset))(defun c:LAYSET () (layset))

Có ai có kô ạ... share cho em với ạ... em đang rất cần... :)

 

Nhân tiện cho em hỏi luôn: trong cái express của autocad2004 cái lisp layon, layoff, layiso nằm ở file nào vậy các bác...


<<

Filename: 33433_layiso_lai_lai_layoff_lo_lo_layon_loo_loo_oll_laylck_lk_lk_layulk_lkk_lkk_ll_layset_layset.lsp
Tác giả: VUVUZELA
Bài viết gốc: 111392
Tên lệnh: cte
chuyển số liệu text từ cad sang excell
Bạn chạy thử Code này nhé :

(defun c:CTE(/ ss ent sht dtich cthua gchu lst i fname)
;copyright by Tue_NV
(IF (ACET-UTIL-VER)
(PROGN
(iF (setq ss (ssget '((0 . "*POLYLINE") (70 ....
>>
Bạn chạy thử Code này nhé :

(defun c:CTE(/ ss ent sht dtich cthua gchu lst i fname)
;copyright by Tue_NV
(IF (ACET-UTIL-VER)
(PROGN
(iF (setq ss (ssget '((0 . "*POLYLINE") (70 . 1))))
(pROGN (setq i -1 lst '())
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq L (acet-geom-vertex-list ent))
   (if (and (setq sht (ssget "CP" L '((0 . "*TEXT") (8 . "Sothua") (1 . "~**"))))  
   	     (setq dtich (ssget "CP" L '((0 . "*TEXT") (8 . "Dientich") (1 . "*#.#*,*#,#*"))))
   	     (setq cthua (ssget "CP" L '((0 . "*TEXT") (8 . "Text") (1 . "*@*"))))
   	     (setq gchu (ssget "CP" L '((0 . "*TEXT") (8 . "Dientich") (1 . "@@@"))))
)
      (setq lst (vl-sort 
           (append lst
   		     (list
	 	 (mapcar '(lambda(x)
		   		(acet-dxf 1 (entget x))
			   )
    			(apply 'append
		       		(mapcar 'acet-ss-to-list
			       			(list sht sht cthua dtich gchu)
		       		)
			)
   		   	)
	     )
          );append
	 '(lambda (x1 x2) (< (atoi (car x1)) (atoi (car x2))))
	);vl-sort
   	)
    )
 );while
 ;;;;;;;;;;;;;;
(if (setq fName (getfiled "Ten file xuat " (getvar "dwgprefix") "xls" 1))
  (progn
(setq fName (open fName "w"))
(write-line "STT\tSO HIEU THUA\tCHU THUA\tDIEN TICH\tGHI CHU" fname)
(foreach pt lst
   (write-line (strcat (nth 0 pt) "\t" (nth 1 pt) "\t" (nth 2 pt) "\t"
		       (nth 3 pt) "\t" (nth 4 pt)) fName)
)
      (close fName)
  )
)
 ))));PROGN_IF
(setvar "modemacro" "Chuc ban lam viec hieu qua - tue_nvcc@yahoo.com")
(princ)
)

 

Công nhận bác TUE_NV viết siêu thật

Câu lệnh ngắn gọn, đơn giản thật

Tui đọc mà không hiểu luôn

Đến khi load lên chạy mới thấy khả năng ứng dụng của nó

Khâm phục, khâm phục

Bữa nào mời bác làm ly cafe Long buổi sáng nhé


<<

Filename: 111392_cte.lsp
Tác giả: VUVUZELA
Bài viết gốc: 111985
Tên lệnh: cte
chuyển số liệu text từ cad sang excell
Bạn chạy thử Code này nhé :

(defun c:CTE(/ ss ent sht dtich cthua gchu lst i fname)
;copyright by Tue_NV
(IF (ACET-UTIL-VER)
(PROGN
(iF (setq ss (ssget '((0 . "*POLYLINE") (70 ....
>>
Bạn chạy thử Code này nhé :

(defun c:CTE(/ ss ent sht dtich cthua gchu lst i fname)
;copyright by Tue_NV
(IF (ACET-UTIL-VER)
(PROGN
(iF (setq ss (ssget '((0 . "*POLYLINE") (70 . 1))))
(pROGN (setq i -1 lst '())
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq L (acet-geom-vertex-list ent))
   (if (and (setq sht (ssget "CP" L '((0 . "*TEXT") (8 . "Sothua") (1 . "~**"))))  
   	     (setq dtich (ssget "CP" L '((0 . "*TEXT") (8 . "Dientich") (1 . "*#.#*,*#,#*"))))
   	     (setq cthua (ssget "CP" L '((0 . "*TEXT") (8 . "Text") (1 . "*@*"))))
   	     (setq gchu (ssget "CP" L '((0 . "*TEXT") (8 . "Dientich") (1 . "@@@"))))
)
      (setq lst (vl-sort 
           (append lst
   		     (list
	 	 (mapcar '(lambda(x)
		   		(acet-dxf 1 (entget x))
			   )
    			(apply 'append
		       		(mapcar 'acet-ss-to-list
			       			(list sht sht cthua dtich gchu)
		       		)
			)
   		   	)
	     )
          );append
	 '(lambda (x1 x2) (< (atoi (car x1)) (atoi (car x2))))
	);vl-sort
   	)
    )
 );while
 ;;;;;;;;;;;;;;
(if (setq fName (getfiled "Ten file xuat " (getvar "dwgprefix") "xls" 1))
  (progn
(setq fName (open fName "w"))
(write-line "STT\tSO HIEU THUA\tCHU THUA\tDIEN TICH\tGHI CHU" fname)
(foreach pt lst
   (write-line (strcat (nth 0 pt) "\t" (nth 1 pt) "\t" (nth 2 pt) "\t"
		       (nth 3 pt) "\t" (nth 4 pt)) fName)
)
      (close fName)
  )
)
 ))));PROGN_IF
(setvar "modemacro" "Chuc ban lam viec hieu qua - tue_nvcc@yahoo.com")
(princ)
)

 

Bác Tue_NV ơi

Mấy cái ký hiệu * # @ gì gì đó có nghĩa là gì vậy

Bác có thể giải thích được không ?


<<

Filename: 111985_cte.lsp
Tác giả: khaosat2009
Bài viết gốc: 98583
Tên lệnh: vtl1 vtl0 vtl2
Lisp rải taluy trên đường cong
Thấy các bạn yêu cầu nhiều về lisp vẽ taluy và trên diễn đàn có share nhiều lisp. Tuy nhiên sau khi dùng thử mọi cái tôi thấy cái lisp của Lamteco đưa lên là hợp lý;...
>>
Thấy các bạn yêu cầu nhiều về lisp vẽ taluy và trên diễn đàn có share nhiều lisp. Tuy nhiên sau khi dùng thử mọi cái tôi thấy cái lisp của Lamteco đưa lên là hợp lý; tuy nhiên nó bị lỗi nên khi xài tôi phát hiện ra và hiệu chỉnh lại .

Các lệnh vẫn giữ nguyên:

1/ Khai báo các kiểu nét taluy dài ngắn, khoảng cách và số vạch ngắn chen giữa vạch dài = lệnh: VTL0;

2/ Vẽ taluy cho 1 đường riêng biệt = lệnh: VTL1, cho phép chọn đổi bên trái sang phải;

3/ Vẽ taluy chọn đường đỉnh mái taluy và đường chân mái taluy, cho phép đổi ngược lại = lệnh: VTL2.

(setq ktdoantaluy1 0.2 ktdoantaluy2 0.4 khoangcachtl 0.2 chieutaluy 1
sodoan 0 sodoanngan 4)
;Ve taluy tren 1 doan
(defun ve1doantaluy ( p1 p2 / pvt diemcu ktdoantaluy ketthuc )
(setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
(setq ketthuc 1)
(if (< sodoan sodoanngan)
(progn
(setq ktdoantaluy ktdoantaluy1)
(setq sodoan (1+ sodoan))
)
(progn
(setq ktdoantaluy ktdoantaluy2)
(setq sodoan 0)
)
)
(setq p2 (polar p1 pvt ktdoantaluy))
(command "_.Line" p1 p2 "")
(setq dem (1+ dem))
)

(Defun xddsd ( com epl kc / e0 e p dsd )
(setq e0 (entlast))
(while e0
(setq e e0)
(setq e0 (entnext e0))
)
(command com epl kc)
(setq e (entnext e))
(while e
(setq p (cdr (assoc 10 (entget e))))
(if p
(setq dsd (cons p dsd))
)
(setq e (entnext e))
)
(command "_.Undo" 1)
(setq dsd dsd)
)
; ve ta luy cho 1 doi tuong
(Defun vetaluy ( ep / le e ketthuc them dsd thutu)
(setq dem 0)
(setq e (entget (car ep)))
(if (or (= (cdr (assoc 0 e)) "POLYLINE")
(= (cdr (assoc 0 e)) "LINE")
(= (cdr (assoc 0 e)) "ARC")
(= (cdr (assoc 0 e)) "CIRCLE")
(= (cdr (assoc 0 e)) "SPLINE")
) (setq ketthuc 1))
(if (or (= (cdr (assoc 0 e)) "LWPOLYLINE") (= (cdr (assoc 0 e)) "POLYLINE"))
(setq ketthuc 1)

)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd (xddsd "_.Measure" ep khoangcachtl))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
)
)
)
(setq dem dem)
)
(Defun C:vtl1 ( / il ill ep chon lai solan )
(setq il (getvar "cecolor"))
(setq ill (getvar "osmode"))
(setvar "osmode" 0)
;(setvar "cecolor" "9")
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "begin")
(setq ep 1)
(while ep
(setq solan 0 chieutaluy 1)
(setq ep (entsel))
(if ep
(progn
(setq solan (vetaluy ep))
(setq chon (getstring "\nU-UNDO/D-Doi nguoc lai:"))
)
)
(if chon (setq chon (strcase chon nil)))
(if (= chon "U")
(command "_.Undo" solan)
)
(if (= chon "D")
(progn
(setq chieutaluy -1)
(command "_.Undo" solan)
(setq solan (vetaluy ep))
)
)
(setq chon nil)
)
(setvar "cecolor" il)
(setvar "osmode" ill)
(command "undo" "end")
)
(Defun C:vtl0 ( / tg )
(setq tg (getreal (strcat "Chieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))
(if tg (setq ktdoantaluy1 tg))
(setq tg (getreal (strcat "Chieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:")))
(if tg (setq ktdoantaluy2 tg))
(setq tg (getreal (strcat "Khoang cach giua cac doan<" (rtos khoangcachtl 2 2) ">:")))
(if tg (setq khoangcachtl tg))
(setq tg (getint (strcat "So doan ngan trong 1 doan dai<" (rtos sodoanngan 2 0) ">:")))
(if tg (setq sodoanngan tg))
)

(Defun ve1doantaluy1 ( p1 p2 / d pv diemcu ktdoantaluy ketthuc )
(if (and p1 p2)
(progn
(setq ketthuc 1)
(setq pv (angle p1 p2))
(setq d (distance p1 p2))
(setq d (* d (/ ktdoantaluy1 ktdoantaluy2)))
(setq pv (polar p1 pv d))
(if (< sodoan sodoanngan)
(progn
(setq p2 pv)
(setq sodoan (1+ sodoan))
)
(progn
(setq p2 p2)
(setq sodoan 0)
)
)
(command "_.Line" p1 p2 "")
(setq dem (1+ dem))
)
)
(setq dem dem)
)

(Defun vetaluy1 ( ep1 ep2 dao / le e1 e2 ketthuc them thutu )
(setq dem 0)
(setq e1 (entget (car ep1)))
(setq e2 (entget (car ep2)))
(if (and (or (= (cdr (assoc 0 e1)) "POLYLINE")
(= (cdr (assoc 0 e1)) "LINE")
(= (cdr (assoc 0 e1)) "ARC")
(= (cdr (assoc 0 e1)) "CIRCLE")
(= (cdr (assoc 0 e1)) "LWPOLYLINE")
(= (cdr (assoc 0 e1)) "SPLINE"))
(or (= (cdr (assoc 0 e2)) "POLYLINE")
(= (cdr (assoc 0 e2)) "LINE")
(= (cdr (assoc 0 e2)) "ARC")
(= (cdr (assoc 0 e2)) "CIRCLE")
(= (cdr (assoc 0 e2)) "LWPOLYLINE")
(= (cdr (assoc 0 e2)) "SPLINE"))
) (setq ketthuc 1))
(if (and (= (cdr (assoc 0 e1)) "POLYLINE") (= (cdr (assoc 0 e2)) "LWPOLYLINE"))
(setq ketthuc 1)

)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd1 (xddsd "_.Measure" ep1 khoangcachtl))
(setq dsd2 (xddsd "_.Divide" ep2 (length dsd1)))
(if dao
(setq dsd2 (reverse dsd2))
)
(repeat (length dsd1)
(setq p1 (nth thutu dsd1))
(setq p2 (nth thutu dsd2))
(setq thutu (1+ thutu))
(ve1doantaluy1 p1 p2)
)
)
)
(setq dem dem)
)

(Defun C:vtl2 ( / ep1 ep2 chon lai solan dsd1 dsd2 )
(setq il (getvar "cecolor"))
(setq ill (getvar "osmode"))
(setvar "osmode" 0)
;(setvar "cecolor" "9")
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "begin")
(setq solan 0 ep1 1 ep2 1)
(while (and ep1 ep2)
(setq chieutaluy 1)
(setq ep1 (entsel "\nDoi tuong thu nhat:"))
(setq ep2 (entsel "\nDoi tuong thu hai:"))
(if (and ep1 ep2)
(progn
(setq solan (vetaluy1 ep1 ep2 nil))
(setq chon (getstring "\nU-UNDO/D-Doi nguoc lai:"))
)
)
(if chon (setq chon (strcase chon nil)))
(if (= chon "U")
(command "_.Undo" solan)
)
(if (= chon "D")
(progn
(command "_.Undo" solan)
(setq chieutaluy -1)
(setq solan (vetaluy1 ep2 ep1 nil))
)
)
(setq chon nil)
)
(command "undo" "end")
(setvar "cecolor" il)
(setvar "osmode" ill)
)

Lisp vẽ taluy của Bạn rất hay, mong được bạn cải tiến thêm để giúp anh em, vi yêu cầu sau :

Nét dài và ngắn thể hiện màu khác nhau,

Khi cần hiệu chỉnh chọn taluy để hiệu chỉnh nét dài , nét ngắn khoảng cách.

Khi vẽ Taluy qua 2 đường vlt2 , khi khi đường chân có thay đổi thì nét chảy taluy sẽ được thay đổi theo.

Rất mong được Bạn giúp.


<<

Filename: 98583_vtl1_vtl0_vtl2.lsp
Tác giả: khongnam
Bài viết gốc: 417538
Tên lệnh: thunghiem
Tạo Lisp Bóc Khối Lượng Ống Gió

 

Được nhưng vẫn cần FILE bản vẽ, bạn đưa lên đây đi; chứ biết bạn có file thế nào, dữ liệu đầu vào thế nào,...

>>

 

Được nhưng vẫn cần FILE bản vẽ, bạn đưa lên đây đi; chứ biết bạn có file thế nào, dữ liệu đầu vào thế nào, đầu ra cho kết quả vào đâu, giá trị chiều dài, pick điểm được kích thước mm, hay m; file thôi mà khó khăn thế?

(defun loc_thong_tin_str(str / pos str1 str2)
  ;(loc_thong_tin_str "300x200")
  (vl-load-com)
  (if (setq pos (vl-string-search "x" str)) (setq str1 (substr str 1 pos) str2 (substr str (+ 2 pos) 8)))
  (list str1 str2)
  )
 
(defun loc_tap_ss(ss lst / lst2 name r r2)
  ;(setq lst '("TEXT" "MTEXT" "DIMENSION"))
  ;(loc_tap_ss ss '("TEXT" "MTEXT" "DIMENSION"))
  ;(setq dt (car ss))
  (setq lst2 (mapcar 'list lst))
  (foreach dt ss
    (if (member (setq name (dxf 0 (entget dt))) lst)
      (progn
(setq r (assoc name lst2))
(setq r2 (append r (list dt)))
(setq lst2 (subst r2 r lst2))
)))
  lst2
  )
 
(defun dxf (n ent) (cdr(assoc n ent)))
 
(defun c:thunghiem(/ e1 e2 ent kqdientich l l1 lst r1 ss str)
  (if (and (setq ss (acet-ss-to-list (ssget '(( 0 . "*TEXT,*DIM*")))))
  (setq lst (loc_tap_ss ss '("TEXT" "DIMENSION"))))    
    (progn
      (if (> (length (car lst)) 1)
(setq e1 (last(car lst)) str (dxf 1 (entget e1)))
(setq str ""))
      (if (> (length (last lst)) 1)
  (setq e2 (cadr(last lst))
L1 (if (= "" (dxf 1 (setq ent (entget e2)))) (dxf 42 ent) (atoi (dxf 1 ent))))
(setq L1 -100.0))
      (if (= str "") (setq str (getstring "/nNhap lai tiet dien ong dang 200x300")))
      (if (< L1 0) (setq L1 (getdist "/nNhap lai chieu dai ong L= <0.00>")))
      (if (setq L (getreal (acet-str-format "Chon chieu dai ong %1  L=<%2>" str L1)))
(setq L1 L))
      (if (>= L1 1000) (setq L1 (* L1 0.001)))
      (setq kqDientich (* 1e-6 (apply '* (mapcar 'read (setq r1 (loc_thong_tin_str str)))) L1))
      (alert (acet-str-format "Gia tri tinh toan S= (%1*%2)*%3m=%4 m2" (read (car r1)) (read (cadr r1)) L1 kqDientich))
      )
    )
  (princ)
  )

Xin lỗi không phải mình khó khăn cái bản vẽ làm gì đâu ah, tại vì mình cho rõ bạn cần cái gì ah? gửi bạn bản Cad nhé của hệ ống gió, mong nhận được sự giúp đỡ của bạn.

http://www.cadviet.com/upfiles/7/161108_bOc_khOi_lUOng_Ong_giO.dwg


<<

Filename: 417538_thunghiem.lsp
Tác giả: hieuhx68
Bài viết gốc: 277772
Tên lệnh: ha
Nhờ anh em giúp lisp ghi cao độ mặt cắt ngang

 

@cocobubu: lần sau post bài nhớ đọc kỹ nội quy kẻo bị đưa qua tạm trú ở thùng rác thì khổ.

Code nhanh cho bạn...

>>

 

@cocobubu: lần sau post bài nhớ đọc kỹ nội quy kẻo bị đưa qua tạm trú ở thùng rác thì khổ.

Code nhanh cho bạn đây:

(defun C:HA( / y0 y1 ent)
 (command "ucs" "w")
 (setq y0 (cadr (cdr (assoc 10 (entget (car (entsel "\nChon Line de lam duong chuan: ")))))))
 (while
  (and
   (setq y1 (cadr (getpoint "\nPick diem de lay cao do: ")))
   (setq ent (car (entsel "\nChon Text de sua cao do: ")))
   (entmod (subst (cons 1 (rtos (- y1 y0) 2 2)) (assoc 1 (entget ent)) (entget ent)))))
 (princ))

Lips này của bác DOAN VAN HA rất tuyệt vời. nhân tiện đọc bài này. em muốn nhờ bác và mọi người giúp em sửa lips này cho thêm 1 số tính năng nữa được ko ạ.

1. Thay vì lấy đường thẳng làm chuẩn Bác có thể cho em là nhập cao độ so sánh (ví dụ em lấy là 90 thì các điểm sau sẽ + hay trừ vào giá trị này) vì khi vẽ mặt cắt em toàn vẽ có mốc so sánh 

2. Đồng thời pick điểm tiếp theo sẽ cho luôn khoảng cách giữa 2 điểm và ghi luôn xuống dưới thì tuyệt quá.

 

em cảm ơn mọi người.


<<

Filename: 277772_ha.lsp
Tác giả: duy782006
Bài viết gốc: 196639
Tên lệnh: pb
Lisp tạo block không cần đặt tên

Hì, đúng vậy :) Ketxu viết để tạo cái Block thôi ^^

THeo cách của bác thì như vầy cho nhanh :

(defun c:pb(/...
>>

Hì, đúng vậy :) Ketxu viết để tạo cái Block thôi ^^

THeo cách của bác thì như vầy cho nhanh :

(defun c:pb(/ p)(command  "_.copybase" (setq p (getvar "LASTPOINT")) (ssget) "" "_.pasteblock" p "_.erase" "_p" ""))

Ơ nay mới biết cu "LASTPOINT" này thank bác. Mà bác chơi hai quả P làm mình đọc cứ lẩn hết cả lộn. Cadviet có nhiều cái để học phết nhỉ.


<<

Filename: 196639_pb.lsp
Tác giả: prute
Bài viết gốc: 203709
Tên lệnh: test
offset tự động

Thử cái này, dựa vào lisp của anh Ketxu. Có vài khiếm khuyết nhé (như đã phân tích ở trên).

(defun...
>>

Thử cái này, dựa vào lisp của anh Ketxu. Có vài khiếm khuyết nhé (như đã phân tích ở trên).

(defun c:test ()
(cond
 ((ssget '((0 . "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE")))
  (or *dist (setq *dist 100))
  (setq *dist
(cond
((getdist (strcat "\nDistance <" (rtos *dist 2 2) ">: ")))
(*dist)))
  (vlax-for obj (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
(if (HA:Closed (vlax-vla-object->ename obj))
(mapcar 'vla-delete
(cdr
(vl-sort
 	(list (car (vlax-invoke obj 'Offset *dist)) obj  (car (vlax-invoke obj 'Offset (- *dist))))
 	'(lambda (x y) (< (vlax-get x 'Area) (vlax-get y 'Area)))))))))
 (T (princ "\nNo thing to do")))
(princ))
(defun HA:Closed (ent / data lstP lstS)
(setq data (entget ent)
  		lstP (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))
  		lstS (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 11)) (entget ent))))
(or
 (= "CIRCLE" (cdr (assoc 0 data)))
 (and (= "ELLIPSE" (cdr (assoc 0 data))) (= 0 (cdr (assoc 41 data))))
 (and
  (= (cdr (assoc 0 data)) "LWPOLYLINE")
  (or
(= 1 (logand 1 (cdr (assoc 70 data))))
(equal (car lstP) (last lstP) 1E-8)))
 (and
  (= (cdr (assoc 0 data)) "SPLINE")
  (or
(= 1 (logand 1 (cdr (assoc 70 data))))
(equal (car lstS) (last lstS) 1E-8)))))

được rồi anh ak. để em test thêm xem sao


<<

Filename: 203709_test.lsp
Tác giả: hoangkimoanh
Bài viết gốc: 305464
Tên lệnh: gb
lisp-Làm thế nào để tìm số đối tượng sinh ra bởi lệnh Boundary

 

Hiểu ý của bạn rồi.

Để tạo thành một region ta có 2 cách :

1. Sử dụng lệnh region

2. Sử dụng lệnh Boundary. Khi...

>>

 

Hiểu ý của bạn rồi.

Để tạo thành một region ta có 2 cách :

1. Sử dụng lệnh region

2. Sử dụng lệnh Boundary. Khi sử dụng lệnh này thì có thể tạo thành region hoặc Polyline.

- Ta dùng cách 2 để tạo Region

Đây là đoạn Code viết theo ý của bạn : Tạo thành một region từ một đa giác mẹ bị khoét n lỗ bên trong.

Đoạn Lisp cũng đúng với trường hợp đa giác kín không khoét lỗ.

(defun c:gb(/ po frome toe cur ss st LA CA)(setq po (getpoint "\n Pick diem :"))(setq frome (entlast)) ;; chon doi tuong cuoi cung truoc khi boundary(command "boundary" "A" "O" "R" "" po "") ;; Region(setq toe (entlast)) ;; chon doi tuong cuoi cung sau khi Region(setq cur frome ; khoi taoss (ssadd))(while (not (eq cur toe)) ;; chon cac doi tuong tu frome den toe(setqcur (entnext cur)ss (ssadd cur ss)))(setq st (ss2ent ss))(setq LA (car st))(setq CA (ssdel LA ss))(Command "subtract" LA "" CA "")(princ));;(defun ss2ent (ss / sodt index lstent)(setqsodt (if ss (sslength ss) 0)index 0)(repeat sodt(setq ent (ssname ss index)index (1+ index)lstent (cons ent lstent)))(reverse lstent))
Nhân đây, các bác trên diễn đàn cho Tue_NV hỏi là sau khi tạo Region thì Region được tạo ra nằm trùng với những đường Polyline cũ thì làm sao có ta có thể xoá được các Polyline này.

Mong các bác trợ giúp cho Tue_NV.

Cảm ơn các bác rất nhiều.

anh tue ơi, anh sửa giúp em đoạn code trên cho nó ngắt đúng đoạn, không bị tất cả 1 dòng vì những đoạn có dấu ;;;em không biết ngắt đoạn chỗ nào cho đúng nữa! và có thể tính diện tích xong và sửa vào text sẵn có với ạ!


<<

Filename: 305464_gb.lsp
Tác giả: Bee
Bài viết gốc: 409575
Tên lệnh: mb
Viết Chữ Tiếng Việt Trong Lisp (Unicode)

 

Mình có đoạn lsp dùng để viết chữ (chữ mặc định), nhưng sau khi gõ lệnh và dùng thì nó bị lỗi font 

Mình muốn...

>>

 

Mình có đoạn lsp dùng để viết chữ (chữ mặc định), nhưng sau khi gõ lệnh và dùng thì nó bị lỗi font 

Mình muốn dùng font arial (bảng mã unicode, kiểu gõ vni)

Mình muốn ghi ra là chữ" MẶT BẰNG TÔN MÁI 

Mong mọi người sửa dùm tí, mình xin cảm ơn ! 


(DEFUN C:MB (/ TILE P)
  (IF (= (TBLOBJNAME "STYLE" "ARIAL") NIL)
  	(command ".STYLE" "ARIAL" "VNI-ARIAL" "" "" "" "" "" "")
    )
  (SETQ
	tile (getint "\nTi le: ")
	p (getpoint "\nChon diem chen text: ")
	)
  (COMMAND "TEXT" "S" "ARIAL" "J" "MC" P (* TILE 2) "0" "%%UMẶT BẰNNG TÔN MÁI"
	            )
)




Thử cái này xem nhé ^_^ máy mình ko có vni-arial nên thay bằng helve

(DEFUN C:MB (/ tile p)
  (IF (= (TBLOBJNAME "STYLE" "ARIAL") NIL)
;(command ".STYLE" "ARIAL" "VNI-ARIAL" "" "" "" "" "" "")
    (entmake '((0 . "STYLE")
	       (100 . "AcDbSymbolTableRecord")
	       (100 . "AcDbTextStyleTableRecord")
	       (2 . "ARIAL")	;style name 
	       (3 . "VNI-HELVE.TTF")	;font file 
	       (70 . 0)
	       (40 . 0.0)
	       (41 . 1.0)
	       (50 . 0.0)
	       (71 . 0)
	      )
    )
  )
  (SETQ
    tile (getint "\nTi le: ")
    p	 (getpoint "\nChon diem chen text: ")
  )
;;;  (COMMAND "TEXT" "S" "ARIAL" "J" "MC" P (* TILE 2) "0" "%%UM?T B?NNG TÔN MÁI"
  (entmake (list
	     (cons 0 "TEXT")
	     (cons 1 "MAËT BAÈNG TOÂN MAÙI")
	     (cons 10 p)
	     (cons 40 (* tile 2))
	     (cons 7 "ARIAL")
	   )
  )

)

<<

Filename: 409575_mb.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 424598
Tên lệnh: gfi
Hỏi về mã dxf 11 của Text
17 phút trước, dinhvantrang đã nói:

 

#Danh Cong:...

>>
17 phút trước, dinhvantrang đã nói:

 

#Danh Cong: cho mình xin code của cái hàm "TRA" được không, bình thường mình toàn dùng thế này (entget (entlast)), toàn phải copy đối tượng cần xem ra rồi dùng cấu trúc trên.

(defun c:gfi()
(setq ma (car (entsel)))
(setq ma1 (entget ma))
(princ ma1)
(princ)
)

 


<<

Filename: 424598_gfi.lsp
Tác giả: Tue_NV
Bài viết gốc: 63069
Tên lệnh: scn
Cách scale nhiều đối tượng một lúc?
Lai làm phiền bạn. Lisp sau mình đã dùng đuợc còn lisp này minh không sử dụng được . sao vậu nhỉ bạn. khi chương trình báo chọn các hình chữ nhật khác. Chọn xong...
>>
Lai làm phiền bạn. Lisp sau mình đã dùng đuợc còn lisp này minh không sử dụng được . sao vậu nhỉ bạn. khi chương trình báo chọn các hình chữ nhật khác. Chọn xong thấy nó hết lệnh luôn.

Đoạn Code trên của Tue_NV không có lỗi . Bạn test lại xem.

Chon hinh chu nhat chuan : Pick chon hinh chu nhat (pick trúng nhé)

Chon diem tam scale tren hinh chu nhat chuan :

Moi ban chon cac hinh chu nhat :

Select objects:

 

 

Tuy nhiên, Tue_NV đồng ý với ý kiến của bạn tigertiger và đã viét ra code dưới để xác định tâm tương ứng của các hình

Nhưng theo mình hay hơn cả là chọn tập các điểm tương ứng các hình,

nếu không phải hình chữ nhật thì cách của tue_NV cũng khó thành?

 

Bạn thử Code này xem :

(defun c:scn()
(prompt "\n Moi ban chon cac doi tuong :")
(setq ssg (ssget))

(setq tl (getreal "\n Ti le scale :"))

(setq n (sslength ssg) i 0)

(while ((setq sn (ssname ssg i))
(HLI sn)
(setq ent (entget sn))
(setq mp (getpoint "\n Ban chon tam cho doi tuong nay :"))

(command "scale" sn "" mp tl)
(setq i (1+ i))

)
(princ)
)
;
(defun HLI(ent)
(sssetfirst (ssadd ent (ssadd)) (ssadd ent (ssadd)))
)


<<

Filename: 63069_scn.lsp
Tác giả: bach1212
Bài viết gốc: 183487
Tên lệnh: lbhg
Lisp thống kê cao độ ga và cống

Mình không có nhiều thời gian lắm nên lisp chưa được hoàn chỉnh tuyệt đối.

Nhưng bạn chứ dùng thử, có ý kiến gì báo lại mình...

>>

Mình không có nhiều thời gian lắm nên lisp chưa được hoàn chỉnh tuyệt đối.

Nhưng bạn chứ dùng thử, có ý kiến gì báo lại mình sẽ khắc phục.

Khi nào có nhiều thời gian hơn, mình sẽ sửa nó 1 cách hoàn thiện

(lisp này còn nông dân lắm)

Sau khi lisp lập ra 1 bảng trong cad, bạn có thể dùng c2e.lsp trên cadviet có để chuyển sang excel bạn nhé

Mọi code lisp được lấy từ Cadviet - tôi chỉ là người xào nấu một chút thôi


;-----------------Lap bang thong ke ga ----------------------------
; Free lisp code from CADViet  - edit by Mathan
(defun C:LBHG (/ TX TY kcach)
(setq diem (getpoint "\Chon vi tri lap bang... "))
(setq kcach (getreal "\Khoang cach cac text trong bang... "))
(prompt "\nBan can pick tung text theo thu tu Ten ho ga; cao do day va cao do dinh ga: ")
(setq dem 1 sdt 1)
(setq ss null)
(while (/= ss nil)
(if (= dem 1)
(progn
(setq ss (car (entsel "\nDS> Ten ho ga: ")))
(setq noidung (cdr (assoc 1 (entget ss))))
(setq diem1 (list (car diem) (- (cadr diem) (* sdt kcach))))
(command "TEXT" diem1 "" "" noidung)
))  
(if (= dem 2)
(progn
(setq ss (car (entsel "\nDS> Cao do day: ")))
(setq noidung (cdr (assoc 1 (entget ss))))  
(setq diem2 (list (+ (* 2 kcach) (car diem)) (- (cadr diem) (* (- sdt 1) kcach))))
(command "TEXT" diem2 "" "" noidung)
))  
(if (= dem 3)
(progn
(setq ss (car (entsel "\nDS> Cao do dinh: ")))
(setq noidung (cdr (assoc 1 (entget ss))))
(setq diem3 (list (+ (* 4 kcach) (car diem)) (- (cadr diem) (* (- sdt 2) kcach))))
  (command "TEXT" diem3 "" "" noidung)
  (setq dem 0)
))  
(setq dem (+ 1 dem))
(setq sdt (+ 1 sdt))
(princ)
)
)

Mong giúp được bạn một chút

Cám ơn bạn nhé. Chàng nông dân của bạn về cơ bản đã giúp mình có thể thực hiện công việc nhanh chóng hơn nhiều roài.

Mình đã sửa đi 1 chút dòng nhắc lệnh thứ 2 là lựa chọn cao độ đỉnh ga trước, đáy ga sau để cho đúng yêu cầu.

Nếu bạn có thời gian có thể chau chuốt lisp này như thế này được không:

- Bảng lập ra trên cad sẽ đẹp được như bảng này: http://www.cadviet.com/upfiles/3/40304_binh_do_tnm_1.rar

- Nên bỏ qua bước: chọn khoảng cách các text trong bảng, thay vào đó lisp sẽ tự động căn chỉnh bảng với khoảng cách giữa các hàng và cột như trong bảng trên. Hiện tại khoảng cách giữa các hàng là rất xa nhau.

- Thêm 1 lựa chọn: chọn chiều cao chữ cho text xuất ra trong bảng.

Nếu có thời gian hơn nữa bạn xử lý yêu cầu này giúp mình nữa nhé: http://www.cadviet.com/forum/index.php?showtopic=60191&pid=183421&st=0entry183421

Thanks U nhé


<<

Filename: 183487_lbhg.lsp
Tác giả: vantran
Bài viết gốc: 92532
Tên lệnh: abc
chuyển tọa độ từ file excel sang cad
Sorry mọi nguời! "nhầm rùi" <_<

 

Bạn chạy thử :

(defun c:ABC (/ data f line point size str ten)
 (setq ten (getfiled "Select a File txt" (getvar...
>>
Sorry mọi nguời! "nhầm rùi" <_<

 

Bạn chạy thử :

(defun c:ABC (/ data f line point size str ten)
 (setq ten (getfiled "Select a File txt" (getvar "dwgprefix") "txt" 8))
 (setq size 10); chieu cao Text
 (setq f (open ten "r"))
 (while (setq Line (read-line f))
   (if	(vl-string-search "\t" Line)
     (progn
(setq data (split Line "\t")
      str (car data)
      Point (cdr data))
(Make_Text_MC Point size str )    )    )  )
 (princ))

(defun Make_Text_MC(pt size val) 
 (entmake
   (list '(0 . "TEXT")
  (cons 10 pt)(cons 40 size)
  (cons 1 val)(cons 7 (getvar "TEXTSTYLE"))
  '(71 . 0) (cons 72 1)
  '(73 . 2) (cons 11 pt))))

(defun Split (Str Char / lst tmp)
 (while (setq Local (vl-string-search Char Str))
   (setq tmp (substr Str 1 Local))
   (if (distof tmp)
     (setq Lst (append Lst (list (read tmp))))
     (setq Lst (append Lst (list tmp)))      )
   (setq Str (substr Str (+ Local 2)) ) )
 (setq Lst (append Lst (list (read Str)))))

cảm ơn bạn. đây đúng là lisp mình cần nhưng nếu có thể nhờ bạn sửa hộ một chút cho giống như ví dụ này được không http://www.cadviet.com/upfiles/2/vd_7.dwg. Tâm của vòng tròn chính là tọa độ của điểm T-V


<<

Filename: 92532_abc.lsp
Tác giả: hmt
Bài viết gốc: 327555
Tên lệnh: dtxt
xin giúp về đổi chỗ 2 text cho nhau

Bổ sung lsp của bác gia_bach 1 chút để có thể chọn nhiều text 1 lúc, với đk là 2 txt nằm trong 1 polyline kín.

 

>>

Bổ sung lsp của bác gia_bach 1 chút để có thể chọn nhiều text 1 lúc, với đk là 2 txt nằm trong 1 polyline kín.

 

(defun c:dtxt() 
(defun doiTxt(ss / obj1 obj2 tmp) 
 (if (and  (= 2 (sslength ss))
(setq obj1 (vlax-ename->vla-object (ssname ss 0)))
(setq obj2 (vlax-ename->vla-object (ssname ss 1)))
(eq (vla-get-Layer obj1) (vla-get-Layer obj2)))
   (progn      
     (setq tmp (vla-get-TextString obj1))
     (vla-put-TextString obj1 (vla-get-TextString obj2))
     (vla-put-TextString obj2 tmp)))
)
(princ "Chon cac khung bao Text :")
(foreach pl (vl-remove-if-not '(lambda (x) (= :vlax-true (vla-get-Closed (vlax-ename->vla-object x))))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LWPOLYLINE")))))))
(doiTxt (ssget "CP" (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl)))
'((0 . "TEXT") )))
)
)

thank bac Tot77 nhé lisp dùng rất hiệu quả :D


<<

Filename: 327555_dtxt.lsp
Tác giả: conghoa
Bài viết gốc: 410433
Tên lệnh: test
Lisp điều chỉnh vị trí text ghi kích thước trên đường dim

 

Thử lisp này, thay lệnh test tùy ý nhé. ^_^

 

>>

 

Thử lisp này, thay lệnh test tùy ý nhé. ^_^

 

https://youtu.be/6NyEJFNnIwM

(defun c:test (/ ss lst _angle)
  (vl-load-com)
  (command "undo" "be")
  (if (setq ss (ssget '((0 . "DIMENSION"))))
    (progn
      (setq lst	(vl-remove-if
		  '(lambda (e) (> (cdr (assoc 42 (entget e))) 900.))
		  (vl-remove-if
		    'listp
		    (mapcar 'cadr (ssnamex ss))
		  )
		)
      )					;setq
      (setq _angle (angle (cdr (assoc 11 (entget (car lst))))
			  (cdr (assoc 11 (entget (cadr lst))))
		   )
      )
      (cond
	((or (= _angle 0)
	     (= _angle pi)
	 )
	 (dim_hor lst)
	)				;#cond1
	((or (= _angle (/ pi 2))
	     (= _angle (* pi 1.5))
	 )
	 (dim_ver lst)
	)				;#cond2
	(_angle
	 (dim_ lst _angle)
	)				;#cond3
      )					;#cond
    )					;progn
    (princ "\nBan da khong chon dim.!")
  )					;if
  (command "undo" "end")
  (princ)
)
(defun dim_hor (l / lst pt)
  (setq	lst (vl-sort l
		     '(lambda (e1 e2)
			(< (car (cdr (assoc 11 (entget e1))))
			   (car (cdr (assoc 11 (entget e2))))

			)
		      )
	    )
  )
  (foreach x lst
    (if	(= (rem (vl-position x lst) 2) 0)
      (progn
	(if (>=	(cadr (cdr (assoc 10 (entget x))))
		(cadr (cdr (assoc 14 (entget x))))
	    )

	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  (* pi 1.5)
			  (* 2 (txt_height x))
		   )
	  )
	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  (/ pi 2)
			  (* 2 (txt_height x))
		   )
	  )
	)
	(vlax-put (vlax-ename->vla-object x) 'TextPosition pt)
      )					;progn
    )					;if
  )					;foreach
)					;defun
(defun dim_ver (l / lst pt)
  (setq	lst (vl-sort l
		     '(lambda (e1 e2)
			(< (cadr (cdr (assoc 11 (entget e1))))
			   (cadr (cdr (assoc 11 (entget e2))))

			)
		      )
	    )
  )
  (foreach x lst
    (if	(= (rem (vl-position x lst) 2) 0)
      (progn
	(if (>=	(car (cdr (assoc 10 (entget x))))
		(car (cdr (assoc 14 (entget x))))
	    )

	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  pi
			  (* 2 (txt_height x))
		   )
	  )
	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  0.0
			  (* 2 (txt_height x))
		   )
	  )
	)
	(vlax-put (vlax-ename->vla-object x) 'TextPosition pt)
      )					;progn
    )					;if
  )					;foreach
)
(defun dim_ (l ang / lst pt)
  (setq	lst (vl-sort l
		     '(lambda (e1 e2)
			(< (cadr (cdr (assoc 11 (entget e1))))
			   (cadr (cdr (assoc 11 (entget e2))))

			)
		      )
	    )
  )
  (foreach x lst
    (if	(= (rem (vl-position x lst) 2) 0)
      (progn
	(if (>=	(car (cdr (assoc 10 (entget x))))
		(car (cdr (assoc 14 (entget x))))
	    )

	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  (+ ang (* pi 1.5))
			  (* 2 (txt_height x))
		   )
	  )
	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  (+ ang (* pi 1.5))
			  (* 2 (txt_height x))
		   )
	  )
	)
	(vlax-put (vlax-ename->vla-object x) 'TextPosition pt)
      )					;progn
    )					;if
  )					;foreach
)
(defun txt_height (ename / BlkEnt EntData height)
  (if
    (and
      (= (cdr (assoc 0 (setq EntData (entget ename))))
	 "DIMENSION"
      )
      (setq BlkEnt (tblobjname "block" (cdr (assoc 2 EntData))))
    )
     (while (setq BlkEnt (entnext BlkEnt))
       (if (= (cdr (assoc 0 (setq EntData (entget BlkEnt)))) "MTEXT")
	 (setq height (cdr (assoc 40 EntData)))
       )
     )
  )
  height
)
(princ)

Thanks Bee nhiều! Lisp của bạn rất hay :D


<<

Filename: 410433_test.lsp

Trang 260/304

260