Jump to content
InfoFile
Tác giả: vodoifx
Bài viết gốc: 413509
Tên lệnh: adv edv
Entmod Pline Theo Hình Dạng Của Pline Mẫu ( Vẫn Giữ Nguyên Entity Name)

;;; Add vertext into Polyline and LWPolyline 2010 by Thaistreetz

(defun c:Adv (/ DKCV LST LSTPT N PL PL1 PLS PLSTLAST PT PTA WP)

(if (and (setq PL (car (entsel (TCVN3-Unicode " - Chän ®­êng Pline cÇn thªm ®Ønh ")))) (wcmatch (cdr (assoc 0 (entget PL))) "*POLYLINE"))

(progn

(vl-cmdf "undo" "begin")

(if (= (cdr (assoc 0 (entget PL))) "POLYLINE")

(progn

(setq DKCV T PLSTLAST (getvar...
>>

;;; Add vertext into Polyline and LWPolyline 2010 by Thaistreetz

(defun c:Adv (/ DKCV LST LSTPT N PL PL1 PLS PLSTLAST PT PTA WP)

(if (and (setq PL (car (entsel (TCVN3-Unicode " - Chän ®­êng Pline cÇn thªm ®Ønh ")))) (wcmatch (cdr (assoc 0 (entget PL))) "*POLYLINE"))

(progn

(vl-cmdf "undo" "begin")

(if (= (cdr (assoc 0 (entget PL))) "POLYLINE")

(progn

(setq DKCV T PLSTLAST (getvar "PLINETYPE"))

(setvar "PLINETYPE" 1)

(vl-cmdf "convert" "P" "S" PL "")

(setvar "PLINETYPE" PLSTLAST)

);progn

);if

(setq PLs (ssadd PL (ssadd)))

(while (progn

(sssetfirst nil PLs)

(initget 128 "u")

(setq PTa (getpoint (TCVN3-Unicode "\nPick ®Ønh cÇn thªm ")))

(if (= PTa "u") (progn (prompt "- Undo") (vl-cmdf "undo" "Back")) PTa))

(if (/= PTa "u")

(progn

(vl-cmdf "undo" "mark")

(setq PT (vlax-curve-getPointatParam PL (setq n (fix (vlax-curve-getParamatPoint PL (vlax-curve-getClosestPointto PL (setq PTa (trans PTa 1 0))))))))

(setq Lst nil)

(if (= n 0)

(progn

(setq Lstpt (reverse(acet-geom-pline-point-list PL nil))

PL1 (makeLWPolyline lstpt nil nil nil nil nil nil))

(if (= (fix (vlax-curve-getParamatPoint PL1 (vlax-curve-getClosestPointto PL1 PTa))) (- (length Lstpt) 1))

(mapcar '(lambda (x)

(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)

(cons x (cons (list 10 (car PTa) (cadr PTa)) Lst))

(cons x Lst))))

(entget PL))

(mapcar '(lambda (x)

(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)

(cons (list 10 (car PTa) (cadr PTa)) (cons x Lst))

(cons x Lst))))

(entget PL)))

(entdel PL1))

(mapcar '(lambda (x)

(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)

(cons (list 10 (car PTa) (cadr PTa)) (cons x Lst))

(cons x Lst)))) (entget PL)))

(entmod (reverse Lst))))

);while

(sssetfirst)

(if DKCV (vl-cmdf "CONVERTPOLY" "H" wp "")))

(prompt (TCVN3-Unicode "\n§èi t­îng kh«ng ph¶i Polyline ")));if

(vl-cmdf "undo" "end")

(princ)

);end

;;; remove vertext into Polyline and LWPolyline

;;; copyright 2010 by Gia_Bach

;;; Edited 2010 by thaistreetz

(defun c:edv (/ removenth bulges coords ent idx param pt DKCV PLSTLAST)

(defun removenth (n lst / i rtn)

(setq i -1)

(foreach x lst (if (/= n (setq i (1+ i))) (setq rtn (cons x rtn))))

(reverse rtn))

(vl-cmdf "undo" "begin")

(while (progn

(initget 128 "u")

(setq ent (entsel (TCVN3-Unicode "\nChän ®Ønh Pline cÇn xãa: ")))

(if (= ent "u") (progn (prompt "- Undo") (vl-cmdf "undo" "Back")) ent))

(if (and (/= ent "u") (wcmatch (cdr (assoc 0 (entget (car ent)))) "*POLYLINE"))

(progn

(vl-cmdf "undo" "Mark")

(princ (setq pt (osnap (cadr ent) "near")))

(if (= (cdr (assoc 0 (entget (car ent)))) "POLYLINE")

(progn

(setq DKCV T PLSTLAST (getvar "PLINETYPE"))

(setvar "PLINETYPE" 1)

(vl-cmdf "convert" "P" "S" (car ent) "")

(setvar "PLINETYPE" PLSTLAST)))

(setq ent (vlax-ename->vla-object (car ent))

param (atoi (rtos (vlax-curve-getparamatpoint ent pt) 2 0))

coords (vlax-get ent 'coordinates) idx -1 bulges nil)

(repeat (/ (length coords) 2) (setq bulges (cons (vla-getbulge ent (setq idx (1+ idx))) bulges)))

(setq bulges (removenth param (reverse bulges)))

(repeat 2 (setq coords (removenth (* 2 param) coords)))

(vlax-put ent 'coordinates coords)

(setq idx -1)

(foreach bulge bulges (vla-setbulge ent (setq idx (1+ idx)) bulge))))

);while

(if DKCV (vl-cmdf "CONVERTPOLY" "H" ent ""))

(vl-cmdf "undo" "end")

(princ)

);end

(defun TCVN3-Unicode (stsua / index stdich chuht chusua tapsua)

(if (= (getvar "acadver") "16.1s (LMS Tech)") stsua (progn

(setq tapsua

(list (cons "µ" "\U+00E0")(cons "Ì" "\U+00E8")(cons "ß" "\U+00F2")(cons "ï" "\U+00F9")

(cons "¸" "\U+00E1")(cons "Ð" "\U+00E9")(cons "ã" "\U+00F3")(cons "ó" "\U+00FA")

(cons "¶" "\U+1EA3")(cons "Î" "\U+1EBB")(cons "á" "\U+1ECF")(cons "ñ" "\U+1EE7")

(cons "·" "\U+00E3")(cons "Ï" "\U+1EBD")(cons "â" "\U+00F5")(cons "ò" "\U+0169")

(cons "¹" "\U+1EA1")(cons "Ñ" "\U+1EB9")(cons "ä" "\U+1ECD")(cons "ô" "\U+1EE5")

(cons "©" "\U+00E2")(cons "ª" "\U+00EA")(cons "«" "\U+00F4")(cons "­" "\U+01B0")

(cons "Ç" "\U+1EA7")(cons "Ò" "\U+1EC1")(cons "å" "\U+1ED3")(cons "õ" "\U+1EEB")

(cons "Ê" "\U+1EA5")(cons "Õ" "\U+1EBF")(cons "è" "\U+1ED1")(cons "ø" "\U+1EE9")

(cons "È" "\U+1EA9")(cons "Ó" "\U+1EC3")(cons "æ" "\U+1ED5")(cons "ö" "\U+1EED")

(cons "É" "\U+1EAB")(cons "Ô" "\U+1EC5")(cons "ç" "\U+1ED7")(cons "÷" "\U+1EEF")

(cons "Ë" "\U+1EAD")(cons "Ö" "\U+1EC7")(cons "é" "\U+1ED9")(cons "ù" "\U+1EF1")

(cons "¨" "\U+0103")(cons "×" "\U+00EC")(cons "¬" "\U+01A1")(cons "ú" "\U+1EF3")

(cons "»" "\U+1EB1")(cons "Ý" "\U+00ED")(cons "ê" "\U+1EDD")(cons "ý" "\U+00FD")

(cons "¾" "\U+1EAF")(cons "Ø" "\U+1EC9")(cons "í" "\U+1EDB")(cons "û" "\U+1EF7")

(cons "¼" "\U+1EB3")(cons "Ü" "\U+0129")(cons "ë" "\U+1EDF")(cons "ü" "\U+1EF9")

(cons "½" "\U+1EB5")(cons "Þ" "\U+1ECB")(cons "ì" "\U+1EE1")(cons "þ" "\U+1EF5")

(cons "Æ" "\U+1EB7")(cons "®" "\U+0111")(cons "î" "\U+1EE3")(cons "¦" "\U+01AF")

(cons "¢" "\U+00C2")(cons "§" "\U+0110")(cons "¤" "\U+00D4")(cons "¥" "\U+01A0")

(cons "¡" "\U+0102")(cons "£" "\U+00CA")))

(setq index 1 stdich "")

(repeat (strlen stsua)

(setq chuht (substr stsua index 1)

index (1+ index)

chusua (cond ((assoc chuht tapsua) (cdr (assoc chuht tapsua))) (t chuht))

stdich (strcat stdich chusua)))

stdich)))

(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)

(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")

(cons 8 (if Layer Layer (getvar "Clayer")))

(cons 6 (if Linetype Linetype "bylayer"))

(cons 48 (if LTScale LTScale 1))

(cons 62 (if Color Color 256))

'(100 . "AcDbPolyline")

(cons 90 (length listpoint))

(cons 70 (if closed 1 0))))

(foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP)))))

