lanvientkh
-
Số lượng nội dung
60 -
Đã tham gia
-
Lần ghé thăm cuối
Bài đăng được đăng bởi lanvientkh
-
-
Vào lúc 22/8/2010 tại 21:55, Tue_NV đã nói:Lisp này hay quá có cách nào chọn thêm được đối tượng là "LINE", kết quả trả về chia 1000 về đơn vị là hệ "MÉT", lệnh có thể nhớ các thông số đã nhập và dùng liên tục chỉ kết thúc khi nhấn ENTER hay khoảng cách, cảm ơn cả nhà.
-
Vào lúc 11/3/2017 tại 11:26, quocmanh04tt đã nói:Xem bài này có phù hợp không! http://www.cadviet.com/forum/topic/156702-xin-lisp-copy-tang-giam-theo-do-doc/?do=findComment&comment=390985
Link này mất rồi bạn ơi
-
Dear bạn Nhất, Lisp bạn rất hay nhưng không chèn được các block phụ kiện nước như hình bên dưới, mình có sưu tầm được Lisp này nhưng phụ kiện tạo ra không phải block mà là poline (cũng tạm xài được). Nhưng phụ kiện tạo ra hơi lớn và lisp cũng hay bị lỗi tạo ra các fitting không đúng như hình mong muốn, mình không rành lisp lắm nhờ bạn hỗ trợ cách chỉnh to nhỏ phụ kiện này được không, cảm bạn ơn nhé.
(defun c:test ( / DrawRect line1 line2 len width fuzz line1Start line1End line2Start line2End intersPt line1Ang line2Ang p1 p2 p3 p4 sel regions lastEnt ctr ctr2 ss lines)
(defun DrawRect (lst)
(entmake (append (list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length lst))
(cons 70 1))
(mapcar (function (lambda (p) (cons 10 p))) lst)))
);defun(prompt "\nSelect lines: ")
(if (setq ss (ssget '((0 . "LINE"))))
(progn(command "_.undo" "_begin")
(setq len 80)
(setq width 20)
(setq fuzz 0.01)
(setq sel (ssadd) regions (ssadd))(setq ctr 0)
(repeat (sslength ss)
(setq line1 (ssname ss ctr))
(setq ctr2 0)
(repeat (sslength ss)
(setq line2 (ssname ss ctr2))(setq line1Start (cdr (assoc 10 (entget line1))))
(setq line1End (cdr (assoc 11 (entget line1))))
(setq line2Start (cdr (assoc 10 (entget line2))))
(setq line2End (cdr (assoc 11 (entget line2))));If the 2 lines intersect
(if (and (/= line1 line2) (setq intersPt (inters line1Start line1End line2Start line2End)))
(progn(setq line1Ang (angle line1Start line1End))
(setq line2Ang (angle line2Start line2End))
(setq lines (cons (list (list line1Start line1End line1Ang line1) (list line2Start line2End line2Ang line2) intersPt) lines))
))
(setq ctr2 (1+ ctr2))
)
(setq ctr (1+ ctr))
)(mapcar '(lambda (linePair)
(setq line1 (car linePair))
(setq line2 (cadr linePair))
(setq line1Start (car line1))
(setq line1End (cadr line1))
(setq line1Ang (caddr line1))
(setq line2Start (car line2))
(setq line2End (cadr line2))
(setq line2Ang (caddr line2))
(setq intersPt (caddr linePair))(mapcar '(lambda (line / lineStart lineEnd lineAng lineEnt)
(setq lineStart (car line) lineEnd (cadr line) lineAng (caddr line) lineEnt (cadddr line))
(cond
;Intersection point is on the start point of the line
((equal intersPt lineStart fuzz)
(setq p1 (polar intersPt (- (- line1Ang (/ pi 2)) (/ (- line1Ang line2Ang) 2)) (/ (/ width 2) (cos (/ (- line1Ang line2Ang) 2)))))
(setq p2 (polar (polar intersPt lineAng len) (- lineAng (/ pi 2)) (/ width 2)))
(setq p3 (polar (polar intersPt lineAng len) (+ lineAng (/ pi 2)) (/ width 2)))
(setq p4 (polar intersPt (- (+ line1Ang (/ pi 2)) (/ (- line1Ang line2Ang) 2)) (/ (/ width 2) (cos (/ (- line1Ang line2Ang) 2)))))
(DrawRect (list p1 p2 p3 p4))
(ssadd (entlast) sel)
(command "break" lineEnt intersPt (polar intersPt lineAng len))
);Intersection point is on the end point of the line
((equal intersPt lineEnd fuzz)
(setq p1 (polar intersPt (- (- line1Ang (/ pi 2)) (/ (- line1Ang line2Ang) 2)) (/ (/ width 2) (cos (/ (- line1Ang line2Ang) 2)))))
(setq p2 (polar (polar intersPt (+ lineAng pi) len) (- lineAng (/ pi 2)) (/ width 2)))
(setq p3 (polar (polar intersPt (+ lineAng pi) len) (+ lineAng (/ pi 2)) (/ width 2)))
(setq p4 (polar intersPt (- (+ line1Ang (/ pi 2)) (/ (- line1Ang line2Ang) 2)) (/ (/ width 2) (cos (/ (- line1Ang line2Ang) 2)))))
(DrawRect (list p1 p2 p3 p4))
(ssadd (entlast) sel)
(command "break" lineEnt intersPt (polar intersPt (+ lineAng pi) len))
);Intersection point is in the middle of the line
(T
(setq p1 (polar (polar intersPt lineAng len) (- lineAng (/ pi 2)) (/ width 2)))
(setq p2 (polar (polar intersPt (+ lineAng pi) len) (- lineAng (/ pi 2)) (/ width 2)))
(setq p3 (polar (polar intersPt (+ lineAng pi) len) (+ lineAng (/ pi 2)) (/ width 2)))
(setq p4 (polar (polar intersPt lineAng len) (+ lineAng (/ pi 2)) (/ width 2)))
(DrawRect (list p1 p2 p3 p4))
(ssadd (entlast) sel)
(command "break" lineEnt (polar intersPt lineAng len) (polar intersPt (+ lineAng pi) len))
)
);cond)
(list line1 line2)
);mapcar)
lines
);mapcar(setq lastEnt (entlast))
(command "region" sel "")
(command "erase" sel "")
(while (setq lastEnt (entnext lastEnt))
(ssadd lastEnt regions))
(command "union" regions "")
(command "_.undo" "_end")));if ss
(princ)
);defun
-
Lisp PRT này không in được A1 A0 phải làm thế nào bạn
-
Lisp này hay quá, có cách nào chiều cao Text mình tự chọn chứ không phải theo Style được không bạn, cảm ơn.
-
1
-
-
Lisp của bạn hay quá, mình chỉ hay dùng về tính chiều dài không tính diện tích vậy làm sao bỏ bớt đi được không bạn, cảm ơn.
-
1
-
-
Mình dùng có thấy nó đổi tên block đâu bạn
-
1
-
-
kkhi đánh lệnh máy hỏi Specifi suffix, không dùng được bạn ơi
-
1
-
-
Lisp hiện nay tọa độ khi xuất ra là trục Y nằm trên trục X nằm dưới có thể chỉnh lại để khi xuất ra trục X nằm trên trục Y nằm dưới theo lệnh của CAD là tuyệt, thanks all bạn nhiều
-
1
-
-
chưa có cao nhân nào giúp mình, buồn quá
-
Chào bạn,
Mình có mong muốn sau:
1. Có thể đếm được tổng số lượng đối tượng
2. Ghi thứ tự từng số đếm của đối tượng để có thể kiểm tra phụ kiện nào bị sót chưa đếm (tạo 1 layer mới số đếm này để dễ quản lý)
3. Có thể lọc đối tượng theo Layer, màu, polyline...
Cảm ơn các bạn.
-
Mình cũng đang tìm mục này, cụ thể như dự án thoát nước của mình phụ kiện Te, Cút, Y thoát thiết kế không vẽ bằng block mà vẽ bằng Polyline và có màu khác nhau, giờ đi đếm phụ kiện thủ công bằng tay cũng hơi đuối, nhờ các bạn hỗ giúp dùm.
-
1
-
-
Quá tốt, thanks bạn nhé
-
5 giờ trước, huunhantvxdts đã nói:-
xy.lsp
-
(defun C:XY( / p1 p2) (setq p1 (getpoint "\nFirst point:") p2 (getpoint p1 "\nNext point:") ) (setvar "dimtad" 1) (command "leader" p1 p2 "a" (strcat "X="(rtos (cadr p1)) "\\P" (strcat "Y="(rtos (car p1)))) "") (while (setq p1 (getpoint "\nFirst point:")) (setq p2 (getpoint p1 "\nNext point:") ) (setvar "dimtad" 1) (command "leader" p1 p2 "a" (strcat "X="(rtos (cadr p1)) "\\P" (strcat "Y="(rtos (car p1)))) "") ) (princ) )
Sửa lại cho bạn nhé
Cảm ơn bạn, nhưng khi dùng báo lỗi, bạn kiểm tra dùm mình với nhé
First point:; error: bad argument type: point
-
-
(defun C:XY( / p1 p2)
(setq
p1 (getpoint "\nFirst point:")
p2 (getpoint p1 "\nNext point:")
)
(setvar "dimtad" 1)
(command "leader" p1 p2 "a" (strcat "X="(rtos (cadr p1)) "\\P" (strcat "Y="(rtos (car p1)))) "")
(princ)
)
Mình muốn thêm dòng lặp và chỉ kết thúc khi enter mà tìm hiểu chưa làm được, bạn hỗ trợ dùm -
cách của bạn rất hay, hiện nay phải đánh lệnh xong mới chọn được đối tượng, có thể thêm tuỳ chỉnh là chọn đối tượng rồi dùng lệnh nữa là tuyệt vời, thanks bạn
-
Lisp bạn viết nó cũng giống như lệnh của Cad rồi, mình muốn khi copy nhiều đối tượng qua bản vẽ mới sẽ cùng toạ độ và nó tạo thành 1 block sẽ dễ quản lý hơn bạn Duong Nhat Duy
-
không ai giúp mình hết buồn quá đi
-
chào các bạn, hiện nay mình hay copy các đối tượng sang bản vẽ khác cùng toạ độ, mình Copy sau đó Paste Original Corrdinate, có lisp nào sau khi paste thế nào nó thành 1 group block được không? Cách copy bắt điểm cũng làm được nhưng làm cách đó tìm điểm sẽ lâu. Cảm ơn mọi người
-
Thấy cái này cũng hay, bạn xài tạm vậy;| DP.LSP JD HENMAN 20090818DP - draws pipe the length of selected lines (centerlines)(use along with pull-down menu for all Std pipe sizes|;(defun c:DP (/ olayer lay_name A B C D E N1 N2 pnt11 pnt12 mssg dist dist2 entity count total); load the vla command set(vl-load-com); accessing the graphic screen as opposed to the text screen(graphscr); remember the current layer(setq olayer (getvar "clayer")); define the layers addressed in the program(command "layer" "m" "Center" "c" "8" "" "lt" "Center2" "" "")(command "layer" "m" "Hidden" "c" "5" "" "lt" "Hidden2" "" "")(command "layer" "m" "Object" "c" "3" "" "lt" "Continuous" "" "")(setvar "clayer" olayer); let user specify OD & ID(setq P-OD (getreal "\n Enter O.D. of Pipe: "))(setq P-ID (getreal "\n Enter I.D. of Pipe: "))(setq P-OD_2 (/ P-OD 2))(setq P-ID_2 (/ P-ID 2))(princ "\nSelect Centerlines to Construct Pipe: ")(setq A (ssget));variable B knows how many objects were found in variable A(setq B (sslength A))(setq C 0); counter; the loop ends when C = B(while (< C B); command line animation to prove computer is working:(defun spinbar (sbar)(cond((= sbar "\\") "|")((= sbar "|") "/")((= sbar "/") "-")(t "\\"));cond);defun(princ (strcat "\rOffsetting Pipe Entities " (setq sbar (spinbar sbar)))); D is assigned the next entity found in the subset(setq D (ssname A C))(setq N2 (entget D)N2 (subst (cons 8 "Center")(assoc 8 N2) N2));setq(entmod N2)(initget (+ 1 2 4 64))(setq odist P-OD_2); distance for offsets(setq idist P-ID_2); distance for offsets; D is the entity but must be considered an object to be offset(setq D (vlax-ename->vla-object D)); D is offset in both directions(vla-offset D idist)(setq entity (entlast)entity (entget entity)entity (subst (cons 8 "Hidden")(assoc 8 entity) entity));setq(entmod entity)(vla-offset D (* idist -1))(setq entity (entlast)entity (entget entity)entity (subst (cons 8 "Hidden")(assoc 8 entity) entity));setq(entmod entity)(vla-offset D odist)(setq entity (entlast)entity (entget entity)entity (subst (cons 8 "Object")(assoc 8 entity) entity));setq(entmod entity)(vla-offset D (* odist -1))(setq entity (entlast)entity (entget entity)entity (subst (cons 8 "Object")(assoc 8 entity) entity));setq(entmod entity)(setq C (1+ C));add one to counter before testing while loop again) ;while(princ));defun DP
-
- Đau lòng quá ^^, bạn tải lại lsp #2 dùng chơi :)
nhoclangbat, lisp này có thể bổ sung thêm tâm ống (đường line ở giũa nét đứt, màu đen) nữa đi bạn
-
Đã fix nhé ^_^
;;Lenh TEST (defun c:test (/ ss n _length pt1 pt2 pt3 pt4 ss1 ) (vl-load-com) (setvar "CMDECHO" 0) (princ "\nChon LINE: ") (if (setq ss (ssget '((0 . "LINE")))) (progn (command "zoom" "ob" ss "") (setq n 0) (repeat (sslength ss) (setq _length (/ (vlax-get (vlax-ename->vla-object (ssname ss n)) 'Length) 1000.)) (setq pt1 (polar (cdr (assoc 10 (entget (ssname ss n)))) (+ (angle (cdr (assoc 10 (entget (ssname ss n)))) (cdr (assoc 11 (entget (ssname ss n)))) ) (/ pi 2) ) 100.) ) (setq pt2 (polar (cdr (assoc 11 (entget (ssname ss n)))) (- (angle (cdr (assoc 10 (entget (ssname ss n)))) (cdr (assoc 11 (entget (ssname ss n)))) ) (/ pi 2) ) 100.) ) (setq pt3 (polar (cdr (assoc 10 (entget (ssname ss n)))) (- (angle (cdr (assoc 10 (entget (ssname ss n)))) (cdr (assoc 11 (entget (ssname ss n)))) ) (/ pi 2) ) 100.) ) (setq pt4 (polar (cdr (assoc 11 (entget (ssname ss n)))) (+ (angle (cdr (assoc 10 (entget (ssname ss n)))) (cdr (assoc 11 (entget (ssname ss n)))) ) (/ pi 2) ) 100.) ) (setq ss1 (ssget "CP" (list pt1 pt4 pt2 pt3) '((0 . "TEXT")))) (if ss1 (if (> (sslength ss1) 1) (progn (princ "\nCo >1 TEXT tai vi tri vung chon xung quanh LINE.") (redraw (ssname ss n) 3) ) (entmod (subst (cons 1 (strcat "L= " (rtos _length 2 1) " m")) (assoc 1 (entget (ssname ss1 0))) (entget (ssname ss1 0))) ) ) ) (setq n (1+ n)) );repeat );progn (princ "\nBan da khong chon LINE.") );if (command "zoom" "P") (princ) )lisp quá tốt, thanks bạn hí
-
Lisp mới đây, chỉ cần chọn LINE còn lại lisp làm việc nhé. ^_^ Thay tên lệnh tùy ý.
Chui khắp các topic nhờ vả mà ko thấy ai repply, khổ thân ^_^
;;Lenh TEST (defun c:test (/ ss n _length pt1 ss1) (setvar "CMDECHO" 0) (princ "\nChon *LINE: ") (if (setq ss (ssget '((0 . "*LINE")))) (progn (command "zoom" "ob" ss "") (setq n 0) (repeat (sslength ss) (setq _length (/ (vlax-get (vlax-ename->vla-object (ssname ss n)) 'Length) 1000.)) (setq pt1 (polar (cdr (assoc 10 (entget (ssname ss n)))) (/ pi 2) 100.)) (setq ss1 (ssget "C" pt1 (cdr (assoc 11 (entget (ssname ss n)))) '((0 . "TEXT")))) (if ss1 (entmod (subst (cons 1 (strcat "L= " (rtos _length 2 1) " m")) (assoc 1 (entget (ssname ss1 0))) (entget (ssname ss1 0))) ) ) (setq n (1+ n)) );repeat );progn (princ "\nBan da khong chon LINE.") );if (command "zoom" "P") (princ) )Hi bạn,
nếu đường thẳng nằm dọc hay nằm ngiêng lisp ko tính được, mình gửi bản vẽ đính kèm nhờ bạn xem với nhé, thanks
https://drive.google.com/open?id=0B1TsLvqrTXByZkhva1RYZUZJUFk
-
1
-
-
Lisp mới đây, chỉ cần chọn LINE còn lại lisp làm việc nhé. ^_^ Thay tên lệnh tùy ý.
Chui khắp các topic nhờ vả mà ko thấy ai repply, khổ thân ^_^
;;Lenh TEST (defun c:test (/ ss n _length pt1 ss1) (setvar "CMDECHO" 0) (princ "\nChon *LINE: ") (if (setq ss (ssget '((0 . "*LINE")))) (progn (command "zoom" "ob" ss "") (setq n 0) (repeat (sslength ss) (setq _length (/ (vlax-get (vlax-ename->vla-object (ssname ss n)) 'Length) 1000.)) (setq pt1 (polar (cdr (assoc 10 (entget (ssname ss n)))) (/ pi 2) 100.)) (setq ss1 (ssget "C" pt1 (cdr (assoc 11 (entget (ssname ss n)))) '((0 . "TEXT")))) (if ss1 (entmod (subst (cons 1 (strcat "L= " (rtos _length 2 1) " m")) (assoc 1 (entget (ssname ss1 0))) (entget (ssname ss1 0))) ) ) (setq n (1+ n)) );repeat );progn (princ "\nBan da khong chon LINE.") );if (command "zoom" "P") (princ) )Dear bạn, lisp này cad 2013 sử dụng được, ko sử dụng được cho cad 2007 vậy bạn, nó báo select object: 1 found
Sáng đầu tuần mà có tin vui của bạn rồi, cảm ơn bạn nhé, đầu tuần vui vẽ, hihi
Xin Lisp Copy Tăng Giảm Theo Độ Dốc
trong Sử dụng AutoCAD
Đã đăng · Trả lời báo cáo
Thanks bạn Mạnh, lisp của bạn rất hay, nhưng thường thì hạ tầng hay ghi là 2.50 (m) ít ghi 2500 (mm), nhờ bạn sửa thêm được không, cảm ơn bạn