trieubb
-
Số lượng nội dung
93 -
Đã tham gia
-
Lần ghé thăm cuối
-
Ngày trúng
3
Bài đăng được đăng bởi trieubb
-
-
Vào lúc 9/8/2025 tại 09:12, TrungTNR đã nói:(defun c:JJM ( / ss tol rows i ent obj insX insY text rowsGrouped
doc spc baseHeight insPt row rowlist line newMText)
(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
spc (if (or (eq acModelSpace (vla-get-ActiveSpace doc))
(eq :vlax-true (vla-get-MSpace doc)))
(vla-get-ModelSpace doc)
(vla-get-PaperSpace doc)))(setq tol 0.5) ;; Dung sai theo Y d? nh?n cùng hàng
(if (setq ss (ssget "_:L" '((0 . "*TEXT"))))
(progn
;; Gom MText theo hàng (theo Y)
(setq rowsGrouped '()
i 0)
(repeat (sslength ss)
(setq ent (ssname ss i)
i (1+ i))
(if ent
(progn
(setq obj (vlax-ename->vla-object ent)
insX (car (vlax-get obj 'InsertionPoint))
insY (cadr (vlax-get obj 'InsertionPoint))
text (vla-get-TextString obj))
;; Tìm hàng g?n insY
(setq found nil)
(foreach row rowsGrouped
(if (< (abs (- insY (car row))) tol)
(progn
(setq rowsGrouped
(subst (cons (car row)
(append (cdr row)
(list (list insX text ent obj))))
row
rowsGrouped))
(setq found T))))
(if (not found)
(setq rowsGrouped
(append rowsGrouped
(list (cons insY (list (list insX text ent obj)))))))))
);; S?p x?p các hàng theo Y gi?m d?n
(setq rowsGrouped (vl-sort rowsGrouped '(lambda (a b) (> (car a) (car b)))));; L?y chi?u cao theo MText d?u tiên
(setq firstRow (car rowsGrouped))
(setq firstMText (car (vl-sort (cdr firstRow) '(lambda(a b) (< (car a) (car b))))))
(setq baseHeight (vla-get-Height (cadddr firstMText)));; Kho?ng cách gi?a các hàng m?i (1.5 l?n chi?u cao)
(setq rowSpacing (* 1.5 baseHeight));; Ch?n di?m d?t g?c
(setq insPt (getpoint "\nSpecify insert point: "))
(if insPt
(progn
(setq currentPt insPt)
;; X? lý t?ng hàng
(foreach row rowsGrouped
;; s?p x?p hàng theo X tang d?n
(setq rowlist (vl-sort (cdr row) '(lambda(a b) (< (car a) (car b)))))
;; N?i n?i dung b?ng " - "
(setq line (apply 'strcat (mapcar '(lambda(x) (strcat (cadr x) " - ")) rowlist)))
(setq line (vl-string-left-trim " " (vl-string-right-trim "- " line)));; T?o MText cho t?ng hàng
(setq newMText (vla-AddMText spc (vlax-3d-point currentPt) 0.0 line))
(vla-put-AttachmentPoint newMText acAttachmentPointTopLeft)
(vla-put-Height newMText baseHeight);; D?i di?m Y xu?ng cho hàng ti?p theo
(setq currentPt (list (car currentPt) (- (cadr currentPt) rowSpacing) (caddr currentPt)))
)
)
)
)
)(princ)
)
Mong anh chỉ giáo sửa giúp em lệnh này ghép text theo chiều dọc ạ.
đây bạn
(defun c:T130 ( / mode ss tol groups i ent obj insX insY text doc spc
baseHeight insPt currentPt sortedGroup groupList line newMText)
(vl-load-com)
;; Lấy document và không gian làm việc
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
spc (if (or (eq acModelSpace (vla-get-ActiveSpace doc))
(eq :vlax-true (vla-get-MSpace doc)))
(vla-get-ModelSpace doc)
(vla-get-PaperSpace doc)));; Chọn chế độ gom
(initget "H C")
(setq mode (getkword "\nChọn chế độ gom [Hàng/Cột] <H>: "))
(if (not mode) (setq mode "H")) ;; mặc định gom hàng(setq tol 0.5) ;; Dung sai theo trục so sánh
;; Chọn TEXT/MTEXT
(if (setq ss (ssget "_:L" '((0 . "*TEXT"))))
(progn
(setq groups '()
i 0)
;; Gom nhóm
(repeat (sslength ss)
(setq ent (ssname ss i)
i (1+ i))
(if ent
(progn
(setq obj (vlax-ename->vla-object ent)
insX (car (vlax-get obj 'InsertionPoint))
insY (cadr (vlax-get obj 'InsertionPoint))
text (vla-get-TextString obj))
(setq found nil)
(foreach grp groups
(if (if (= mode "H")
(< (abs (- insY (car grp))) tol) ;; so sánh Y cho hàng
(< (abs (- insX (car grp))) tol) ;; so sánh X cho cột
)
(progn
(setq groups
(subst (cons (car grp)
(append (cdr grp)
(list (list (if (= mode "H") insX insY)
text ent obj))))
grp
groups))
(setq found T))))
(if (not found)
(setq groups
(append groups
(list (cons (if (= mode "H") insY insX)
(list (list (if (= mode "H") insX insY)
text ent obj))))))))
)
);; Sắp xếp nhóm
(setq groups (vl-sort groups
(if (= mode "H")
'(lambda (a b) (> (car a) (car b))) ;; hàng: Y giảm
'(lambda (a b) (< (car a) (car b))) ;; cột: X tăng
)));; Lấy chiều cao chuẩn
(setq firstGroup (car groups))
(setq firstText (car (vl-sort (cdr firstGroup)
(if (= mode "H")
'(lambda(a b) (< (car a) (car b))) ;; hàng: X tăng
'(lambda(a b) (> (car a) (car b))) ;; cột: Y giảm
))))
(setq baseHeight (vla-get-Height (cadddr firstText)));; Khoảng cách giữa các nhóm
(setq groupSpacing (if (= mode "H")
(* 1.5 baseHeight) ;; hàng: dãn theo Y
(* 4 baseHeight) ;; cột: dãn theo X
));; Chọn điểm chèn
(setq insPt (getpoint "\nChỉ định điểm chèn: "))
(if insPt
(progn
(setq currentPt insPt)
(foreach grp groups
;; Sắp xếp trong nhóm
(setq groupList (vl-sort (cdr grp)
(if (= mode "H")
'(lambda(a b) (< (car a) (car b))) ;; hàng: X tăng
'(lambda(a b) (> (car a) (car b))) ;; cột: Y giảm
)))
;; Nối nội dung
(setq line (if (= mode "H")
(apply 'strcat (mapcar '(lambda(x) (strcat (cadr x) " - ")) groupList))
(apply 'strcat (mapcar '(lambda(x) (strcat (cadr x) "\\P")) groupList))
))
(setq line (vl-string-left-trim " " (vl-string-right-trim (if (= mode "H") "- " "\\P") line)));; Tạo MText
(setq newMText (vla-AddMText spc (vlax-3d-point currentPt) 0.0 line))
(vla-put-AttachmentPoint newMText acAttachmentPointTopLeft)
(vla-put-Height newMText baseHeight);; Dời vị trí
(if (= mode "H")
;; xuống hàng
(setq currentPt (list (car currentPt)
(- (cadr currentPt) groupSpacing)
(caddr currentPt)))
;; sang phải
(setq currentPt (list (+ (car currentPt) groupSpacing)
(cadr currentPt)
(caddr currentPt)))
)
)
)
)
)
)(princ)
)
-
1
-
-
Xin lisp tọa độ
trong AutoLisp
Vào lúc 27/1/2025 tại 12:26, boybdh đã nói:Bạn nào có lisp tọa độ như hình cho mình xịn thảm khảo với
tên lệnh: TOADOTHUADAT:
(defun get-polyline-points (ent / obj name pts i coords vtx pt)
(vl-load-com)
(setq obj (vlax-ename->vla-object ent))
(setq name (vla-get-objectname obj))
(cond
((= name "AcDbPolyline")
(setq coords (vlax-get obj 'Coordinates))
(setq pts '())
(setq i 0)
(while (< i (length coords))
(setq pts (append pts (list (list (nth i coords) (nth (1+ i) coords)))))
(setq i (+ i 2))
)
pts
)
((= name "AcDb2dPolyline")
(setq pts '())
(setq vtx (entnext ent))
(while (and vtx (= (cdr (assoc 0 (entget vtx))) "VERTEX"))
(setq pt (cdr (assoc 10 (entget vtx))))
(setq pts (append pts (list pt)))
(setq vtx (entnext vtx))
)
(if (/= (car pts) (last pts))
(setq pts (append pts (list (car pts))))
)
pts
)
(t nil)
)
)(defun distance2d (p1 p2)
(distance (list (car p1) (cadr p1)) (list (car p2) (cadr p2)))
)(defun c:TOADOTHUADAT ( / ent pts insPt i pt1 pt2 dai txt csvFile fn
rowHeight colW1 colW2 colW3 colW4 yrow xbase ytitle ytitle2 total-rows y-top y-bottom)
(vl-load-com)
(command "._undo" "_begin")
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)(setq rowHeight 5.0
colW1 25.0 colW2 25.0 colW3 25.0 colW4 25.0
)
(setq ent (car (entsel "\nChon polyline khép kín: ")))
(if (null ent)
(progn (princ "\nKhong co doi tuong duoc chon.") (exit))
)
(setq pts (get-polyline-points ent))
(if (null pts)
(progn (princ "\nKhong lay duoc toa do.") (exit))
)
(setq insPt (getpoint "\nChon diem chen bang: "))
(setq xbase (car insPt));; ===== TIÊU ĐỀ BẢNG =====
(setq ytitle (cadr insPt))
(setq ytitle2 (- ytitle rowHeight));; Hàng 1
(command "TEXT" "J" "MC" (list (+ xbase (/ colW1 2.0)) (- ytitle (/ rowHeight 2.0)) ) 2.5 0 "Số hiệu đỉnh thửa")
(command "TEXT" "J" "MC" (list (+ xbase colW1 (/ (+ colW2 colW3) 2.0)) ytitle) 2.5 0 "Tọa độ")
(command "TEXT" "J" "MC" (list (+ xbase colW1 colW2 colW3 (/ colW4 2.0)) (- ytitle (/ rowHeight 2.0)) ) 2.5 0 "Chiều dài (m)");; Hàng 2
(command "TEXT" "J" "MC" (list (+ xbase colW1 (/ colW2 2.0)) ytitle2) 2.5 0 "X")
(command "TEXT" "J" "MC" (list (+ xbase colW1 colW2 (/ colW3 2.0)) ytitle2) 2.5 0 "Y");; Vẽ dòng tiêu đề
(command "LINE"
(list xbase (+ ytitle (/ rowHeight 2.0)) )
(list (+ xbase colW1 colW2 colW3 colW4) (+ ytitle (/ rowHeight 2.0)) ) "")
(command "LINE"
(list xbase (- ytitle2 (/ rowHeight 2.0)) )
(list (+ xbase colW1 colW2 colW3 colW4) (- ytitle2 (/ rowHeight 2.0)) ) "");; Đường ngang ngăn giữa "Tọa độ" và "X/Y"
(command "LINE"
(list (+ xbase colW1) (- ytitle (/ rowHeight 2.0)) )
(list (+ xbase colW1 colW2 colW3) (- ytitle (/ rowHeight 2.0)) ) "");; ===== NỘI DUNG BẢNG =====
(setq i 1)
(foreach pt1 pts
(setq pt2 (if (< i (length pts)) (nth i pts) (car pts)))
(setq dai (distance2d pt1 pt2))
(setq yrow (- ytitle2 (* i rowHeight)));; Ghi giá trị
(command "TEXT" "J" "MC" (list (+ xbase (/ colW1 2.0)) yrow) 2.5 0 (rtos i 2 0))
(command "TEXT" "J" "MC" (list (+ xbase colW1 (/ colW2 2.0)) yrow) 2.5 0 (rtos (cadr pt1) 2 2))
(command "TEXT" "J" "MC" (list (+ xbase colW1 colW2 (/ colW3 2.0)) yrow) 2.5 0 (rtos (car pt1) 2 2))
(command "TEXT" "J" "MC" (list (+ xbase colW1 colW2 colW3 (/ colW4 2.0)) yrow) 2.5 0 (rtos dai 2 2));; Vẽ dòng
(command "LINE"
(list xbase (- yrow (/ rowHeight 2.0)) )
(list (+ xbase colW1 colW2 colW3 colW4) (- yrow (/ rowHeight 2.0)) ) "")
(setq i (+ i 1))
);; Cột dọc toàn bảng
(setq total-rows (+ (length pts) 1))
(setq y-top (+ ytitle (/ rowHeight 2.0)))
(setq y-bottom (- ytitle2 (* total-rows rowHeight) (/ rowHeight 2.0)))(foreach x (list
xbase
(+ xbase colW1)
(+ xbase colW1 colW2 colW3)
(+ xbase colW1 colW2 colW3 colW4))
(command "LINE" (list x y-top) (list x y-bottom) "")
)
(command "LINE" (list (+ xbase colW1 colW2) (- ytitle (/ rowHeight 2.0)) ) (list (+ xbase colW1 colW2) y-bottom) "")(command "TEXT" "J" "MC" (list (+ xbase (/ colW1 2.0)) (+ y-bottom (/ rowHeight 2.0)) ) 2.5 0 (rtos 1 2 0))
(command "LINE" (list xbase y-bottom) (list (+ xbase colW1 colW2 colW3 colW4) y-bottom) "");; ===== XUẤT FILE CSV =====
(setq csvFile (getfiled "Chon noi luu file CSV" "" "csv" 1))
(if csvFile
(progn
(setq fn (open csvFile "w"))
(write-line "STT,X,Y,Dai" fn)
(setq i 1)
(foreach pt1 pts
(setq pt2 (if (< i (length pts)) (nth i pts) (car pts)))
(setq dai (distance2d pt1 pt2))
(write-line (strcat (itoa i) "," (rtos (cadr pt1) 2 4) "," (rtos (car pt1) 2 4) "," (rtos dai 2 4)) fn)
(setq i (+ i 1))
)
(close fn)
(princ (strcat "\nĐã xuất file CSV: " csvFile))
)
)(setvar "osmode" luubatdiem)
(setvar "CMDECHO" cmd)
(command "._undo" "_end")
(princ)
)
-
1
-
-
không thì sửa dòng này:
(command "pedit" "m" ss "" "Y" "j" "0" "")
thành:
(command "pedit" "m" ss "" "j" "0" "")
-
1
-
-
Vào lúc 29/7/2025 tại 13:51, mourison1993 đã nói:Mình có lisp sưu tầm trên mạng và nhờ ChatGPT chỉnh sửa dần cũng được 90% theo ý muốn rồi, còn 1 vấn đề nhỏ là khi rải lý trình trên tuyến thì cọc đầu và cọc cuối không có, mình muốn thêm vào cọc đầu là Km0+000 và cọc cuối sẽ theo chiều dài của đường Polyline, rất mong các bác giúp e chỉnh sửa thêm cho hoàn thiện ạ, e cám ơn!
Nội dung lisp (e không chèn file đính kèm được):
(defun C:RLT()
(RDInput1)
(RDSA)
)(defun C:RDS1()
(RDSA)
)(defun RDSA ()
(setq cmdold (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq osmold (getvar "osmode"))
(setvar "osmode" 0)
(princ) (terpri)(setq sst nil)
(while (= sst nil)
(setq sst (entsel "\nChọn tim tuyến:"))
)(setq RD (+ RD rdi)) ; First Value
(COMMAND "MEASURE" sst "B" rdmB "" mdi)
(COMMAND "MEASURE" sst "B" "RD" "" rdii)
(setq SSET (ssget "P"))(setq COUNT 0)
(while (< COUNT (sslength SSET))
(setq A1 (ssname SSET count))
(setq A2 (entget A1))
(setq A3 (cdr (assoc 0 A2)))
(if (= A3 "INSERT")
(progn
(setq A4 (assoc 10 A2))
(setq A5 (cdr A4))
(command "EXPLODE" a1)
(SETQ X1 (ENTGET(ENTLAST)))
(SETQ X2 (ASSOC 1 X1))
(SETQ X3 (CDR X2))
(SETQ RD5 (RTOS RD 2 0))
(setq RDtxt RD5)
(text1)
(setq B1 RDtext)
(setq B2 (cons 1 B1))
(setq A2 (subst B2 X2 X1))
(entmod A2)
(SETQ RD5 (ATOF RD5))
(SETQ RD (+ RD5 rdi))
)
)
(setq count (+ 1 count))
)
(setvar "cmdecho" cmdold)
(setvar "osmode" osmold)
(terpri)
(princ (strcat " RD = " (rtos rd 2 0))) (terpri)
)(defun text1 (/ abs2 rem1)
(if (and (= (strlen RDtxt) 1) (= RDtxt "0"))
(Progn
(setq RDtxt "0000")
)
(progn
(if (and (> (strlen RDtxt) 1) (<= (strlen RDtxt) 3))
(setq RDtxt (strcat "0" RDtxt))
)
)
)
(setq abs2 (substr RDtxt 1 (- (strlen RDtxt) 3)))
(setq rem1 (substr RDtxt (+ (strlen abs2) 1)))
(setq RDtext (strcat "Km" abs2 "+" rem1))
)(defun c:RDInput ()
(RDInput1)
)(defun c:RD ()
(RD1)
)(defun c:RDI()
(RDI1)
)(defun c:RDM()
(RDM1)
)(defun c:RDMB()
(RDMB1)
)(defun c:SF()
(SF1)
)(defun RDInput1 ()
(SF1) ; Scale Factor
(RD1) ; RD # and block
(RDblk)
(RDI1) ; RD interval
(RDM1) ; RD marker Interval
(RDMB1) ; RD marker block name
)(defun RD1 (/ RD1)
(if (= RD nil) (setq RD 0))
(setq RD1 (getreal (strcat "\nLý trình bắt đầu # [" (rtos RD 2 0) "] :")))
(if (/= RD1 nil) (setq RD RD1))
(princ (strcat "RD = " (rtos rd 2 0))) (terpri)
)(defun RDI1(/ rdiA)
(if (= rdi nil) (setq rdi 100))
(setq rdiA (getreal (strcat "\nNhập khoảng cách điền tên cọc: [" (rtos RDi 2 0) "] :")))
(if (/= rdiA nil) (setq rdi rdiA))
(princ (strcat "RD Intr = " (rtos rdi 2 0))) (terpri)
(setq rdii (* rdi ssf))
)(defun RDM1(/ mdA)
(if (= md nil) (setq md 100))
(setq mdA (getreal (strcat "\nNhập khoảng cách rãi cọc: [" (rtos md 2 0) "] :" )))
(if (/= mdA nil) (setq md mdA))
(if (> md rdi) (setq md rdi))
(princ (strcat "RD marker Dist = " (rtos md 2 0))) (terpri)
(setq mdi (* md ssf))
)(defun RDMB1()
(if (= rdmB nil) (setq rdmB " "))
(setq rdmB (getstring (strcat "\nĐặt tên block cọc: [" rdmB "]:")))
(while (equal rdmB "")
(setq rdmB (getstring (strcat "\nĐặt tên block cọc: [" rdmB "]:")))
)
(princ (strcat "RD marker Blk = " rdmB))
(RDmarker) ; RD marker Block
)(defun SF1(/ ssf1)
(if (= ssf nil) (setq ssf 1.0))
(setq ssf1 (getreal (strcat "\nNhập tỉ lệ rãi: [" (rtos ssf 2 8) "] :")))
(if (/= ssf1 nil) (setq ssf ssf1))
(princ (strcat "Sheet Scale Factor = " (rtos ssf 2 8))) (terpri)
)(defun RDblk(/ sl curlyr osmold list1 yCoord)
(setvar "cmdecho" 0) ; Tắt echo trong command line
(setq osmold (getvar "osmode")) ; Lưu trạng thái hiện tại của osmode
(setvar "osmode" 0) ; Tắt chế độ chọn đối tượng mặc định; Yêu cầu người dùng nhập chiều cao của block
(setq height (getreal "\nNhập chiều cao chữ: ")) ; Yêu cầu nhập chiều cao; Yêu cầu người dùng nhập giá trị tọa độ Y cho block
(setq yCoord (getreal "\nNhập khoảng cách cọc so với tim: [mặc định: -25]:"))
(if (null yCoord) (setq yCoord -25)) ; Nếu người dùng không nhập gì, mặc định tọa độ là -25; Kiểm tra xem block "RD" đã tồn tại hay chưa
(if (equal (tblsearch "block" "RD") nil) (progn
(command "zoom" "e") ; Phóng to toàn bộ bản vẽ
(command "style" "ghc" "Arial" "0.0" "1.0" "0" "N" "N") ; Cài đặt kiểu chữ
(command "color" "green") ; Đặt màu sắc cho văn bản
(command "TEXT" "S" "ghc" "J" "ML" "0,0" height "90" "Km0+000") ; Vẽ văn bản Km0+000
(setq list1 (list (cons 0 "TEXT")(cons 1 "Km0+000"))) ; Tạo đối tượng văn bản
(setq sl (ssget "l" list1)) ; Lấy danh sách đối tượng văn bản
; Tạo block "RD" tại tọa độ (0, yCoord)
(command "block" "RD" (strcat "0," (rtos yCoord 2 0)) sl "")
)); Khôi phục trạng thái cũ của osmode
(setvar "osmode" osmold)
; Phóng to lại phạm vi ban đầu
(command "zoom" "p")
)(defun RDmarker(/ sl1 osmold list1)
(setvar "cmdecho" 0)
(setq osmold (getvar "osmode"))
(setvar "osmode" 0); Kiểm tra xem block RD Marker có tồn tại chưa
(if (equal (tblsearch "block" rdmB) nil) (progn
(command "zoom" "e")
(command "color" "bylayer")
(command "line" "0,-1" "0,1" "") ; Vẽ đường thẳng từ (0,-1) đến (0,1)
(setq list1 (list (cons 0 "LINE") (cons 10 (list 0.0 -1.0 0.0)) (cons 11 (list 0.0 1.0 0.0))))
(setq sl1 (ssget "l" list1))
(command "block" rdmB "0,0" sl1 "")
))(setvar "osmode" osmold)
(command "zoom" "p")
)
thêm đoạn này:
(defun my-angle (p1 p2)
(atan (- (cadr p2) (cadr p1)) (- (car p2) (car p1)))
)(defun AddStartEndRDMarker (curveobj ssf yOffset / startpt endpt length RDtxt RDtext ent elist RD5 tangent angle offsetPt)
;; ======= CỌC ĐẦU =======
(setq startpt (vlax-curve-getStartPoint curveobj))
(setq tangent (vlax-curve-getFirstDeriv curveobj 0.0))
(if (and tangent startpt)
(progn
(setq angle (my-angle '(0.0 0.0) (list (car tangent) (cadr tangent))))
(setq angle-deg (* angle (/ 180.0 pi)))
(setq angle (+ angle-deg (/ pi 2))) ; lệch 90 độ
(command "_.insert" rdmB "R" angle startpt "" "")
(command "_.insert" "RD" "R" angle startpt "" "")
(setq RDtxt "0000") ; Lý trình K0+000
(text1)
(command "EXPLODE" (entlast))
(setq ent (entlast))
(setq elist (entget ent))
(setq elist (subst (cons 1 RDtext) (assoc 1 elist) elist))
(entmod elist)
)
);; ======= CỌC CUỐI =======
(setq endpt (vlax-curve-getEndPoint curveobj))
(setq tangent (vlax-curve-getFirstDeriv curveobj (vlax-curve-getEndParam curveobj)))
(if (and tangent endpt)
(progn
(setq angle (my-angle '(0.0 0.0) (list (car tangent) (cadr tangent))))
(setq angle-deg (* angle (/ 180.0 pi)))
(setq angle (+ angle-deg (/ pi 2))) ; lệch 90 độ
(command "_.insert" rdmB "R" angle endpt "" "")
(setq length (* (vlax-curve-getDistAtParam curveobj (vlax-curve-getEndParam curveobj)) ssf))
(setq RD5 (rtos length 2 0)) ; Làm tròn số nguyên
(setq RDtxt RD5)
(text1)
(command "_.insert" "RD" "R" angle endpt "" "")
(command "EXPLODE" (entlast))
(setq ent (entlast))
(setq elist (entget ent))
(setq elist (subst (cons 1 RDtext) (assoc 1 elist) elist))
(entmod elist)
)
)
)và thêm 2 dòng này:
(setq curveobj (vlax-ename->vla-object (car sst)))
(AddStartEndRDMarker curveobj ssf yCoord)vào sau đoạn này
(while (= sst nil)
(setq sst (entsel "\nChọn tim tuyến:"))
) -
Vào lúc 30/3/2025 tại 21:15, nguyenhong3868 đã nói:Em đang có các tờ bản đồ địa chính File Autocad, trên bản đồ có rất nhiều thửa đất được vẽ bằng Line
Nhiệm vụ của em là : Bo từng thửa đất để tạo thành thửa khép kín bằng đường Polyline ở 1 Level hiện tại và màu Level hiện tại đóNếu sử dụng lệnh Bo từng thửa 1 thì mất rất nhiều thời gian và có khi còn bị sót không kiểm soát được
>>> EM CÓ TÌM THẤY 1 LISP TRÊN DIỄN ĐÀNTRONG LISP NAY tác giả đang viết Hatch và TÔ MÀU cho từng thửa và từng vùng một
Em không biết gì về viết code Lisp. Em nhờ các cao nhân giúp em sửa lại Lisp trên thành Lisp :- Tên lệnh : taovungthua
- Lisp chỉ tạo đường BO cho từng thửa riêng lẻ (KHÔNG BO CHO CẢ MỘT VÙNG RỘNG LỚN)
- KHÔNG TÔ MÀU CHO THỬA
- Làm sao để chạy nhanh hơn vì em thấy Lisp trên nếu quét một vùng nhiều thửa thấy chạy chậm lắm ạ
* HOẶC CÓ CÁCH NÀO XỬ LÝ TRÊN FILE CAD ĐƯỢC KHÔNG Ạ
Rất mong được các cao nhân giúp đỡ ạ. Em xin cảm ơn rất nhiều
đây bạn, xem dùng được không
-
1
-
-
41 phút trước, amateurday đã nói:đúng rồi bạn, vì cái này chỉ dùng ghi dốc taluy thôi.
Đây bạn
-
1
-
-
Vào lúc 6/4/2022 tại 04:41, letuan0601 đã nói:Em chào các a ạ. Em có vấn đề này nhờ các a giúp. Em có cao độ 1 điểm gốc rồi giờ biết cao độ điểm thứ 2. E muốn vẽ 1 đường xline hoặc pline đi qua điểm thứ 2 mà chỉ cần nhập cao độ của điểm thứ 2. Mong các a giúp đỡ ạ. Em xin cảm ơn!
Bạn nói chung chung khó hình dung, hãy đưa hình ảnh mô tả để trực quan dễ hiểu hơn. Vẽ gì thì vẽ ít cũng qua 2 điểm, mà là điểm đủ x,y,z chứ có mỗi cái cao độ bảo vẽ đường thì ai vẽ được bạn.
-
Vào lúc 24/4/2022 tại 23:27, duc hoang đã nói:các anh cho em lisp cắt thép mà từ 1 đường thẳng cắt ra từng đoạn nhỏ mà có mối nối như này được không ạ, em có tìm trên diễn đàn nhưng lisp đó không dùng được ạ, em cảm ơn mọi người
p/s: ảnh em xin phép mượn của bác chủ topic trong bài đó ạ
Đây bạn, không biết đúng ý không
-
Vào lúc 16/5/2022 tại 14:23, hatrongquan88 đã nói:Em đã tìm trên diễn đàn nhưng chưa có lisp nào tương tự hoặc em chưa tìm thấy, Nay em xin nhờ các anh trên diễn đàn viết giúp em 1 lisp nối 2 polyline kín thành 1 polyline kín và xóa đường gốc (Layer polyline kín mới theo layer hiện hành). Em xin trân trọng cảm ơn!
đây bạn
-
Vào lúc 19/7/2022 tại 14:49, Thanh TV đã nói:Em có tìm trên web một lisp tìm text cùng giá trị (text value bằng nhau) trên bản vẽ, nhưng phải chọn từng text mẫu rồi chọn vùng chứa text cần tìm.
Mong muốn mọi người chỉnh sửa, cải tiến thêm nội dung để phục vụ công việc được tốt hơn, cụ thể như sau:B1: Nhập lệnh
B2: Chọn một hoặc nhóm text mẫu (ví dụ: text mẫu hoặc nhóm text mẫu có giá trị text valua lần lượt là 17, 18, 19)
B3: Chọn vùng text cần tìm theo text mẫu đã chọn
B4: Hiện kết quả tìm được. (hiện tất cả các text có giá trị text valua lần lượt là 17, 18, 19)
Cảm ơn!
Lisp hiện có như sau:
TIM TEXT CUNG GIA TRI
(defun C:jk( / i txt ent)
(setq i 1 txt (cdr (assoc 1 (entget (car (entsel "\nChon Text mau: "))))))
(while (setq ent (car (entsel (strcat "\nChon Text mau " (itoa i) ": "))))
(setq txt (strcat txt "," (cdr (assoc 1 (entget ent)))))
(setq i (1+ i)))
(princ "\nChon nhom Text...")
(setq ss (ssget (list '(0 . "*TEXT") (cons 1 txt))))
(sssetfirst nil ss))đây bạn
-
Vào lúc 25/10/2024 tại 10:01, hunghong250906 đã nói:Xin chào!
Mình cần 1 lisp xuất dữ liệu từ Cad sang Excel như sau:- File cad chỉ gồm Text thể hiện cao độ, Text có thể là MText, DT, dấu thập phân có thể là "," hoặc "."
- Mình muốn xuất ra file Excel hoặc Txt gồm 3 cột thông tin là X, Y, Z trong đó Z bằng luôn giá trị của Text đang thể hiện..
Cảm ơn các bạn rất nhiều.
đây bạn
-
Nhờ các bác giúp đỡ
trong AutoLisp
Vào lúc 29/9/2024 tại 15:11, quangluc đã nói:Trong cad e có các điểm cao độ text, e muốn nhờ các bác giúp e viết 1 lisp có thế quét các điểm text đó để lấy các thông tin tọa độ xyz (ở mục Geometry) và giá trị của text (value) xuất ra fiel excel ạ. E xin cảm ơn các bác. E có siêu tầm một lisp gần giống như vậy nhưng là phải bo kín vùng chọn và nó thiếu mất cao độ z, mong các bác sửa giúp ạ
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/69746-nho-viet-lisp-loc-cac-doi-tuong-la-text-trong-mot-vung-kin-xuat-ra-excel/
;========LISP OUTPUT TEXT BEN TRONG PLINE==========
;=============KANGKUNG 28/03/2013==================
(defun C:KK()
(setq plst (acet-geom-vertex-list (car (entsel "\n Select pline:\n"))))
(setq plst1 (vl-sort plst '(lambda (e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2))))))
(setq X_min(car (nth 0 plst1))
X_max(car (last plst1)))
(setq plst2 (vl-sort plst '(lambda (e1 e2) (if (/= (cadr e1) (cadr e2)) (< (cadr e1) (cadr e2)) (< (car e1) (car e2))))))
(setq Y_min(cadr (nth 0 plst2))
Y_max(cadr (last plst2)))
(command "ZOOM" (list X_min Y_min) (list X_max Y_max))
(setq taphop (ssget "CP" plst '((0 . "TEXT"))))
(if (not Path) (setq Path(getvar "dwgprefix")))
(setq file(getfiled "Output File" Path "csv" 11) Path file)
(setq file_out(open file "W"))
(setq index 0)
(while (< index (sslength taphop))
(setq TEXT (entget (ssname taphop index)))
(if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
(setq InsertPoint(cdr(assoc 10 TEXT)))
(setq InsertPoint(cdr(assoc 11 TEXT))))
(setq String(cdr(assoc 1 TEXT)))
(write-line (strcat (rtos (+ index 1) 2 0) "," (rtos (car InsertPoint) 2 3) "," (rtos (cadr InsertPoint) 2 3) "," String) file_out)
(setq index (+ index 1))
)
(close file_out)
(alert "Well done!")
)
(princ "\n Written By KangKung - 28/03/2013\n")
(princ "\n Nhap KK de chay chuong trinh\n")đây bạn
-
Vào lúc 19/8/2024 tại 16:24, vanthuong160483 đã nói:E có cái lisp xuất tọa độ thửa đất mà nó ra kết quả 3 số thập phân.
E nhờ các anh chị giúp e viết lại sao cho có thêm tùy chọn (có thể chọn ra 2 hoặc ra 3) để chọn cho ra kết quả là 2 hoặc 3 chữ số thập phân với ạ.
và sửa lại cái tên bảng theo mẫu này với ạ
E xin cảm ơn và mời cafe ạ
mẫu đâu, file lisp đâu, nói thế ai mà giúp được
-
Vào lúc 3/7/2025 tại 23:00, amateurday đã nói:Tớ vẫn đang ghi dốc thủ công. Nếu mà chọn polyline rồi tự động hết các đoạn dốc thì cũng nhanh hơn.
tức là khi chọn polyline thì cứ có độ dốc các đoạn thì ghi í hả, độ dốc bằng 0 thì thôi?
-
Vào lúc 10/12/2024 tại 09:05, HAUUUUU đã nói:Dạ các anh trong group có ai có lisp theo yêu cầu như thế này không ạ, nếu có share cho em với nhé
Em có các Text và Mtext " Ví dụ số 12 và số 13 có cùng điểm Pick point em muốn 1 lisp khi quét chọn các đối tượng thì các đối tượng Text hoặc Mtext mà có điểm Pick Ponit trùng nhau thì sẽ được chọn
Nâng cao hơn xíu thì có thể nhập thêm hệ số dung sai giữa 2 điểm Pick point để chọn đổi tượng trùng lập được không ạ
Em cảm ơn
đây bạn
-
Vào lúc 23/12/2024 tại 17:18, NgọcH đã nói:Chào các bác, mong các bác giúp e lisp xóa đối tượng giữa 2 vùng kín (chỉ xóa ko trim). E có tìm trên diễn đàn thì chỉ thấy xóa đối tượng trong hoặc ngoài vùng kín. Nhờ các bác giúp e vấn đề này ạ. E cảm ơn rất nhiều. Các đối tượng giữa 2 vùng kín có thể là block,... e muốn xóa hết ạ
đây bạn
-
Vào lúc 20/1/2025 tại 13:47, ThuanNguyen79 đã nói:Nhờ viết Lisp ghi độ dốc mái taluy theo tỉ lệ: 1/n. Cảm ơn ạ!
không thể hiểu được ý đồ như nào, bạn cần mô tả thêm hoặc minh họa bằng hình ảnh, file cad....chứ
-
Vào lúc 10/3/2025 tại 11:29, jimmyc.nguyen đã nói:Chào các bạn,
Mình đang cần Lisp tính tổng chiều dài, diện tích ( Như hình đính kèm ) mà có Leader chỉ vào đối tượng đã chọn, để dễ hình dung và kiểm tra. Vậy nên mình nhờ các bạn thạo lisp viết giúp mình.
Cám ơn các bạn ạ.
Đây bạn
-
Vào lúc 28/5/2025 tại 12:19, Vietdvv đã nói:Lisp này của mình đang bị lỗi khi chèn bảng. Các cao thủ giúp mình hoàn thiện lisp này với ạ. Mình cám ơn
đây bạn
-
Vào lúc 13/6/2025 tại 08:59, thanhduan2407 đã nói:Bạn tham khảo nhé!
(defun c:00 () (command "undo" "be") (setq cmd (getvar "cmdecho")) (setvar "cmdecho" 1) (setq vl_ltren0 "2.0" vl_lduoi0 "2.0" vl_ltrc0 "2.0" vl_lsau0 "2.0" ) (setq dcl_code (list (strcat "vehinhchunhat : dialog { label = \"&Ve hinh chu nhat\";" " : boxed_radio_column { label = \"Chon loai\"; key = \"hcn\";" " : radio_button { label = \"&1-Hinh chu nhat lech TREN\"; key = \"tren\";}" " : radio_button { label = \"&2-Hinh chu nhat lech TRAI\"; key = \"trai\";}}" " : row {" " : column {" " : edit_box { label = \"Chieu dai canh duoi (m)\"; edit_width = 5; key = \"lduoi\";}" " : edit_box { label = \"Chieu dai canh tren (m)\"; edit_width = 5; key = \"ltren\";}" " : edit_box { label = \"Chieu dai canh truoc (m)\"; edit_width = 5; key = \"ltruoc\";}" " : edit_box { label = \"Chieu dai canh sau (m)\"; edit_width = 5; key = \"lsau\";}}" " }" " ok_cancel;}" ) ) ) (setq temp (vl-filename-mktemp "vehinhchunhat.dcl") file_dcl (open temp "W") ) (foreach l dcl_code (write-line l file_dcl)) (close file_dcl) (setq dcl_id (load_dialog temp)) (vl-file-delete temp) (new_dialog "vehinhchunhat" dcl_id) (if (not rad_lech) (setq rad_lech "tren") ) (set_tile rad_lech "1") (action_tile "tren" "(mapcar 'mode_tile '(\"lduoi\" \"ltren\" \"ltruoc\" \"lsau\" ) '(0 1 0 0)) (setq rad_lech $key) " ) (action_tile "trai" "(mapcar 'mode_tile '(\"lduoi\" \"ltren\" \"ltruoc\" \"lsau\" ) '(0 0 1 0)) (setq rad_lech $key) " ) (if (not vl_ltren) (setq vl_ltren vl_ltren0) ) (set_tile "ltren" vl_ltren) (if (not vl_lduoi) (setq vl_lduoi vl_lduoi0) ) (set_tile "lduoi" vl_lduoi) (if (not vl_ltrc) (setq vl_ltrc vl_ltrc0) ) (set_tile "ltruoc" vl_ltrc) (if (not vl_lsau) (setq vl_lsau vl_lsau0) ) (set_tile "lsau" vl_lsau) (action_tile "accept" "(if (= rad_lech \"tren\") (progn (setq vl_tren (get_tile \"lduoi\")) (setq vl_lduoi (get_tile \"lduoi\")) (setq vl_ltrc (get_tile \"ltruoc\")) (setq vl_lsau (get_tile \"lsau\")) ;(hinhchunhatlechtren lduoi ltren ltrc lsau) ) (progn (setq vl_ltren (get_tile \"ltren\")) (setq vl_lduoi (get_tile \"lduoi\")) (setq vl_ltrc (get_tile \"ltruoc\")) (setq vl_lsau (get_tile \"lsau\")) ;(hinhchunhatlechtrai lduoi ltren ltrc lsau) )) (done_dialog)" ) (action_tile "cancel" "(done_dialog) (exit)") (start_dialog) (unload_dialog dcl_id) (command "style" "vntime.shx" "vntime.shx" "0" "0.75" "0" "n" "n" "n") (command "style" "vntimeh.shx" "vntimeh.shx" "0" "0.75" "0" "n" "n" "n") ;tao lop kich thuoc (if (tblsearch "dimstyle" "D25") (command "_dimstyle" "r" "D25") (progn (command "DIMSCALE" 0) (command "DIMDLE" 0.15 "DIMDLI" 0.2 "DIMEXE" 0.15 "DIMEXO" 0 "DIMBLK1" "Oblique" "DIMBLK2" "Oblique" "DIMLDRBLK" "Oblique" "DIMASZ" 0.1 "DIMSAH" "ON" "DIMCEN" 0.1 "DIMTAD" 1 "DIMJUST" 0) (command "DIMTXSTY" "vntime.shx" "DIMCLRT" 7 "DIMGAP" 0.05 "DIMDEC" 0 "DIMTOH" "OFF" "DIMTIH" "OFF" "DIMTIX" "ON" "DIMTXT" 0.25 "DIMFXLON" "On" "DIMFXL" 0.2 "DIMTMOVE" 2 "DIMTOFL" "On" "DIMLFAC" 25) (command "-dimstyle" "s" "D25") ) ) (if (tblsearch "dimstyle" "D100") (command "_dimstyle" "r" "D100") (progn (command "DIMSCALE" 0) (command "DIMDLE" 0.15 "DIMDLI" 0.2 "DIMEXE" 0.15 "DIMEXO" 0 "DIMBLK1" "Oblique" "DIMBLK2" "Oblique" "DIMLDRBLK" "Oblique" "DIMASZ" 0.1 "DIMSAH" "ON" "DIMCEN" 0.1 "DIMTAD" 1 "DIMJUST" 0) (command "DIMTXSTY" "vntime.shx" "DIMCLRT" 7 "DIMGAP" 0.05 "DIMDEC" 0 "DIMTOH" "OFF" "DIMTIH" "OFF" "DIMTIX" "ON" "DIMTXT" 0.25 "DIMFXLON" "On" "DIMFXL" 0.2 "DIMTMOVE" 2 "DIMTOFL" "On" "DIMLFAC" 100) (command "-dimstyle" "s" "D100") ) ) (setvar "cmdecho" cmd) (command "undo" "end") (princ) )cảm ơn bạn nhiều nhưng các action hinhchunhatlechtren không hoạt động, và đây là lệnh có 2 loại lệch trên và lệch trái, ví dụ có nhiều loại thì sửa như nào bạn có thể hướng dẫn giúp mình được không
-
Vào lúc 12/6/2025 tại 20:08, conghoa đã nói:@trieubb Bạn thử dùng lisp này xem được không.
Chia pline theo giao diem - Plintav1.lsp
ps: Nguồn trên mạng
thanksssss
-
5 giờ trước, NTHAHT đã nói:Đúng vậy bác! Vấn đề ở đây là phải tính toán lại và mới giá trị Bulge.
Mình thử tham gia 1 lisp: https://drive.google.com/file/d/1WNbovt7Eh-nGYz9FrzgrJGyKyZEke_8e/view?usp=sharing
thanks bạn nhưng bạn có thể chia sẻ file. lsp cho mình được không? xin cảm ơn
-
uh thế nếu bạn rảnh thì bạn giúp mình với nhé, thanksssss
-
Nhờ mọi người sửa lisp vẽ hình chữ nhật bằng DCL này làm sao để chiều dài các cạch lưu lại các lần mình đã nhập từ lần nhập trước đó. Trân trọng cảm ơn!
-
1
-
kính nhờ quý anh chị hổ trợ viết lispcad đơn giản
trong AutoLisp
Đã đăng · Trả lời báo cáo
cái 1 thì đơn giản:
(defun c: tên lệnh ()
(vl-cmdf "_.layer" "s" "tên layer muốn quy định hiện hành" "" )
(vl-cmdf "_.line" pause "" )
)
Còn cái 2 thì chưa hiểu ý chủ thớt. có thể tải ảnh minh họa trước và sau khi dùng lệnh đc không