(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))

(entmakex Lst));end

 

 

Em đang tham khảo lisp của bác Thaistreetz nhưng chưa ra ngô khoai gì. :))

 

 

32348161093_7653eb33d2_b.jpg


<<

Filename: 413509_adv_edv.lsp
Tác giả: dunguss3581
Bài viết gốc: 194944
Tên lệnh: ha
lệnh viết "độ phút giây" trong lisp

Kết hợp vừa chuyển đổi vừa ghi ra text thì ví dụ thế này:

(defun C:HA ( / goc dpg)
(setq goc (getreal...
>>

Kết hợp vừa chuyển đổi vừa ghi ra text thì ví dụ thế này:

(defun C:HA ( / goc dpg)
(setq goc (getreal "\nNhap gia goc : "))
(setq dpg (vl-string-subst (chr 176) "d" (angtos (* pi (/ goc 180.0)) 1 3)))
(command "text" "non" '(0 0) 2 0 dpg)
(princ))

 

Kết hợp vừa chuyển đổi vừa ghi ra text thì ví dụ thế này:

(defun C:HA ( / goc dpg)
(setq goc (getreal "\nNhap gia goc : "))
(setq dpg (vl-string-subst (chr 176) "d" (angtos (* pi (/ goc 180.0)) 1 3)))
(command "text" "non" '(0 0) 2 0 dpg)
(princ))

bạn có thể giúp tôi tính góc của một đỉnh trong tam giác có 3 đỉnh p1, p2, p3 không? hàm angle sử dụng thế nào vậy?


<<

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

Cảm ơn bạn phamthanhbinh đã quan tâm.

 

Khi sồ hóa đường đồng mức mất rất nhiều thời gian nên trước khi định...

>>

Cảm ơn bạn phamthanhbinh đã quan tâm.

 

Khi sồ hóa đường đồng mức mất rất nhiều thời gian nên trước khi định nghĩa mình nối trước vì vậy các đường đồng mức chưa có cao độ. Còn đây là file bạn xem thử

http://www.mediafire.com/?3q77b5j0t7fqcqv

Bạn xài thử cái này coi có ổn hơn thằng overkill không nhé. Mình chạy thử thấy cũng không quá chậm song có tí nhược điểm là nếu như cái đoạn overlay không trùng nhau hoàn toàn sẽ bị lỗi. Khi đó phải sửa bằng tay cái chỗ bị lỗi đó.

(defun gver ( e / enlist e2 enlist2)
 (setq enlist(entget e))
 (setq ptList(list))
 (setq e2 (entnext e)) 
 (setq enlist2 (entget e2))
 (while (not (equal (cdr(assoc 0 (entget(entnext e2))))"SEQEND"))
    (setq e2(entnext e2))
    (setq enlist2(entget e2))
    (if(/= 16 (cdr(assoc 70 enlist2)))
       (setq ptList(append ptList (list (cdr(assoc 10 enlist2)))))
    )
 ) 
 ptlist
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun chlst ( lst )
(setq lst2 (list))
(while (/= (cdr lst) nil)
        (setq lst2 (append lst2 (list (list (car lst) (cadr lst)))))
        (setq lst (cdr lst))
)
lst2
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:ovkpl (/ olcol ss ss1 en e1 plst plst1 pls1 pls2 i col ans )
(vl-load-com)
(command "undo" "be")
(setq olcol (getvar "cecolor"))
(setq ss (ssget (list (cons 0 "POLYLINE") (cons 8 "DONG MUC BANG DO")))
       ;;;;ssl (acet-ss-to-list ss)
       ;;;;n (sslength ss)
       ;;;i 0
)

(while (/= (sslength ss) 0) 
       (setq en (ssname ss 0))
       ;;;;(while (/= ss nil)
       (setq ss1 (ssdel en ss)
               plst (gver en)
               pls1 (chlst plst))
       (if (/= (sslength ss1) 0)
          (progn
              (setq i 0)
              (while (< i (sslength ss1))
              (setq e1 (ssname ss1 i))
              (setq col (cdr (assoc 62 (entget e1))))
              (setq plst1 (gver e1))
              (setq pls2 (chlst plst1))
              (setq ans nil)
              (if (or (equal plst plst1) (equal plst (reverse plst1)))
                  (command "erase" e1 "")
                  (foreach cp1 pls1
                              (foreach cp2 pls2
                                     (if (or (equal cp1 cp2) (equal cp1 (reverse cp2)))
                                        (progn                                          
                                        (setq plst1 (vl-remove (cadr cp2) (vl-remove (car cp2) plst1)))
                                        (setq ans T)
                                        )

                                     )
                              )
                  )                              
              ) 
              (if (= ans T)
              (progn 
              (setq ss1 (ssdel e1 ss1))            
              (command "erase" e1 "")
              ;;;;;(command "regenall")
              (setvar "cecolor" (rtos col 2 0))
              (command "pline"  )
              (foreach pt plst1 
                      (command pt) 
              ) 
              (command "")
              )
              )
              (setq i (1+ i))
              )
          )
       )
       (setq ss ss1)
       ;;;;;;;)

)
(setvar "cecolor" olcol)
(command "undo" "e")
(princ)
)

Có gì xin cứ phản hồi nhé. Mình viết cái này là dựa trên bản vẽ của bạn, nó chỉ xét các polyline trên lớp DONG MUC BANG DO. Kết quả trả về chỉ còn 1 phần là polyline còn phần kia là LWpolyline . Hơi khác với cái mẫu bạn gửi là tất cả đều là lwpolyline.

Trong cái mẫu bạn gửi, vẫn còn sót phần trùng đó.

Chúc bạn vui.


<<

Filename: 137919_ovkpl.lsp
Tác giả: nhocbabi
Bài viết gốc: 388289
Tên lệnh: scd
Nhờ Viết Lisp Đánh Số Cột Đèn Có Phân Pha!

 

Rảnh nên làm thầy bói phát xem sao :D :D :D

;;;lisp danh so cot den
(defun c:SCD( / st str p chu...
>>

 

Rảnh nên làm thầy bói phát xem sao :D :D :D

;;;lisp danh so cot den
(defun c:SCD( / st str p chu str1)
(setq	#tu (NGT #tu "1" getstring "Tu chieu sang so")
		#lo (NGT #lo "1" getstring "Lo so")
		#st (NGT #st 1 getint "STT cot dau tien")
		st (1- #st)
		str (strcat "TCS" #tu "/L" #lo "/")
		)
(while
	(setq p (getpoint "\nPick: "))
	(setq chu (nth (rem st 3) '("A" "B" "C"))
		  st (1+ st)
		  str1 (strcat str (itoa st) chu)
		  )
	(MakeText p str1 2.5 0 "L" nil nil 2 nil)
)
)
;;;==================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)
;;;=================================================
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial	
(setq Lst (list '(0 . "TEXT")
				(cons 8 (if Layer Layer (getvar "Clayer")))									
				(cons 62 (if Color Color 256))									
				(cons 10 point)									
				(cons 40 Height)									
				(cons 1 string)									
				(if Ang (cons 50 Ang))									
				(cons 7 (if Style Style (getvar "Textstyle")))									
				(cons -3 (if xdata (list xdata) nil)))				
				justify (strcase justify))	
				(cond ((= 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)))))				
					  ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))					
					  ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))				
					  ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
					  )	
					  (entmakex Lst)
);end
;=================================

Quá là tuyệt bác ạ, còn hơn cả mong đợi của em ấy, vì có thể lựa chọn tại bất kỳ điểm nào, và có thể lựa chọn được các thông số bắt đầu trong chuỗi text. Em chỉ nhờ bác xíu nữa thôi là hoàn hảo, đó là bác có thể thêm lựa chọn cho thông số cuối cùng được không ạ, nghĩa là sau khi hỏi “stt cột đầu tiên” - gõ thông số,  thì sẽ hỏi thêm “pha đầu tiên” ý ạ!

Một lần nữa cảm ơn bác rất rất nhiều!


<<

Filename: 388289_scd.lsp
Tác giả: thanh_kta
Bài viết gốc: 404267
Tên lệnh: gc
Sửa Lisp Để Tương Thích Với Autocad Đời

 

Chạy trên 2014 vẫn tốt, nhưng nếu có sửa thì thêm như sau:

(defun Length1 (e)
(vlax-curve-getDistAtParam...
>>

 

Chạy trên 2014 vẫn tốt, nhưng nếu có sửa thì thêm như sau:

(defun Length1 (e)
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
 
(defun C:GC (/ ss L e)
(setq ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE" )))
L  0.0
k  (getvar "dimlfac")
)
 
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua <1-Text co san / 2-Text moi>: "))
(if (= ans "1")
(progn
(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)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua: "))
(setq h (getreal "\n Nhap chieu cao text ket qua: "))
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 11 p) (cons 40 h) 
(cons 7 (getvar 'textstyle)) (cons 1 (strcat "D-L" (rtos L 2 1) " "))))
;;; (command "text" p h "0" (strcat "D-L" (rtos L 2 1) " "))
)
)
(ssdel e ss)
)
(princ)
)
 

Cảm ơn bác, em thử lại thì đúng là file cũ có chạy được trên cad 2014, trước load vào chạy mà không được. Xin lỗi đã làm phiền mọi người!


<<

Filename: 404267_gc.lsp
Tác giả: tranpro
Bài viết gốc: 278349
Tên lệnh: ddd
đo đường polyline

 

Viết bậy cho qua ngày

Bạn dùng đc thì dùng, ko dc thì cũng đừng ném đá :D :D :D

;dim nhanh
(defun...
>>

 

Viết bậy cho qua ngày

Bạn dùng đc thì dùng, ko dc thì cũng đừng ném đá :D :D :D

;dim nhanh
(defun c:DDD( / sel pl pre group)
(setq sel (car (entsel "\nChon polyline: ")))
(command ".copy" sel "" (list 0 0 0) "@0,0,0")
(setq pl (entlast))
(command ".explode" pl)
(setq pre pl
	group (ssadd)
	)
(while (setq pre (entnext pre))
		(setq group (ssadd pre group))
)
(setq i 0)
(while (< i (sslength group))
(progn
(setq ename (ssname group i)
	info (entget ename)
	)
(command ".DIMALIGNED" (cdr (assoc 10 info)) (cdr (assoc 11 info)) (polar (cdr (assoc 10 info)) (+ (angle (cdr (assoc 10 info)) (cdr (assoc 11 info))) (/ pi 2)) 10))
(setq i (1+ i))
))
(command ".erase" group "")
(princ)
)
Bác cho em hỏi có cách nào chỉ xuất 1 text cho cả đoạn polyline đó thôi được ko? chứ mỗi 1 line trong poliline nó cho 1 cái text ra thì hình có vể hơi rối? Mong bác giúp đỡ.

<<

Filename: 278349_ddd.lsp
Tác giả: Nộ Thiên
Bài viết gốc: 17267
Tên lệnh: vd
Có vấn đề với việc tạo TextStyle bằng lisp
Hoàn toàn đồng ý với bạn, các vấn đề tương tự như trên dùng entmake là hợp lý nhất. Tuy nhiên, không cần phải "dựa hơi" style có sẵn, có vẻ không "chính quy" lắm. Mình ví...
>>
Hoàn toàn đồng ý với bạn, các vấn đề tương tự như trên dùng entmake là hợp lý nhất. Tuy nhiên, không cần phải "dựa hơi" style có sẵn, có vẻ không "chính quy" lắm. Mình ví dụ, nếu ai đó đổi tên Standard thành MyStandard chẳng hạn thì hàm chStyle của bạn không tạo được style?

Bạn tham khảo đoạn sau:

;;;--------------------------------------------------------------------------
(defun emk_style (MyStyle MyFont MyFlag)
(entmake (list
   (cons 0 "STYLE")
   (cons 100 "AcDbSymbolTableRecord")
   (cons 100 "AcDbTextStyleTableRecord")
   (cons 2 MyStyle)
   (cons 3  MyFont)
   (cons 70 MyFlag)
))
)
;;;--------------------------------------------------------------------------
(defun C:VD()
(emk_style "MyStyle1" "txt" 0)
(emk_style "MyStyle2" "txt" 4)
)
;;;--------------------------------------------------------------------------

Chạy VD sẽ tạo 2 style: MyStyle1 bỉnh thường và MyStyle2 có hiệu ứng Vertical như ý bạn Nộ Thiên.

Mình đã thử emk_style với nhiều tổ hợp mã DXF khác nhau. Các mã 0, 100, 100, 2, 3, 70 như trên là bắt buộc, nghĩa là tối thiểu cần phải có để tạo thành style. Bạn lưu ý: các code 100 là bắt buộc trong đa số trường hợp để tạo các đối tượng Symbol Table bằng entmake.

Ngoài các code tối thiểu trên, có thể bổ sung các code khác theo ý đồ và nhu cầu sử dụng. Bạn có thể tham khảo DXF Reference trong Help để biết cụ thể hơn.

Ngoài ra, theo mình, không nên đưa các biểu thức điều kiện như (if (null (setq item (tblsearch "style" tenstyle)))... vào các function mang tính public như cái chúng ta đang xây dựng. Các điều kiện như vậy nên đặt trong chương trình chính khi áp dụng, dễ xử lý tình huống một cách triệt để hơn.

Đúng là mình bị "ì" rồi. Quên mất là còn khả năng tạo textstyle bằng entmake. Thank so much.

 

không nên đưa các biểu thức điều kiện như (if (null (setq item (tblsearch "style" tenstyle)))...

Còn cái này cũng do "ì" mà ra bởi vì nguồn gốc của nó do hàm public (chlayer) mà ra. Chứ nếu viết nó độc lập thì mình đã đặt tên hàm là (creatstyle) rồi chứ kg phải (chstyle).

 

(emk_style "MyStyle1" "VNI-Helve-Condense" 0)

Cái dòng code trên có gì đó kg ổn, kg biết SSG có nhận thấy kg vì:

Nếu tetstyle bằng lệnh của CAD thì kg bao giờ có thể tick vào "Vertical" đc.

Nhưng với dòng code trên thì có thể. Kg biết có rắc rối chi về sau kg. Cái này để test sau vậy.

Một lần nữa gửi lời cảm ơn đến 2 bạn: Crazylisp và Ssg


<<

Filename: 17267_vd.lsp
Tác giả: manhti14
Bài viết gốc: 412877
Tên lệnh: test1 test2
Điều Chỉnh Toàn Bộ Text

 

Thử cái này xem nhé. ^_^

(defun Bee_run (ss / n vlaobj)
  (if (tblsearch "style" "gaiheki")
    (command "-style"...
>>

 

Thử cái này xem nhé. ^_^

(defun Bee_run (ss / n vlaobj)
  (if (tblsearch "style" "gaiheki")
    (command "-style" "gaiheki" "romans.shx" 50. 0.75 "" "" "" "")
    )
  (if ss
    (progn
      (setq n 0)
      (repeat (sslength ss)
        (setq vlaobj (vlax-ename->vla-object (ssname ss n)))
        (if (= (vlax-get vlaobj 'StyleName) "bigfont")
          (vlax-put vlaobj 'StyleName  "standard")
          )
        (vlax-put vlaobj 'Height  100.)
        (vlax-put vlaobj 'ScaleFactor  0.55)
        (setq n (1+ n))
        )      
      )
    )
  )
(defun c:test1 ()                
  (Bee_run (ssget "_X" '((0 . "TEXT,MTEXT"))))
  (princ)
  )
(defun c:test2 ()                
  (Bee_run (ssget '((0 . "TEXT,MTEXT"))))
  (princ)
  )

CHẠY ĐƯỢC RỒI BÁC Ạ :D.

MỖI CÁI KHÔNG CHUYỂN ĐƯỢC STYLE CỦA TEXT VỀ STANDARD.

 

NHÂN TIỆN E MUỐN HỎI LUÔN LÀ NẾU NHƯ LÚC CHỈNH "GAIHEKI" STYLE NẾU NHƯ MUỐN CHỌN THÊM THUỘC TÍNH BIGFONT THÌ LÀM THẾ NÀO Ạ :).

EM XIN CÁM ƠN BÁC NHIỀU.


<<

Filename: 412877_test1_test2.lsp
Tác giả: Danh Cong
Bài viết gốc: 428935
Tên lệnh: vtt
Nối thép 40D

Tôi hay dùng cái thể thể loại này - Tự viết lâu. Chỉ vẽ ra cốt thép, còn Dim thì dùng tay ( Bởi không thích viết và không có nhu cầu cần viết).



(defun c:vtt (/ d L40 X1 Y1 PT-end X-end Y-end scale osold)
(command "undo" "begin")
;;;;; So lieu dau vao
  (setq L (getdist "Nhap chieu dai / Chon 2 diem: "))
;;;;;; Luu gia tri duong kinh
  (or Vtt.d (setq Vtt.d 16))
  (setq...

>>

Tôi hay dùng cái thể thể loại này - Tự viết lâu. Chỉ vẽ ra cốt thép, còn Dim thì dùng tay ( Bởi không thích viết và không có nhu cầu cần viết).



(defun c:vtt (/ d L40 X1 Y1 PT-end X-end Y-end scale osold)
(command "undo" "begin")
;;;;; So lieu dau vao
  (setq L (getdist "Nhap chieu dai / Chon 2 diem: "))
;;;;;; Luu gia tri duong kinh
  (or Vtt.d (setq Vtt.d 16))
  (setq Vtt.d (cond ((getreal (strcat "\nNhap D= < " (rtos Vtt.d 2 0) " >:")))(Vtt.d)))
 
  (setq    Pt1 (getpoint "\n Nhap diem ve: "))
  (setq scale (getvar "dimscale"))
  (setq osold (getvar "osmode"))
  (setvar "osmode" 0)

  ;;;;; Tinh toan so lieu:
  
  (setq L40 (* 40 vtt.d)
    X1 (car Pt1)
    Y1 (cadr Pt1)
    PT-end (Polar Pt1 0 L)
    X-end (car Pt-end)
    Y-end (cadr Pt-end))
  ;;;;;; Ve thep

  (While  (> X-end X1)
          (if (>= 11700 (- X-end X1))
        (progn
              (command ".line" Pt1 Pt-End "")
              (setq X1  X-End))
        (Progn
              (setq Pt2 (polar Pt1 0 11700))
          (command ".line" Pt1 Pt2 "")
          (setq X1 (- (car Pt2) L40)
            Y1 (+ (cadr Pt1) (* 1.5 scale))
            Pt1 (list X1 Y1)
                    PT-end (list X-end Y1))
          )
      ))
  (setvar "osmode" osold)
  (command "undo" "end")
  (Princ))


<<

Filename: 428935_vtt.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 250535
Tên lệnh: pdm thuhoi
Nhờ hoàn thiện lisp phun điểm mia địa chính ra Autocad

Em thấy cái lisp của anh toiyeuviet nam rất đơn giản về cách thực hiện, nhờ các các anh giúp sửa giúp em để khi mình chỉ cần...

>>

Em thấy cái lisp của anh toiyeuviet nam rất đơn giản về cách thực hiện, nhờ các các anh giúp sửa giúp em để khi mình chỉ cần ghi tọa độ 2 điểm GPS1 và GPS2 như file số liệu em gửi kèm theo và phun điểm mia bằng gõ lệnh PDM -> nhập mẫu số tỉ lệ: gõ 1000 -> tìm file solieu -> là phun điểm mia ra giống như hình vẽ kèm theo được không ạ! Chỉ cần liệt kê tọa độ trạm máy và điểm định hướng (giống như dùng chương trình chitietwin của thầy Trần Trung Anh chỉ cần liệt kê tọa độ trạm máy và điểm định hướng là tự vẽ lưới các trạm trong khu đo).

mong các anh giúp em với nhé vì nếu thành công thì công đoạn sẽ đơn giản mà không phải phức tạp và nhiều file rác trong khâu xử lý số liệu nữa! cảm ơn các anh trước nhé!

------------------------------------------------------------------------------------------------------------------------------------------------------------------
;******chuong trinh phun diem mia cho file duoc che bien tu may TOPCON 223**********
 ;          	DUNG CHO BAN DO DIA CHINH 	*
 ;* TR  DCII-04  1014424.593 516275.846       	*
 ;* TR  DCII-07  1014339.861 516213.914       	*
 ;* TR  DCII-03  1014491.054  516180.297        	*
 ;* TR  DCII-06  1014670.141  516433.592         	*
 ;* TR  DCTI-04       	*
 ;* DH  DCII-03         	*
 ;* 1    	355.1447 	66.896        	*
 ;* 2    	355.1519 	47.576         	*
 ;* 3    	1.4545   	48.375        	*
 ;************************************************************************
(defun c:pdm (/    	tam ms  PR   FN	thunhat
   	tentram  caodotram  xtram   ytram	htram
   	tentrammay tendh
  	)
  (bdau)
  (setq tam ())
  (setq ms (getreal "Nhap vao mau so ty le : "))
  (setq
	FN (getfiled "NhËp file nguån : "
   ""
   ""
   4
   	)
  )
  (progn
	(command "-osnap" "")
	(setvar "cmdecho" 0)
	(setvar "luprec" 8)
	(setvar "pdmode" 0)
	(command "-layer" "m" "diem" "c" "red" "" "")
;	(command "-layer" "m" "caodo" "c" "cyan" "" "")
	(command "-layer" "m" "sothutu" "c" "magenta" "" "")
	(command "-layer" "m" "khongche" "c" "red" "" "")
	(setq st (/ ms 1000))
	(setq st1 st)
	(command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
	(setq FN (open FN "r"))
	(while (and (setq PR (read-line FN)) (/= PR ""))
  	(progn
(setq PR (strcat "(" PR ")"))
(setq PR (read PR))
(setq thunhat (nth 0 PR))
(if
   (numberp thunhat)
	(gapsoA)
	(gaptramA)
)
  	) ;end progn
	) ;end while
  ) ;end progn
;;;;ket thuc viet lenh
  (close FN)
  (command "zoom" "e")
  (kthuc)
  (princ "\nVAY LA XONG!)*****")
  (princ)
)
(defun gaptramA (/ x y)
  (setq thunhat (convtostr thunhat))
  (if (= thunhat "TR")
	(progn
  	(setq ktra (nth 3 PR))
  	(if (/= ktra nil) ;GAP TRAM CHUA TOA DO GOC
(progn
   (setq tentram (convtostr (nth 1 PR)))
   (setq Y (nth 2 PR))
   (setq X ktra)
;   (setq h (nth 4 PR))
   (setq tam (append tam (list (list tentram x y ))))
)   ;GAP TRAM DO THUC TE
(progn
   (setq tentrammay (convtostr (nth 1 PR)))
;   (if (/= (nth 2 PR) nil)
; 	(setq caodotram (nth 2 PR))
; 	(setq caodotram 0)
;   )
   (laytdgoc tentrammay)
   (setq tdtram1 (list (+ xtram (* 2 st)) ytram ))
   (setq xxtram xtram)
   (setq yytram ytram)
   (setq tdtram (list xtram ytram))
   (command "-layer" "s" "khongche" "")
;(command "point" tdtram)
   (command "insert" "cdkc" tdtram st st "")
   (setq sss (strlen tentrammay))
   (setq tdtram2 (list (+ xtram (* 2 st) );(* (/ sss 2) st))
     	(- ytram (* 0.65 st))       
   )
   )
;   (command "insert"
; "l"
; 	tdtram1
; 	(* st sss)
; 	(* st sss)
; ""
;   )
   (command "-style"
 "mota"
 "txt.shx"
 	st
 "1"
 "0"
 "n"
 "n"
 "n"
   )
   (command "text" "j" "bl" tdtram1 "" tentrammay)
   (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
;   (command "-layer" "s" "khongche" "")
;   (command "text" "j" "tl" tdtram2 "" (rtos htram 2 2))
)
  	)
	) ;end progn
	(if (= thunhat "DH")  ;else
  	(progn
(setq tendh (convtostr (nth 1 PR)))
(laytdgoc tendh)
(setq tddh (list xtram ytram ))
(setq tddh1 (list (+ xtram (* 2 st)) ytram ))
(command "-layer" "s" "khongche" "")
(command "insert" "cdkc" tddh st st "")
;(command "point" tddh)
(setq sss (strlen tendh))
(setq tddh2 (list (+ xtram (* 2 st)); (* (/ sss 2) st))
 	(- ytram (* 0.65 st))    
  	)
)
;(command "insert"
;  "l"
;  tddh1
;  (* st sss)
;  (* st sss)
;  ""
<img src='http://www.cadviet.com/forum/public/style_emoticons/<#EMO_DIR#>/wink.png' class='bbc_emoticon' alt=';)' />
(command "-style"
   "mota"
   "txt.shx"
   st
   "1"
   "0"
   "n"
   "n"
   "n"
)
(command "text" "j" "bl" tddh1 "" tendh)
(command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
; (command "-layer" "s" "khongche" "")
; (command "text" "j" "tl" tddh2 "" (rtos htram 2 1))
  	)
	)
  )
)
(defun gapsoA (/ gocbang kc goctd tdx tdy tdz td dentah)
  (setq gocbang (nth 1 PR))
  (setq kc (nth 2 PR))
;  (setq dentah (nth 3 PR))
  (setq gocbang (dpgtod gocbang))
  (setq gocbang (- 360 gocbang))
  (setq gocbang (+ (/ (* gocbang pi) 180) (angle tdtram tddh)))
  (setq tdX (+ xxtram (* kc (cos gocbang))))
  (setq tdY (+ yytram (* kc (sin gocbang))))
;  (if (/= dentah nil)
;	(setq tdz (+ caodotram (nth 2 tdtram) dentah))
;	(setq tdz 0)
;  )
  (setq td (list tdx tdy))
  (setq td1 (list (+ tdx (* 0.5 st)) (+ tdy (* 0.3 st)) ))
  (setq td2 (list (+ tdx (* 0.5 st)) (- tdy (* 0.3 st)) ))
  (command "-layer" "s" "diem" "")
  ;(command "insert" "cdc" td st st "")
  (command "point" td)
  (command "-style"
"mota"
"txt.shx"
	(* st 2)
"1"
"0"
"n"
"n"
"n"
  )
  (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
  (command "-layer" "s" "sothutu" "")
  (command "text" td "" thunhat)
;  (command "-style" "mota" "txt.shx" st1 "1" "0" "n" "n" "n")
;  (command "-layer" "s" "caodo" "")
;  (command "text" "tl" td "" (rtos tdz 2 1))
)
------------------------------------------------------------------------------------
---------------------------------------------------------------------------------------
CHUONG TRINH CON:
---------------------------------------------------------------------------------------
(defun c:thuhoi (/ tenfile tenfile1 timfile dodaichuoi)
  (setq dodaichuoi (strlen (getvar "dwgname")))
  (setq tenfile1 (strcat (substr (getvar "dwgname") 1 (- dodaichuoi 3)) "xls"))
  (setq tenfile (strcat (getvar "dwgprefix") (getvar "dwgname")))
  (setq timfile (findfile (strcat (getvar "dwgprefix") tenfile1)))
  (if (/= timfile nil)
  	(vl-file-delete timfile)
  )
  ;(command "-eattext" "" "n" "n" "C:\\Program Files\\thuhoi.blk" "X" tenfile);Ghi file nhung bo bot vai cot
  (command "-eattext" "" "n" "n" "" "X" tenfile);Ghi file nhung khong bo bot cot
)
(defun laytdgoc (tentrammay / len i sosanh)
  (setq len (length tam))
  (setq i 0)
  (setq j 0)
  (while (< i len)
	(progn
  	(setq sosanh (car (nth i tam)))
  	(if (= tentrammay sosanh)
(progn
   (setq j (+ j 1))
   (setq xtram (cadr (nth i tam)))
   (setq ytram (caddr (nth i tam)))
   (if (/= (cadddr (nth i tam)) nil)
 	(setq htram (cadddr (nth i tam)))
 	(setq htram 0.0)
   )
)
(progn
   (if (= j 0)
 	(progn
   	(setq xtram 0)
   	(setq ytram 0)
   	(setq htram 0)
 	)
   )
)
  	)
  	(setq i (+ i 1))
	)
  )
)
(defun ConvtoStr (Sym)
  (setq ftemp "temp.tmp")
  (setq ftmp (open ftemp "w"))
  (princ Sym ftmp)
  (close ftmp)
  (setq ftmp (open ftemp "r"))
  (setq sym (read-line ftmp))
  (close ftmp)
  (princ sym)
)
(defun *error* (msg)
  (princ "\nerror:")
  (princ msg)
  (command "osmode" h "")
  (command "_.undo" "end")
  (command "clayer" clay)
  (command "u" "")
  (alert "  - - - - ha ha ha- - - -"
  )
  (setq *error* olderr)
  (princ)
)
(defun bdau ()
;(setq FNr "c:\\program files\\sr.txt")
;(setq FNr (open FNr "r"))
;(setq PRr (read-line FNr))
;(if (/= PRr "0909.446.887")
;(alert "VAY LA OK!"  )
   
<img src='http://www.cadviet.com/forum/public/style_emoticons/<#EMO_DIR#>/wink.png' class='bbc_emoticon' alt=';)' />
;(close FNr)
  (command "_.undo" "begin")
  (setq cmd (getvar "cmdecho"))
  (setq plwid (getvar "plinewid"))
  (setq elev (getvar "elevation"))
  (setq thick (getvar "thickness"))
  (setq hh (getvar "osmode"))
  (setq clay (getvar "clayer"))
)
(defun kthuc ()
  (command "plinewid" plwid)
  (command "elevation" elev)
  (command "thickness" thick)
  (command "osmode" hh)
  (command "_.undo" "end")
  (command "clayer" clay)
  (command "cmdecho" cmd)
)
(defun dpgtod (nhap / do phut giay)
  (setq do (fix nhap))
  (setq phut (fix (* (- nhap do) 100)))
  (setq giay (* (- (* (- nhap do) 100) phut) 100))
  (setq xuat (+ do (/ (* phut 1.0) 60) (/ giay 3600)))
)
(defun dtodpg (nhap / do phut giay)
  (setq do (fix nhap))
  (setq phut (fix (* (- nhap do) 60)))
  (setq giay (* (- (* (- nhap do) 60) phut) 60))
  (setq xuat (strcat (rtos do 2 0) "." (rtos phut 2 0) (rtos giay 2 0)))
)
(defun dd (nhap)
  (setq len (strlen nhap))
  (cond ((= len 1)  (setq xuat (strcat nhap "      	")))
((= len 2)  (setq xuat (strcat nhap "     	")))
((= len 3)  (setq xuat (strcat nhap "    	")))
((= len 4)  (setq xuat (strcat nhap "   	")))
((= len 5)  (setq xuat (strcat nhap "  	")))
((= len 6)  (setq xuat (strcat nhap " 	")))
((= len 7)  (setq xuat (strcat nhap "	")))
((= len 8)  (setq xuat (strcat nhap "   ")))
((= len 9)  (setq xuat (strcat nhap "  ")))
((= len 10) (setq xuat (strcat nhap " ")))
((= len 11) (setq xuat (strcat nhap "")))
; ((= len 12) (setq xuat (strcat nhap "     	")))
; ((= len 13) (setq xuat (strcat nhap "    	")))
; ((= len 14) (setq xuat (strcat nhap "   	")))
; ((= len 15) (setq xuat (strcat nhap "  	")))
; ((= len 16) (setq xuat (strcat nhap " 	")))
; ((= len 17) (setq xuat (strcat nhap "	")))
; ((= len 18) (setq xuat (strcat nhap "   ")))
; ((= len 19) (setq xuat (strcat nhap "  ")))
; ((= len 20) (setq xuat (strcat nhap " ")))
; ((= len 21) (setq xuat (strcat nhap "")))
  )
)
(defun dd1 (nhap)
  (setq len (strlen nhap))
  (cond ((= len 1)  (setq xuat (strcat nhap "                	")))
((= len 2)  (setq xuat (strcat nhap "               	")))
((= len 3)  (setq xuat (strcat nhap "              	")))
((= len 4)  (setq xuat (strcat nhap "             	")))
((= len 5)  (setq xuat (strcat nhap "            	")))
((= len 6)  (setq xuat (strcat nhap "           	")))
((= len 7)  (setq xuat (strcat nhap "          	")))
((= len 8)  (setq xuat (strcat nhap "         	")))
((= len 9)  (setq xuat (strcat nhap "        	")))
((= len 10) (setq xuat (strcat nhap "       	")))
((= len 11) (setq xuat (strcat nhap "      	")))
((= len 12) (setq xuat (strcat nhap "     	")))
((= len 13) (setq xuat (strcat nhap "    	")))
((= len 14) (setq xuat (strcat nhap "   	")))
((= len 15) (setq xuat (strcat nhap "  	")))
((= len 16) (setq xuat (strcat nhap " 	")))
((= len 17) (setq xuat (strcat nhap "	")))
((= len 18) (setq xuat (strcat nhap "   ")))
((= len 19) (setq xuat (strcat nhap "  ")))
((= len 20) (setq xuat (strcat nhap " ")))
((= len 21) (setq xuat (strcat nhap "")))
  )
)

file solieu và kết quả cần ra bản vẽ sau khi thực hiện xong

 

http://www.cadviet.com/upfiles/3/103752_file_solieu_goc_canh_va_san_pham_ban_ve_sau_phun_diem_mia.rar

Hề hề hề,

Xin lỗi bạn vì tò mò nhé.

Mình không rõ mối liên hệ giữa bảng số liệu bạn gửi với bản vẽ bạn gửi bạn ạ,

Nếu mình không nhầm thì bản vẽ bạn gửi được vẽ từ bảng số liệu khác vì mình kiểm tra tọa độ của hai điểm gprs1 và gprs2 thì chúng không giống với số liệu trong bảng của bạn. 

Nếu như bạn có hiệu chỉnh gì đó với các số liệu này thì mong bạn hãy giải thích cụ thể cách hiệu chỉnh đó.

Do mình không phải dân trắc đ5c hay bản đố nên thiệt tình không hiểu rõ cái bảng số liệu của bạn. Vì thế mình đoán mò rằng cột thứ nhất chỉ số thứ tự của điểm đo, cột thứ hai chỉ góc hợp thành giữa hai dường thẳng là đường nối từ điểm đo tới trạm GPRS2 và đường nối từ trạm GPRS2 tới trạm GPRS1. Cột thử 3 chỉ khoảng cách từ điểm đo tới trạm GPRS1.

Nếu đúng như vậy thì mình nghĩ có thể làm lisp được. 

Còn nếu không đúng mong bạn chớ giận và xin giải thích rõ mối tương quan giữa các số liệu đo với bản vẽ. Từ đó mình mới có hy vọng có thể làm lisp giúp bạn được.

Ngoài ra cái lưới tram mà bạn vẽ màu đỏ giữa các trạm GPRS1 GPRS2, P1 CP3, CP4 được thiết lập theo nguyên tắc nào, mong bạn giải thích rõ hơn mới có thể viết lisp được bạn ạ.

Chúc bạn vui.


<<

Filename: 250535_pdm_thuhoi.lsp
Tác giả: Superlong
Bài viết gốc: 395970
Tên lệnh: yeah
Hỏi Về Lisp Tạo Boundary Từ Các Polyline Không Giao Nhau

   ví dụ tôi có 2 pline nằm rời rạc như thế nay tôi muốn tạo boundary bằng cách chọn 2 pline đó thì boundary sẽ được tạo là bao quanh các đỉnh của 2 pline này , em thử dùng 2 hàm (acet-geom-vertex-list (ssget)) để lấy tọa độ xog dùng hàm (acet-pline-make) nhưng lại báo lỗi error: bad argument type: lentityp nil

các bác có thể giúp em không 

>>

   ví dụ tôi có 2 pline nằm rời rạc như thế nay tôi muốn tạo boundary bằng cách chọn 2 pline đó thì boundary sẽ được tạo là bao quanh các đỉnh của 2 pline này , em thử dùng 2 hàm (acet-geom-vertex-list (ssget)) để lấy tọa độ xog dùng hàm (acet-pline-make) nhưng lại báo lỗi error: bad argument type: lentityp nil

các bác có thể giúp em không 

(defun c:yeah ( / dt dt1 dt2 rec1 rec2 ss)

(setq dt (ssget '((0 . "LWPOLYLINE"))))

(setq dt1 (ssname dt 1)

dt2 (ssname dt 2)

rec1 (acet-geom-vertex-list dt1)

rec2 (acet-geom-vertex-list dt2))

(setq ss (append rec1 rec2))

(acet-pline-make ss))

 

150337_capture_3.png


<<

Filename: 395970_yeah.lsp
Tác giả: phambr45
Bài viết gốc: 71816
Tên lệnh: sxt
Viết Lisp theo yêu cầu
Bạn sử dụng Code này thử nhé :

(defun c:sxt()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(command "justifytext" ss ""...
>>
Bạn sử dụng Code này thử nhé :

(defun c:sxt()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(command "justifytext" ss "" "BC")

(setq lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(<
(cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))
)
)
)
)

(setq ddau (cdr(assoc 10 (entget(car lst))))
i 0)

(foreach e lst
(setq ent (entget e))
(setq dcuoi (cdr(assoc 10 ent)))
(setq ddauu (list (car dcuoi) (cadr ddau) 0))
(command "move" e "" dcuoi ddauu) 
(setq i (1+ i))
)
(setvar "osmode" oldos)
(Princ)
)
;
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

Thật sự là tuyêt vời.Cảm ơn rất nhiều!


<<

Filename: 71816_sxt.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 221096
Tên lệnh: dai
viết lisp tính chiều dài trung bình của nhiều đoạn thẳng

Cái chọn K máy bạn không được, mình không rõ lắm vì máy mình ok (Bạn thử kiểm tra lại chế độ bắt điểm)

bạn thử...

>>

Cái chọn K máy bạn không được, mình không rõ lắm vì máy mình ok (Bạn thử kiểm tra lại chế độ bắt điểm)

bạn thử xem

(prompt "command : dai")
(defun c:dai()
(setq tong 0)
(setq th (ssget))
(setq index 0)
(setq dtuong (sslength th))
(while (< index dtuong)
 (setq ds (entget (ssname th index)))

(command "lengthen" (ssname th index) "" )
(setq tong (+ tong (getvar "perimeter")))

(setq index (1+ index))
)
(print tong)
(prompt "Ghi text moi <G> hay thay the text (T) :")
(setq luachon (getstring))
(setq luachon (strcase luachon))
(if (= "" luachon) (setq luachon "G"))
(if (= "G" luachon)
(progn
  (setq pt1 (getpoint))
  (setq h (/ (getvar "viewsize") 20))
  (command "text" pt1 h "" tong)
 )
)
(if (= "T" luachon)
(progn
(prompt "\n Chon gia tri can thay the")
(SETQ TT (SSGET))
 (setq s (entget (SSNAME TT 0)))
 (setq otext (assoc 1 s))
 (setq ot (cdr otext))
 (setq ot (read (substr ot 1 )))
 (setq nt (cons 1 (rtos tong 2)))
 ;(setq s (subst nt otext s))
(setq s (subst (cons 62 80) (assoc 62 s) s))
(setq s (append s (list (cons 62 80))))
(entmod s)
(princ)
)
)
)

Tôi chỉ sửa qua được vậy thôi :D

Cái số 80 là mầu, bạn thích mầu nào thay số 80=màu (1...256)

Hề hề hề,

Bác NguyenNgocSon xem lại dòng code này:

(command "text" pt1 h "" tong)

Hình như chỗ "" phải là một giá trị số mới đúng bác ạ.


<<

Filename: 221096_dai.lsp
Tác giả: hung1608
Bài viết gốc: 358863
Tên lệnh: m2c
Yêu câu lisp: copy chính giữa đối tượng vào Rectang

 

lỗi code diễn đàn bị mất tên biến. Bạn lấy lisp này (mình chỉ đổi lại tên biến)

;;...
>>

 

lỗi code diễn đàn bị mất tên biến. Bạn lấy lisp này (mình chỉ đổi lại tên biến)

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/280-lisp-move-text-vao-chinh-giua-mot-rectang/
(defun c:m2c (/ comm src des oldos mid)
  (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
  )
  (or cm (setq cm "C"))
  (initget "C M")
  (setq comm (getkword  (strcat "\nBan muon Copy hay Move <" cm ">: ")))
  (if(not comm)(setq comm cm))
  (setq cm comm)
  (setq oldos (getvar "osmode"))
  (setvar "osmode" 0)
  (while (and
	   (setq src (car (entsel "\nDoi tuong can di chuyen: ")))
	   (not(redraw src 3))
	   (setq des (car (entsel "\nDoi tuong dich: ")))
	   (not(redraw src 4))
	 )
    (if	(= (strcase comm) "C")
      (command ".copy" src "" (mid src) (mid des))
      (command ".move" src "" (mid src) (mid des))
    )
  )
  (setvar "osmode" oldos)
  (princ)
)
(vl-load-com)

Giả sử Bạn quét chọn có 2 đối tượng, thì đối tượng nào là nguồn, là đích, khi quét được n đối tượng thì sẽ ra sao

Mô tả của Bạn khó hiểu quá. Bạn hãy up file lên trong đó thể hiện trước và sau khi thực hiện lệnh, "khu vực đó" là gì

 

Vẫn thế bạn ơi, vẫn chỉ Move thôi k copy được, không có lựa chon copy hay move gì cả

Bạn xem file nay của mình, mình có các căn hộ cần bố trí tiết bị ở giữa phòng, mình muốn dùng lisp để thực hiện công việc này có được không bạn

Cảm ơn bạn đã xem bài viết của mình

http://www.cadviet.com/upfiles/5/11317_da_nang.rar


<<

Filename: 358863_m2c.lsp
Tác giả: hung1608
Bài viết gốc: 358455
Tên lệnh: m2c
Yêu câu lisp: copy chính giữa đối tượng vào Rectang

đã chỉnh sửa cho Bạn

;; free lisp from cadviet.com
;;; this lisp was downloaded from...
>>

đã chỉnh sửa cho Bạn

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/280-lisp-move-text-vao-chinh-giua-mot-rectang/
(defun c:m2c (/ comm src des oldos mid)
  (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
  )
  (or com (setq com "C"))
  (initget "C M")
  (setq comm (getkword  (strcat "\nBan muon Copy hay Move <"com">:")))
  (if(not comm)(setq comm com))
  (setq com comm)
  (setq oldos (getvar "osmode"))
  (setvar "osmode" 0)
  (while (and
	   (setq src (car (entsel "\nDoi tuong can di chuyen: ")))
	   (not(redraw src 3))
	   (setq des (car (entsel "\nDoi tuong dich: ")))
	   (not(redraw src 4))
	 )
    (if	(= (strcase comm) "C")
      (command ".copy" src "" (mid src) (mid des))
      (command ".move" src "" (mid src) (mid des))
    )
  )
  (setvar "osmode" oldos)
  (princ)
)
(vl-load-com)

Việc chon nhiều rectang rồi chọn các đối tương thì chưa có vì phải có qui luật sắp xếp. Nếu sắp xếp theo thứ tự chọn thì làm theo lisp trên sẽ nhanh hơn

 Cảm ơn bạn đã giúp mình, mình đã sử dụng lisp chạy ổn nhưng còn 1 số chỗ bạn điều chỉnh giúp mình được không

+ khi dùng lisp xong thì mất hết chon điêm Osnap, mình thử mấy lần rùi vẫn thế

+ bạn có thể cho lísp lựa chọn thêm chức năng copy hoặc move được không

+Thêm lựa chon chức năng quét 1 khu vực hoặc lựa chọn Rectang thì đối tượng được chọn sẽ copy hay move vào chính giữa

Thanks bạn rất nhiều. 


<<

Filename: 358455_m2c.lsp
Tác giả: leejang
Bài viết gốc: 162566
Tên lệnh: o2p
Lệnh offset đặc biệt

Bạn dùng thử cái này

(defun c:o2p()
 (setq ob (vlax-ename->vla-object(car(entsel"\n chon doi tuong de offset:...
>>

Bạn dùng thử cái này

(defun c:o2p()
 (setq ob (vlax-ename->vla-object(car(entsel"\n chon doi tuong de offset: ")))
kc (* (getreal"\n Nhap khoang cach offset: ") 2)
sp (vlax-safearray->list(vlax-variant-value(vla-get-startpoint ob)))
ep (vlax-safearray->list(vlax-variant-value(vla-get-endpoint ob))))
 (command "Mline" "j" "z" "s" kc sp ep "")
 (command "explode" "l" "")
 )

Em thì chỉ dùng trong khi vẽ thép. Vậy bác chỉnh giúp em để đối tượng mới sinh ra thuộc layer "THEP", và đối tượng có màu 4 được ko ạ ?


<<

Filename: 162566_o2p.lsp
Tác giả: duy782006
Bài viết gốc: 429071
Tên lệnh: ttl
Lisp vẽ thước tỷ lệ cho trắc dọc

Mức so sánh min và max có luôn là số nguyên hay không. Nếu đúng thì thử cái này xem. Chưa hoàn chỉnh coi có ưng sửa gì thì sửa luôn 1 thể.

 

(defun c:ttl ()
(or ssmin (setq ssmin 0))
(setq ssmin (cond ((getint (strcat "\nMuc so sanh min < " (rtos ssmin 2 0) " >:")))(ssmin)))

(or ssmax (setq ssmax 10))
(setq ssmax (cond ((getint (strcat "\nMuc so sanh...
>>

Mức so sánh min và max có luôn là số nguyên hay không. Nếu đúng thì thử cái này xem. Chưa hoàn chỉnh coi có ưng sửa gì thì sửa luôn 1 thể.

 

(defun c:ttl ()
(or ssmin (setq ssmin 0))
(setq ssmin (cond ((getint (strcat "\nMuc so sanh min < " (rtos ssmin 2 0) " >:")))(ssmin)))

(or ssmax (setq ssmax 10))
(setq ssmax (cond ((getint (strcat "\nMuc so sanh max < " (rtos ssmax 2 0) " >:")))(ssmax)))

(or tlve (setq tlve 1))
(setq tlve (cond ((getreal (strcat "\nTi le ve < " (rtos tlve 2 1) " >:")))(tlve)))

(setq diemve (getpoint "\nChon diem ve thuoc :"))
(setq diemdau diemve)
(setq slc ssmin)

(repeat (fix (- ssmax ssmin))
(setq diemve (polar diemve (/ pi 2) (* 0.1 tlve)))
(entmake (list (cons 0 "LINE")(cons 10 diemve)(cons 11 (polar diemve pi (* 0.1 tlve)))(cons 8 "Clayer")(cons 62 256)(cons 6 "bylayer")(cons 48 1) )) 
(entmake (list (cons 0 "TEXT")(cons 10 (polar diemve pi (* 0.5 tlve)))(cons 11 (polar diemve pi (* 0.5 tlve)))(cons 40 1.5)(cons 50 0)(cons 72 1)(cons 1 (rtos slc 2 0))(cons 7 (getvar "TEXTSTYLE"))(cons 8 "Clayer")(cons 62 256))) 


(repeat 9
(setq diemve (polar diemve (/ pi 2) (* 0.1 tlve)))
(entmake (list (cons 0 "LINE")(cons 10 diemve)(cons 11 (polar diemve pi (* 0.05 tlve)))(cons 8 "Clayer")(cons 62 256)(cons 6 "bylayer")(cons 48 1) )) 
)

(setq slc (+ slc 1))
)

(entmake (list (cons 0 "LINE")(cons 10 diemdau)(cons 11 diemve)(cons 8 "Clayer")(cons 62 256)(cons 6 "bylayer")(cons 48 1) )) 
(Princ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 


<<

Filename: 429071_ttl.lsp
Tác giả: nguyenbakien
Bài viết gốc: 15657
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)

 

Bác Hoành chỉ giúp em cách sử dụng cái này đi .

em thay nó cũng hay nhưng ko biết sử dụng nó


<<

Filename: 15657_m2c.lsp
Tác giả: zizpo_hetxang
Bài viết gốc: 154519
Tên lệnh: xbd
Lisp cắt, xoay Bình đồ

Hề hề hề,

Trước hết cám ơn bạn đã dùng lisp do mình viết.

Thứ nữa là việc còn lại một số đối tượng...

>>

Hề hề hề,

Trước hết cám ơn bạn đã dùng lisp do mình viết.

Thứ nữa là việc còn lại một số đối tượng không xoay như bản vẽ bạn post là do các polyline của bạn khá phức tạp. Nó có thể có nhiều giao điểm với đường cắt chứ không phải chỉ có một giao điểm. Do vậy mình đã không xét tới trường hợp này. Để mình xét thêm rồi nếu được sẽ bổ sung sau.

Bạn cần lưu ý thêm với vái lisp của mình là khi lisp yêu cầu bạn Chon điểm tiếp theo thì bạn cứ việc chọn liên tục sao cho cái polyline mà bạn thấy nó tạo ra bao kín hoặc cắt qua các đối tượng bạn cần xoay. Khi bạn không chọn nữa nó sẽ tự động khép kín lại. Tất cả các đối tượng nằm trong hoặc trên polyline này sẽ được chọn với điều kiện toàn bộ vùng chọn đều thấy được trên màn hình.

Một lần nữa cám ơn phản hồi của bạn.

 

Đây là lisp mình đã bổ sung để đảm bảo cắt sạch các polyline. Bạn dùng thử xem sao nhé. Mình đả thử với bản vẽ 111_2 bạn gửi thì thấy ngon lành. Các trường hợp khác mong bạn test thêm.


(defun c:xbd (/ p0 pn en en0 en1 ssl ssp en2 en3 pc p p1 p2 pk plst  pls ssq gq ans)
(vl-load-com)
(command "undo" "be")
(setq p0 (getpoint "\n Chon diem dau duong cat ")
       pn (getpoint p0 "\n Chon diem cuoi duong cat "))
(command "line" p0 pn "")
(setq en0 (entlast)
        ssl (ssget "X" (list (cons 0 "*LINE"))))
(ve0 ssl)
(setq ssp (acet-ss-to-list (ssget "F" (list p0 pn) (list (cons 0 "*LINE")))))
(foreach en2 ssp
        (setq pls (acet-geom-intersectwith en0 en2 0))
        (setq en en2)
        (if pls
            (foreach pc pls
                 (command "break" en  pc "@")
                 (setq en (entlast))
            )
        )
)
(setq p (getpoint p0 "\n Chon phia can xoay"))
(command "offset" "1" en0 p "")
(setq en1 (entlast)
       p1 (cdr (assoc 10 (entget en1)))
       pk (cdr (assoc 11 (entget en1)))
)
(setq plst (list))
(setq plst (append (list p1) plst))
(command "pline" 
   (while p1        
       (setq p2 (getpoint p1 "\n Chon diem tiep theo"))
       (if  p2
            (progn
                   (setq plst (append (list p2) plst))
                   (command p1 p2)
                   (setq  p1 p2)
            )
            (progn
                  (setq plst (append (list pk) plst))
                  (command p1 pk )
                  (setq p1 nil)
            )
       )
   )
)
(setq en3 (entlast))
(setq ssq (ssget "CP" plst))
(setq ans (getstring "\n Chon tam quay < A or B >: "))
(setq gq (getreal "\n Nhap goc quay theo do: "))
(command "copy" en0 "" p0 p0)
(if (= (strcase ans) "A")
   (command "rotate" ssq (entlast) "" p0 gq)
   (command "rotate" ssq (entlast) "" pn gq)
)
(command "erase" en1 en3 "")
(command "undo" "e")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ve0 (ss)
 (defun suadinhPl(thongtin / index doituong doituongmoi toado)
   (setq
     doituong (assoc '38 thongtin)      
     doituongmoi (cons 38 0.)
   )
   (subst doituongmoi doituong thongtin)
 )
 (defun suadinh (thongtin / index doituong doituongmoi toado)
   (setq thongtinmoi nil)
   (foreach doituong thongtin
     (if (and (>= (car doituong) 10)
       (<= (car doituong) 36) 
  )
(setq doituongmoi
       (list (car doituong)
	     (cadr doituong)
	     (caddr doituong)
	     0.0
       )
)
(setq doituongmoi doituong)
     )
     (setq thongtinmoi (append thongtinmoi (list doituongmoi)))
   )
   (setq thongtinmoi thongtinmoi)
 )
 (defun tendoituong (ssdt /)
   (cdr (assoc '0 (entget ssdt)))
 )
 ;;---------------------------------------------
 (setq	tapdoituong ss
                 ;;;;; (ssget)
sodt	    (sslength tapdoituong)
index	    0
ta	    (chr 8)
stxoa	    (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta)
stxuly	    "Xu ly duoc: "
ptcu	    nil
 )
 (repeat sodt
   (setq
     ssdt  (ssname tapdoituong index)
     pt    (* (/ (* index 1.0) sodt) 100.0)
     index (1+ index)
   )
   (if	(/= pt ptcu)
     (progn
(princ (strcat stxoa stxuly (rtos pt 2 0) "%"))
(setq ptcu pt)
     )
   )    
   (if	(or (= (tendoituong ssdt) "SPLINE")
    (= (tendoituong ssdt) "LINE")	    
    (= (tendoituong ssdt) "CIRCLE")
    (= (tendoituong ssdt) "ARC")
    (= (tendoituong ssdt) "POLYLINE")
    (= (tendoituong ssdt) "ELLIPSE")
    (= (tendoituong ssdt) "TEXT")
    (= (tendoituong ssdt) "DIMENSION")
           (= (tendoituong ssdt) "ATTDEF")
    (= (tendoituong ssdt) "SOLID")
    (= (tendoituong ssdt) "INSERT")
    (= (tendoituong ssdt) "ATTRIB")
    (= (tendoituong ssdt) "HATCH")
)
     (progn
(setq thongtin (entget ssdt)
      thongtin (suadinh thongtin)
)
(entmod thongtin)
     )
   )
   (if (= (tendoituong ssdt) "LWPOLYLINE")
     (progn
       (setq thongtin (entget ssdt)
      thongtin (suadinhPL thongtin)	      
)
(entmod thongtin)
     )
   )
   (princ)
 )
)

 

Hy vọng bạn vừa ý. Chú ý khi chọn điểm tạo polyline sao cho phù hợp với ý bạn nhé.

bác phamthanhbinh ơi. lần này thì quá tuyệt rồi bác ơi. em không còn ý kiến gì nữa.Chỉ có thể nói là chân thành cảm ơn bác. Xin chúc bác sức khoẻ và mọi người trên diễn đàn như ý


<<

Filename: 154519_xbd.lsp
Tác giả: dinhdainhan
Bài viết gốc: 234607
Tên lệnh: trb
Lisp trải bóng( trải không đều)

 

Lisp của bạn có phải có chức năng tương đương thế này không ??

Code chưa dùng entmake nên có thể bị chậm xíu xíu

>>

 

Lisp của bạn có phải có chức năng tương đương thế này không ??

Code chưa dùng entmake nên có thể bị chậm xíu xíu

(defun c:trb(/ p1 p11 p2 p22 n1 x1 x2 dis1 dis2 i oldOs oldCmd)
(grtext -1 "@S\U+01A1n T\U+00F9ng - ketxu - Cadviet")
(if (= n nil)(setq n 10))
(setq p1 (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m 1") 
p2 (getpoint p1 "\nCh\U+1ECDn \U+0111i\U+1EC3m 2") 
p11 (getpoint  "\nCh\U+1ECDn \U+0111i\U+1EC3m 3") 
p22 (getpoint p11 "\nCh\U+1ECDn \U+0111i\U+1EC3m 4") i 0
n1 (getint (strcat "\nS\U+1ED1 kho\U+1ea3ng chia < " (rtos n 2 0) " > : "))
	dis1 (distance p1 p11)
	dis2 (distance p2 p22)
)
(if n1 (setq n n1))
(setq
x1 (/ dis1  (/ (* n (+ n 1)) 2))
x2 (/ dis2  (/ (* n (+ n 1)) 2))
oldOs (getvar "osmode")
oldCmd (getvar "cmdecho"))

(setvar "osmode" 0)
(setvar "cmdecho" 0)
(repeat n
	(command ".Line" (setq p1 (polar p1 (angle p1 p11) (+ x1 (* i x1)))) (setq p2(polar p2 (angle p2 p22) (+ x2 (* i x2)))) "")
	(setq i (1+ i))
)
(setvar "osmode" oldOs)
(setvar "cmdecho" oldCmd)
)

P/s : tại sao lại phải để alert liên tục gây khó chịu cho người dùng như vậy bạn nhỉ ?

   Có thể sửa giúp minh được không ?

   Sao cho khoảng cách line sau gấp đôi line trước

Ví dụ như:

Khoang cách line 1 đến line 2 là : 1

Khoang cách line 2 đến line 3 là : 2

Khoang cách line 3 đến line 4 là : 4

Khoang cách line 4 đến line 5 là : 8

.....................................................

Mình thấy như vậy mới đẹp


<<

Filename: 234607_trb.lsp

Trang 275/330

275