study_forever
-
Số lượng nội dung
22 -
Đã tham gia
-
Lần ghé thăm cuối
Bài đăng được đăng bởi study_forever
-
-
Nếu có thể anh Tuệ có thể giúp em viết cái lisp để copy những đối tượng mà copy sót (như với move sót ấy ạ), em xin cảm ơn anh :DBác Tuệ đã giúp thì giúp cho trót trét, giúp cả cái lisp "để copy những đối tượng mà copy sót" và giúp luôn cái lisp "để stretch những đối tượng mà stretch sót" nữa. Xin vô cùng cảm ơn bác :tongue2:
-
Có 1 đường line dài L (chưa biết), em muốn stretch đường line để chiều dài còn là 100 thì làm cách nào nhanh nhất ạ? Chẳng lẽ cứ phải đo chiều dài L cả đường line rồi lấy L-100 à, thế thì mất thời gian quá nhỉ? Có bác nào có cách nhanh hơn không ạ :tongue2:
-
Các bác mách giúp em cách đưa tọa độ (0,0) về gốc tọa độ với? Tại sao của em tọa độ (0,0) nó lại nằm cách gốc tọa độ 1 khoảng khá xa vậy???
-
Có lẽ phương án tối ưu nằm ở đây :(Kết hợp MA và Fi)
Command: ma MATCHPROP -> gõ MA
Select source object: -> Chọn source object
Current active settings: Color Layer Ltype Ltscale Lineweight Thickness
PlotStyle Text Dim Hatch Polyline Viewport
Select destination object(s) or [settings]: 'fi -> gõ 'Fi
Applying filter to selection.
>>Select objects: >>Specify opposite corner: 17 found
2 were filtered out.
>>Select objects: -> hộp thoại filter hiện ra và thực hiện lọc Text
Exiting filtered selection.
Resuming MATCHPROP command.
Select destination object(s) or [settings]: -> Chọn các đối tượng -> CAD sẽ lọc các đối tượng Text đích và Thay đổi thuộc tính giống Text nguồn
Mong bạn hiểu và làm được
Bác nói đúng, em đã tìm được phương án tối ưu! :bigsmile:
-
Chào 'study_forever'Đây là Lisp MSOT -> Move các đối tượng còn sót lại (chưa MOVE cùng với đối tượng trước đó)
Tue_NV bổ sung vào Lisp nhé :
1. Lệnh M : move các đối tượng của bản vẽ : giống lệnh M (Move) của CAD như 2 giọt nước
2. Lệnh UM (Unmove) : đưa các đối tượng Move nhầm về vị trí cũ
3 . Lệnh MSOT : Move các đối tượng còn sót lại (chưa MOVE cùng với đối tượng trước đó)
Các bạn hãy sử dụng thử và cho mình biết ý kiến nhé :
(defun c:m() (setq ss (ssget)) (command "line" '(0 0 0) '(1 1 1) "") (setq ss (ssadd (entlast) ss)) (command "move" ss "") (while (< 0 (getvar "CMDACTIVE")) (command pause)) (setq dc (cdr(assoc 10 (entget (entlast))))) (setq ss (ssdel (entlast) ss)) (entdel (entlast)) (setq kc (distance '(0 0 0) dc)) (setq ang (angle dc '(0 0 0) )) (princ) ) ; (defun c:um(/ ssg po lis) (prompt "\n Chon doi tuong Move nham :") (setq ssg (ssget) i 0 j 0) (while (< i (sslength ss)) (setq lis (append lis (list (ssname ss i)))) (setq i (1+ i)) ) (while (< j (sslength ssg)) (if (/= (member (ssname ssg j) lis) nil) (progn (setq ss (ssdel (ssname ssg j) ss)) (setq po (polar '(0 0 0) ang kc)) (setq ssg (ssadd (ssname ssg j) ssg)) ) (princ "\n Doi tuong chon khong phai Move nham") ) (setq j (1+ j)) ) (command "move" ssg "" '(0 0 0) po) (princ) ) ; (defun c:msot(/ ssg po lis) (prompt "\n Chon doi tuong Move sot :") (setq ssg (ssget) i 0 j 0) (while (< i (sslength ss)) (setq lis (append lis (list (ssname ss i)))) (setq i (1+ i)) ) (while (< j (sslength ssg)) (if (= (member (ssname ssg j) lis) nil) (progn (setq po (polar '(0 0 0) (+ pi ang) kc)) (setq ssg (ssadd (ssname ssg j) ssg)) ) (princ "\n Doi tuong chon da Move roi") ) (setq j (1+ j)) ) (command "move" ssg "" '(0 0 0) po) (princ) )
@study : Với yêu cầu 2 thì Tue_NV yêu cầu bạn post bài đúng chổ. Đây là bài viết về Move chứ không phải bài viết về copy. Mong bạn hiểu. Bạn post đoạn code trên ở chổ nào thì trả về đúng chổ cũ của nó. Mình sẽ trả lời bạn nếu bạn post bài đúng chổ. Bạn đồng ý chứ?
Hãy edit lại bài viết trên của bạn và trả về vị trí của nó
Cảm ơn bác đã giúp đỡ em về cái lisp trên, lisp dùng rất tốt!
Về vấn đề bác nói ở trên em xin trình bày là, hôm trước em đã tìm kiếm rất nhiều trên diễn đàn nhưng ko thấy cái Topic cũ của bác, chỉ còn cái lisp là em đã lưu trong máy thôi. Hôm nay nghe bác góp ý em đã cố gắng liên hệ với thằng bạn em có bài trong Topic cũ đó, nó phải giở mục lịch sử bài viết của nó ra mới thấy được cái Topic này, vì thế em đã gửi yêu cầu trong bài viết ở đó, đồng thời xin phép được bỏ phần yêu cầu ở bài viết trên. Em xin cảm ơn.
-
Lần sau bạn đừng làm như vậy nữa nhé. Nút tick Thanks ở dưới mỗi bài viết là lời cảm ơn đồng thời là lời thông cảm chân tình nhất đấy CUONG à.Code sau Tue_NV mày mò mãi mới hoàn thành xong. Sướng cả người được. Cảm giác thật khó tả.
Lệnh là cpp. Hy vọng chạy Code xong bạn sẽ hài lòng.
(defun c:cpp( / ss frome toe cur obj po1 po2) (setvar "grips" 0) (Command "undo" "be") (setq frome (entlast));; chon doi tuong cuoi cung truoc khi Copy (Prompt "\nChon doi tuong :") (setq obj (ssget)) (sssetfirst obj obj) (setq po1 (getpoint "\n Base point : ")) (setq po2 (getpoint po1 "\n Specify second point of displacement : ")) (Command "Copy" "p" "" po1 po2) (setq toe (entlast));; chon doi tuong cuoi cung sau khi Copy (setq cur frome; khoi tao ss (ssadd) ) (while (not (eq cur toe));; chon cac doi tuong tu frome den toe (setq cur (entnext cur) ss (ssadd cur ss) ) ) (sssetfirst ss ss);; highlight ket qua (setq po1 po2) (while (setq po2 (getpoint po1 "\n Specify second point of displacement : ")) (setq frome (entlast)) (Command "Copy" ss "" po1 po2) (setq toe (entlast)) (setq cur frome; khoi tao ss (ssadd) ) (while (not (eq cur toe));; chon cac doi tuong tu frome den toe (setq cur (entnext cur) ss (ssadd cur ss) ) ) (setq po1 po2) (sssetfirst ss ss);; highlight ket qua ) (setvar "grips" 1) (Command "undo" "end") (princ) )
Chúc thành công nhé. :bigsmile:
Chào bác Tuệ!
Bác có thể sửa lại để lisp có thể hoàn thiện hơn nữa ko: lệnh CPP có thể giống hệt với lệnh COPY trong Cad, và khi muốn gọi đối tượng vừa mới COPY thì vẫn dùng tham số P như trên, và khi Move hay Copy đối tượng mới đó thì cũng giống như là dùng Move với Copy trong cad, chứ không nó lại không hiện lên hình ảnh của đối tượng khi chuẩn bị đặt, bác giúp em nhé cảm ơn bác rất nhiều :bigsmile:
-
Chào bạn thiep và hai1401Tue_NV có ý như thế này :
1. Trong ACAD bạn đặt lệnh tắt của lệnh Move là M (trong file acad.pgp) -> Nay mình xây dựng lệnh M của Lisp có tính năng giống y như lệnh MOVE của CAD (lần này thì giống lệnh MOVE của CAD y như 2 giọt nước đấy bạn Hai1401 à)
-> Như vậy bạn sử dụng lệnh M (để MOVE) nhé
2. Tue_NV xây dựng lại Lisp UM (unmove) -> có chức năng đưa đối tượng về vị trí cũ sau khi move
Lisp này xây dựng dựa trên cơ sở là : khi ta move thì tên (ename) của Entity không đổi (nội dung về điểm chèn thay đổi nhưng tên (ename) thì không đổi trước và sau khi Move -> dựa vào đặc điểm này ta có thể UM (unmove) đối tượng làm nhiều lần trên ý tưởng của Tue_NV :
Tức là ta UM (unmove cho đến khi nào) mà số phần tử trong tập hợp chọn SS2 bằng 0 thì không thể UM được nữa -> Cái này theo đúng như ý của User. Hơn nữa, khi Un (unmove) các đối tượng không bị move nhầm thì các đối tượng này không có tác dụng gì cả (theo đúng ý của user luôn) :bigsmile:
Các bạn hãy thử Code này và cho biết ý kiến nhé :
(defun c:m() (setq ss (ssget)) (command "line" '(0 0 0) '(1 1 1) "") (setq ss (ssadd (entlast) ss)) (command "move" ss "") (while (< 0 (getvar "CMDACTIVE")) (command pause)) (setq dc (cdr(assoc 10 (entget (entlast))))) (setq ss (ssdel (entlast) ss)) (entdel (entlast)) (setq kc (distance '(0 0 0) dc)) (setq ang (angle dc '(0 0 0) )) (princ) ) ; (defun c:um(/ ssg po lis) (prompt "\n Chon doi tuong Move nham :") (setq ssg (ssget) i 0 j 0) (while (< i (sslength ss)) (setq lis (append lis (list (ssname ss i)))) (setq i (1+ i)) ) (while (< j (sslength ssg)) (if (/= (member (ssname ssg j) lis) nil) (progn (setq ss (ssdel (ssname ssg j) ss)) (setq po (polar '(0 0 0) ang kc)) (setq ssg (ssadd (ssname ssg j) ssg)) ) (princ "\n Doi tuong chon khong phai Move nham") ) (setq j (1+ j)) ) (command "move" ssg "" '(0 0 0) po) (princ) )
Bác Tuệ có thể thừa thắng xông lên bằng cách xem giúp qua cho em 2 yêu cầu nho nhỏ sau đây mà em nghĩ là sẽ tương đồng với cái lisp mà bác đã viết ko ạ, em vô cùng cảm ơn:
- Lisp có nội dung như sau: Sau khi di chuyển rất nhiều đối tượng bằng 1 lệnh MOVE ta lại thấy sót vài đối tượng chưa MOVE cùng, nếu lại nhặt vài đối tượng đó để MOVE tiếp thì rất có thể bản vẽ sẽ không còn được như ban đầu. Lisp này có chức năng MOVE các đối tượng còn sót đó theo phương, hướng và khoảng cách như đã MOVE các đối tượng trước (để bản vẽ không bị thay đổi bất cứ 1 thứ j)
- Bác Tuệ đã chính tay viết cái lisp để có thể làm việc với các đối tượng được COPY SAU CÙNG.
(defun c:cc( / ss frome toe cur obj po1 po2) (setvar "grips" 0) (Command "undo" "be") (setq frome (entlast));; chon doi tuong cuoi cung truoc khi Copy (Prompt "\nChon doi tuong :") (setq obj (ssget)) (sssetfirst obj obj) (setq po1 (getpoint "\n Base point : ")) (setq po2 (getpoint po1 "\n Specify second point of displacement : ")) (Command "Copy" "p" "" po1 po2) (setq toe (entlast));; chon doi tuong cuoi cung sau khi Copy (setq cur frome; khoi tao ss (ssadd) ) (while (not (eq cur toe));; chon cac doi tuong tu frome den toe (setq cur (entnext cur) ss (ssadd cur ss) ) ) (sssetfirst ss ss);; highlight ket qua (setq po1 po2) (while (setq po2 (getpoint po1 "\n Specify second point of displacement : ")) (setq frome (entlast)) (Command "Copy" ss "" po1 po2) (setq toe (entlast)) (setq cur frome; khoi tao ss (ssadd) ) (while (not (eq cur toe));; chon cac doi tuong tu frome den toe (setq cur (entnext cur) ss (ssadd cur ss) ) ) (setq po1 po2) (sssetfirst ss ss);; highlight ket qua ) (setvar "grips" 1) (Command "undo" "end") (princ) )
Tuy nhiên em thấy lisp này có lệnh COPY bác tự đặt ra có nhiều đặc điểm giống với cái lệnh MOVE mà bác Hai_1401 đã nói ở trên: "tuy nhiên khi em dùng lệnh này thì thấy 1 điều, đó là với lệnh Move của cad, sau khi mình chọn bắt điểm (BASE POINT) và trong lúc chờ điểm đặt (SECOND POINT) thì tại con trỏ sẽ hiện lên ảnh của các đối tượng mình vừa chọn, tuy nhiên khi em dùng lệnh MNH trong lisp trên thì hoàn toàn ko thấy". Do đó, bác Tuệ có thế viết lại giùm em đoạn CODE để có thể biến lệnh COPY trong lisp giống y như lệnh COPY trong Cad ko ạ?
Xin cảm ơn các bác :bigsmile:
-
-bạn có thể ẩn toàn bộ LINE và CIRCLE đi ( layoff) còn lại là cá đối tượng text sau đó rồi MA CHÚNG-HAY layiso các đói tượng TEXT sau đó MA.THÂN :bigsmile:
Thanks, nhưng em vẫn chờ đợi 1 phương án tối ưu hơn :bigsmile:
-
Giao diện màn hình cad của mình bao giờ mình cũng để cái hộp thoại properties cố định vào cạnh trái của màn hình. nó cung cấp tất cả các thông tin về đối tượng hay nhóm đối tượng mà trong quá trình vẽ ta chọn chúng. Việc chỉnh sửa số liệu của đối tượng cũng dễ dàng và nhanh chóng. Mình khuyễn bạn nên tập sử dụng hộp thoại này.Cái bảng Properties thì em cũng biết, tuy nhiên ý em là thế này ạ: Open 1 bản vẽ lên, mình làm sao có thể kiểm tra sơ qua để xem có đối tượng nào để chế độ 3D (có Z khác 0) không, chẳng lẽ 1 bản vẽ hàng ngàn đối tượng bị lẫn có 1 cái có Z khác 0 thì ta cứ mò mẫm xem cái nào à? Hay bác có cách nào kiểm tra thì bảo giúp em cái. thanks :bigsmile:
-
Em có 1 số đối tượng TEXT lẫn trong nhiều đối tượng Line hay Circle, em muốn MA các TEXT trong đó thì làm thế nào nhờ các bác chỉ giúp? Sau khi em lọc được Text trong đám hổ lốn đó bằng lệnh FI thì chịu, ko biết cách nào MA đám Text đấy được :bigsmile:
-
Có 2 lisp đều có mục đích đưa tọa độ Z của các đối tượng trong bản vẽ về 0, em xin hỏi sự khác nhau giữa 2 lisp này là như thế nào ạ?
SIron: Superiron
SuperFlatten: SF
Cái thứ nữa em xin hỏi làm thế nào để mình phát hiện ra trong 1 bản vẽ có đối tượng nào đó có Z khác 0?
Nhờ các bác thông thạo chỉ giúp :bigsmile:
-
Bạn thử dùng lisp cutdim này xem có bị lỗi không. Mình đã sửa một chút code của nó.http://www.cadviet.com/upfiles/CUTDIM_4.lsp
Hy vọng ngon lành :bigsmile:
Nhờ bác Nataca chỉnh nốt lisp căn hàng lisp thẳng nhau (lệnh BD) để cho nó cũng dùng được cho các Dim có Z khác 0 (giống như lisp CD trên bác viết ấy), cảm ơn bác rất nhiều@
(DEFUN C:BD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR) (SETQ CMD (GETVAR "CMDECHO")) (SETQ OSM (GETVAR "OSMODE")) (SETQ OLDERR *error* *error* myerror) (PRINC "Please select dimension object!") (SETQ SS (SSGET)) (SETVAR "CMDECHO" 0) (SETQ PT (GETPOINT "Point to trim or extend:")) (SETQ PT (TRANS PT 1 0)) (COMMAND "UCS" "W") (SETQ LTH (SSLENGTH SS)) (SETQ DEM 0) (WHILE (< DEM LTH) (PROGN (SETQ DS (ENTGET (SSNAME SS DEM))) (SETQ KDL (CDR (ASSOC 0 DS))) (IF (= "DIMENSION" KDL) (PROGN (SETQ PT13 (CDR (ASSOC 13 DS))) (SETQ PT14 (CDR (ASSOC 14 DS))) (SETQ PT10 (CDR (ASSOC 10 DS))) (SETQ PT11 (CDR (ASSOC 11 DS))) (SETQ N70 (CDR (ASSOC 70 DS))) (IF (OR (= N70 0) (= N70 32) (= N70 33) (= N70 160) (= N70 161)) (PROGN (SETQ GOCY (ANGLE PT10 PT14)) (SETQ GOCX (+ GOCY (/ PI 2))) ) ) (SETVAR "OSMODE" 0) (SETQ PTI (POLAR PT GOCX 2)) (SETQ PT10I (POLAR PT10 GOCY 2)) (SETQ PT10N (INTERS PT PTI PT10 PT10I NIL)) (SETQ KC (DISTANCE PT10 PT10N)) (SETQ O10 (ASSOC 10 DS)) (SETQ N10 (CONS 10 PT10N)) (SETQ DS (SUBST N10 O10 DS)) (SETQ PT11N (POLAR PT11 (ANGLE PT10 PT10N) KC)) (SETQ O11 (ASSOC 11 DS)) (SETQ N11 (CONS 11 PT11N)) (SETQ DS (SUBST N11 O11 DS)) (ENTMOD DS) ) ) (SETQ DEM (+ DEM 1)) ) ) (COMMAND "UCS" "P") (SETVAR "CMDECHO" CMD) (SETVAR "OSMODE" OSM) (setq *error* OLDERR) (PRINC) ) -
Chào Hai_1401, đây là lisp thay cho lệnh extrim, vừa cắt xóa 1 bên đối tượng giao với 1 đường thẳng, lại vừa xóa hết các đối tượng ở 1 bên của đường thẳng chặn;; ERCLINE.LSP free lisp from cadviet.com ;; copyright by Thiep,09/2009 ;;;-------------------------- (defun line (Model p1 p2) (vla-Addline Model (vlax-3d-point p1) (vlax-3d-point p2) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun DXF (code en) (cdr (assoc code (entget en)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun CalcZ (Pt1 Pt2 Pt3 / v w) (setq v (mapcar '- Pt1 Pt2) w (mapcar '- Pt3 Pt2)) (- (* (car v) (cadr w)) (* (cadr v) (car w))) ) ;;;----------------------- (defun SS-enlst (ss / c L) (setq c -1) (repeat (sslength ss) (setq L (cons (ssname ss (setq c (1+ c))) L)) ) (reverse L) ) ;;;-----------------------MAIN LISP---------------------------- (vl-load-com) (defun c:er2l (/ encur enobjL objL objLW1 tmp LenssBR ss1 ss2 regn ll ur ul lr oc1 oc2 oc3 oc4 c1 c2 c3 c4 ps pe p2 enXL enc1 enc2 enc3 enc4 ssER LenssER ) (princ "\nFree lisp from www.cadviet.com") (acet-error-init (list (list "cmdecho" 0 "highlight" 0 "regenmode" 1 "osmode" 0 "ucsicon" 0 "offsetdist" 0 "attreq" 0 "plinewid" 0 "plinetype" 1 "gridmode" 0 "celtype" "CONTINUOUS" "ucsfollow" 0 "limcheck" 0 ) T ;;;flag. True means use undo for error clean up. ' (if redraw_it (redraw na 4) ) ) ) ;;;acet-error-init ;;;-------------------- (command "undo" "be") (setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object)) *Model* (vla-get-ModelSpace ActDoc) ) (setvar "osmode" 0) (setvar "pdmode" 0) (setq ss1 (ssadd)) ;; get objects to break (prompt "\nBreak objects touching selected objects.") (if (and (not (prompt "\nSelect object(s) to break & press enter: ")) (setq encur (ssname (ssget '((0 . "LINE"))) 0)) (mapcar '(lambda (x) (ssadd x ss1)) (gettouching encur)) ) (break_with ss1 encur) ) ;;;====================================== (redraw encur 3) (setq objL (vlax-ename->vla-object encur) ps (vlax-curve-getstartpoint objL) pe (vlax-curve-getendpoint objL) Xs (car ps) Ys (cadr ps) Xe (car pe) Ye (cadr pe) ) (setq p2 (getpoint "pick a point side:")) (setq ll (getvar "extmin") ur (getvar "extmax") lr (list (car ur) (cadr ll) 0.0) ul (list (car ll) (cadr ur) 0.0) ll (list (car ll) (cadr ll) 0.0) ur (list (car ur) (cadr ur) 0.0) ) (setq regn (CalcZ ps p2 pe)) (if (< regn 0) (setq flag -0.1) (setq flag 0.1) ) (setq objLW1 (car (vlax-safearray->list (vlax-variant-value (vla-offset objL flag)) ) ) enobjL (vlax-vla-object->ename objLW1) ) (setq LenssBR (gettouching enobjL)) (mapcar 'entdel LenssBR) ;;;------------------------- (vla-put-visible objL :vlax-false) (setq enc1 (vlax-vla-object->ename (line *Model* ll ul)) enc2 (vlax-vla-object->ename (line *Model* ul ur)) enc3 (vlax-vla-object->ename (line *Model* ur lr)) enc4 (vlax-vla-object->ename (line *Model* lr ll)) c1 (car (acet-geom-intersectwith enc1 enobjL 2)) c2 (car (acet-geom-intersectwith enc2 enobjL 2)) c3 (car (acet-geom-intersectwith enc3 enobjL 2)) c4 (car (acet-geom-intersectwith enc4 enobjL 2)) ) (mapcar 'entdel (list enobjL enc1 enc2 enc3 enc4) ) (cond ((and c1 c2 (< Xs Xe)) (if (< regn 0) (setq lstfen (list c2 ur lr ll c1)) (setq lstfen (list c1 ul c2)) ) ) ((and c1 c2 (> Xs Xe)) (if (< regn 0) (setq lstfen (list c1 ul c2)) (setq lstfen (list c2 ur lr ll c1)) ) ) ((and c1 c3 (< Xs Xe)) (if (< regn 0) (setq lstfen (list c1 c3 lr ll)) (setq lstfen (list c1 c3 ur ul)) ) ) ((and c1 c3 (> Xs Xe)) (if (< regn 0) (setq lstfen (list c1 c3 ur ul)) (setq lstfen (list c1 c3 lr ll)) ) ) ((and c1 c4 (< Xs Xe)) (if (< regn 0) (setq lstfen (list c1 c4 ll)) (setq lstfen (list c1 ul ur lr c4)) ) ) ((and c1 c4 (> Xs Xe)) (if (< regn 0) (setq lstfen (list c1 ul ur lr c4)) (setq lstfen (list c1 c4 ll)) ) ) ((and c2 c3 (< Xs Xe)) (if (< regn 0) (setq lstfen (list c2 c3 lr ll ul)) (setq lstfen (list c2 c3 ur)) ) ) ((and c2 c3 (> Xs Xe)) (if (< regn 0) (setq lstfen (list c2 c3 ur)) (setq lstfen (list c2 c3 lr ll ul)) ) ) ((and c2 c4 (< Ys Ye)) (if (< regn 0) (setq lstfen (list c2 ur lr c4)) (setq lstfen (list c2 c4 ll ul)) ) ) ((and c2 c4 (> Ys Ye)) (if (< regn 0) (setq lstfen (list c2 c4 ll ul)) (setq lstfen (list c2 ur lr c4)) ) ) ((and c3 c4 (< Xs Xe)) (if (< regn 0) (setq lstfen (list c3 lr c4)) (setq lstfen (list c4 ll ul ur c3)) ) ) ((and c3 c4 (> Xs Xe)) (if (< regn 0) (setq lstfen (list c4 ll ul ur c3)) (setq lstfen (list c3 lr c4)) ) ) ); end cond (setq ssER (ssget "CP" lstfen)) (if ssER (progn (setq LenssER (SS-enlst ssER)) (if (member encur LenssER) (setq LenssER (SS-enlst (ssdel encur ssER))) ) (vla-put-visible objL :vlax-false) (mapcar 'entdel LenssER) ) ) (vla-put-visible objL :vlax-true) (vlax-invoke-method ActDoc 'Regen acActiveViewport) ; regen (command "undo" "end") (acet-error-restore) (setvar "pdmode" 35) (princ) (princ "\nChuc cac ban may man va thanh cong - Thiep 0918841230" ) (princ) ) ;;;==================================================================== (defun break_with (ss2brk enL / lst masterlist ss oc break_obj intpts) (princ "\nCalculating Break Points, Please Wait.\n") ;;======================================== ;; Break entity at break points in list ;;======================================== (defun break_obj (ent brkptlst / brkobjlst en enttype maxparam closedobj minparam obj obj2break p1param p2param brkpt2 dlst idx brkptS brkptE brkpt result result ignore dist tmppt #ofpts enddist lastent obj2break stdist ) (setq obj2break ent brkobjlst (list ent) enttype (dxf 0 ent) closedobj (vlax-curve-isclosed obj2break) ) (setq spt (vlax-curve-getstartpoint ent) ept (vlax-curve-getendpoint ent) brkptlst (vl-remove-if '(lambda (x) (or (< (distance x spt) 0.0001) (< (distance x ept) 0.0001) ) ) brkptlst ) ) (if brkptlst (progn ;; sort break points based on the distance along the break object ;; get distance to break point, catch error if pt is off end ;; ver 2.0 fix - added COND to fix break point is at the end of a ;; line which is not a valid break but does no harm (setq brkptlst (mapcar '(lambda (x) (list x (vlax-curve-getdistatparam obj2break ;; ver 2.0 fix (cond ((vlax-curve-getparamatpoint obj2break x) ) ((vlax-curve-getparamatpoint obj2break (vlax-curve-getclosestpointto obj2break x ) ) ) ) ) ) ) brkptlst ) ) ;; sort primary list on distance (setq brkptlst (vl-sort brkptlst '(lambda (a1 a2) (< (cadr a1) (cadr a2))) ) ) ;; ----------------------------------------------------- ;; (if (equal a ent) (princ)) ; debug CAB ------------- (foreach brkpt (reverse brkptlst) (setq brkptS (car brkpt) brkptE brkptS ) ;; get last entity created via break in case multiple breaks (if brkobjlst (progn (setq tmppt brkptS) ; use only one of the pair of breakpoints ;; if pt not on object x, switch objects (if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj2break tmppt) ) ) ) (progn ; find the one that pt is on (setq idx (length brkobjlst)) (while (and (not (minusp (setq idx (1- idx)))) (setq obj (nth idx brkobjlst)) (if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj tmppt) ) ) (null (setq obj2break obj)) ; switch objects, null causes exit t ) ) ) ) ) ) ); end (if brkobjlst ;;; Handle any objects that can not be used with the Break Command ;;; using one point, gap of 0.000001 is used (setq closedobj (vlax-curve-isclosed obj2break)) ;;; single breakpoint ---------------------------------------------------- (if (and closedobj (not (setq brkptE (vlax-curve-getPointAtDist obj2break (+ (vlax-curve-getdistatparam obj2break ;;(vlax-curve-getparamatpoint obj2break brkpts)) 0.00001)))) ;; ver 2.0 fix (cond ((vlax-curve-getparamatpoint obj2break brkpts ) ) ((vlax-curve-getparamatpoint obj2break (vlax-curve-getclosestpointto obj2break brkpts ) ) ) ) ) 0.00001 ) ) ) ) ) (setq brkptE (vlax-curve-getPointAtDist obj2break (- (vlax-curve-getdistatparam obj2break (cond ((vlax-curve-getparamatpoint obj2break brkpts ) ) ((vlax-curve-getparamatpoint obj2break (vlax-curve-getclosestpointto obj2break brkpts ) ) ) ) ) 0.00001 ) ) ); end setq brkptE ); end fi (and closedobj (setq LastEnt (GetLastEnt)) (command "._break" obj2break "_non" (trans brkptS 0 1) "_non" (trans brkptE 0 1) ) (and (= "CIRCLE" enttype) (setq enttype "ARC")) (if (and (not closedobj) ; new object was created (not (equal LastEnt (entlast))) ) (setq brkobjlst (cons (entlast) brkobjlst)) ); end (if (and ); end (foreach brkpt (reverse brkptlst) );end progn brkptlst ); end if brkptlst ); defun break_obj ;;==================================== ;; CAB - get last entity in datatbase (defun GetLastEnt (/ ename result) (if (setq result (entlast)) (while (setq ename (entnext result)) (setq result ename) ) ) result ) ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;; S T A R T S U B R O U T I N E H E R E ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ (if (and ss2brk enL) (progn (setq oc 0) ;; CREATE a list of entity & it's break points (foreach en (SS-enlst ss2brk) ; check each object in ss2brk (if (not (acet-layer-locked (dxf 8 en))) (progn (setq lst nil) ;; check for break pts with other objects in ss2brkwith (if (and (not (equal en enint)) (setq intpts (acet-geom-intersectwith en enL 0)) ) (setq lst (append intpts lst)) ; entity w/ break points ) (princ (strcat "Objects Checked: " (itoa (setq oc (1+ oc))) "\r" ) ) (if lst (setq masterlist (cons (cons en lst) masterlist) ) ) ) ) ) (princ "\nBreaking Objects.\n") (if masterlist (foreach obj2brk masterlist (break_obj (car obj2brk) (cdr obj2brk)) ) ) ) ) );end break_with ;;=========================================================================== ;; get all objects touching entities in the sscross ;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE" ;; returns a list of enames ;;=========================================================================== (defun gettouching (en / ss lst lstb lstc objl) (and (setq objl (vlax-ename->vla-object en)) (setq ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE" ) (cons 410 (getvar "ctab")) ) ) ) (setq lst (SS-enlst ss) lst (mapcar 'vlax-ename->vla-object lst) ) (mapcar '(lambda (x) (if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (vlax-safearray->list (vlax-variant-value (vla-intersectwith objl x acextendnone) ) ) ) ) ) ) (setq lstc (cons (vlax-vla-object->ename x) lstc)) ) ) lst ) ) lstc )Chào anh Thiệp, tại sao trong lisp của anh thỉnh thoảng báo lỗi "bad argument type: lselsetp "? Anh có thể sửa lại để không bị lỗi này nữa được ko?
Thêm 1 điều nữa là tại sao khi đưởng thẳng chạy qua 1 bộ XREF và Hatch nào đó thì khi dùng lisp này nó lại xóa luôn cả bộ XREF và Hatch đó chứ ko còn là trim nữa?
Nhờ anh xem giúp, xin cảm ơn :bigsmile:
-
Update theo yêu cầu :(defun c:dt (/ cen des obj src typ) (vl-load-com) (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)) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)) ) (and (setq src (car (entsel "\nChon doi tuong can di chuyen: "))) (not(redraw src 3)) (setq obj (vlax-ename->vla-object src) typ (vlax-get obj 'ObjectName)) (setq des (car (entsel "\nDoi tuong dich: "))) (not(redraw src 4)) (setq cen (vlax-3d-point(mid des))) (cond ((= typ "AcDbText") (vla-put-alignment obj 10) (vla-put-TextAlignmentPoint obj cen) ) ((= typ "AcDbMText") (vla-put-AttachmentPoint obj 5) (vla-put-InsertionPoint obj cen) ) (t (vlax-invoke obj 'Move (mid src) (mid des) ) ) ) ) (princ) ):cheers: :cheers: :cheers:
-
Chào study_foreverTiếng Việt mình, cụm từ "Đã thế" đuợc dùng trong bối cảnh nào vậy ta ?
Hàm (defun mid (ent / p1 p2) ..) bạn post lên không trả về tâm của 1 đối tuợng đâu !
Thưc chất là nó trả về tâm của hình chử nhật bao quanh đối tuợng đó.
"Đã thế" : tâm của 1 cung tròn (ARC) ở đâu ?
"Đã thế" : tâm của 1 đuờng kích thuớc (Dimension) ở đâu ?
.....
Khái niệm "tâm 1 vật nào đó" mà bạn Post ở trên cần phải hiểu là tâm của hình chử nhật bao quanh đối tuợng đó.
"Đã thế" :bạn chạy thử LISP này xem có Đã đã đã ............. hôn ?
(defun c:dt (/ cen des obj src ss_ent typ) (vl-load-com) (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)) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)) ) (and (princ "\nChon doi tuong can di chuyen (Text,MText) : ") (setq ss_ent (ssget "_:S:E" '((0 . "*TEXT"))) ) (setq src (ssname ss_ent 0)) (not(redraw src 3)) (setq obj (vlax-ename->vla-object src) typ (vlax-get obj 'ObjectName)) (setq des (car (entsel "\nDoi tuong dich: "))) (not(redraw src 4)) (setq cen (vlax-3d-point(mid des))) (cond ((= typ "AcDbText") (vla-put-alignment obj 10) (vla-put-TextAlignmentPoint obj cen) ) ((= typ "AcDbMText") (vla-put-AttachmentPoint obj 5) (vla-put-InsertionPoint obj cen) ) ) ) (princ) )Ơ nhưng mà bác Gia_bach ơi, sao cái lisp dt bác lại bỏ chức năng move các đối tượng mà chỉ để chức năng đối tượng là text thôi à? Thế thì mất hết ý nghĩa của cái lisp này rồi, em muốn vẫn giữ nguyên chức năng move các đối tượng khác vào tâm 1 đối tượng nào đó và bổ sung thêm đối tượng là mtext thôi (text thì đã được rồi), bác xem lại giúp em nhé, thanks các bác nhiều nhiều
-
Hi thanks các bác nhiều :cheers:
-
Có cái lisp căn lề rất hay, em đưa lên cho anh em nào chưa biết thì dùng, với cả nhờ bác nào thạo về lisp sửa giúp em để lệnh CLG (căn lề giữa) có thể áp dụng cho cả Mtext, thanks
;Viet boi: KTS_DUY BINH SON - QUANG NGAI ;Dien dan: tailieukythuat.com ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (Defun c:clt ( ) (princ "\nPHAM QUOC DUY Binh Son - Quang ngai") (command "undo" "be") (Princ "\nHay chon doi tuong :") (setq SS (ssget '((0 . "TEXT,MTEXT")))) (setq diemcanhle (getpoint "\nChon diem canh le :")) (setq i 0) (setq N (sslength ss)) (while (< i N) (setq luubatdiem (getvar "osmode")) (setvar "osmode" 0) (setq DT (ssname ss i)) (setq DTT (entget DT)) (setq TEXT (cdr (assoc 10 DTT))) (setq Xcanhle (list (car diemcanhle)(cadr text))) (command ".move" DT "" TEXT Xcanhle) (setvar "osmode" luubatdiem) (setq i (1+ i)) ) (command "undo" "end") (setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**") (Princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (Defun c:cln ( ) (princ "\nPHAM QUOC DUY Binh Son - Quang ngai") (command "undo" "be") (Princ "\nHay chon doi tuong :") (setq SS (ssget '((0 . "TEXT,MTEXT")))) (setq diemcanhle (getpoint "\nChon diem canh le :")) (setq i 0) (setq N (sslength ss)) (while (< i N) (setq luubatdiem (getvar "osmode")) (setvar "osmode" 0) (setq DT (ssname ss i)) (setq DTT (entget DT)) (setq TEXT (cdr (assoc 10 DTT))) (setq Xcanhle (list (car text)(cadr diemcanhle))) (command ".move" DT "" TEXT Xcanhle) (setvar "osmode" luubatdiem) (setq i (1+ i)) ) (command "undo" "end") (setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**") (Princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (Defun c:clp ( ) (princ "\nPHAM QUOC DUY Binh Son - Quang ngai") (command "undo" "be") (setvar "mirrtext" 0) (Princ "\nHay chon doi tuong :") (setq SS (ssget '((0 . "TEXT,MTEXT")))) (setq diemcanhle (getpoint "\nChon diem canh le :")) (setq i 0) (setq N (sslength ss)) (while (< i N) (setq luubatdiem (getvar "osmode")) (setvar "osmode" 0) (setq DT (ssname ss i)) (setq DTT (entget DT)) (setq TEXT (cdr (assoc 10 DTT))) (setq Xcanhle (list (car diemcanhle)(cadr text))) (command ".move" DT "" TEXT Xcanhle) (command ".mirror" DT "" Xcanhle diemcanhle "y") (setvar "osmode" luubatdiem) (setq i (1+ i)) ) (command "undo" "end") (setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**") (Princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (Defun c:clg ( ) (princ "\nPHAM QUOC DUY Binh Son - Quang ngai") (command "undo" "be") ;(setvar "mirrtext" 0) (Princ "\nHay chon doi tuong :") (setq SS (ssget '((0 . "TEXT")))) (setq diemcanhle (getpoint "\nChon diem canh le :")) (setq i 0) (setq N (sslength ss)) (while (< i N) (setq luubatdiem (getvar "osmode")) (setvar "osmode" 0) (setq DT (ssname ss i)) (setq DTT (entget DT)) (setq TEXT (cdr (assoc 10 DTT))) (setq Xcanhle (list (car diemcanhle)(cadr text))) (command ".move" DT "" TEXT Xcanhle) (command ".mirror" DT "" Xcanhle diemcanhle "y") (setq DTTG (entget DT)) (setq TEXTG (cdr (assoc 10 DTTG))) (setq daitextg (distance Xcanhle TEXTG)) (setq goctextg(angle Xcanhle TEXTG)) (setq dainuatextg (/ daitextg 2)) (setq diemquayg (polar Xcanhle goctextg dainuatextg)) ;(setq diemlatg (list (car diemquayg) (+ (cadr diemquayg) 100))) (command ".move" DT "" diemquayg Xcanhle) ;(command ".mirror" DT "" diemquayg diemlatg "y") (setvar "osmode" luubatdiem) (setq i (1+ i)) ) (command "undo" "end") (setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**") (Princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;; ;--------------------------------------- (defun nstr (stri def) (princ stri) (princ "<") (princ " ") (princ def) (princ ">") (princ ":") (princ " ") );defun nstr ;-------------------- (defun nstr1 (stri) (princ stri) (princ "<") (princ "Nhap vao") (princ ">") (princ ":") (princ " ") );defun nstr1 ;--------------------- (defun nint (prompt def / temp) (if def (setq temp (getint (nstr prompt def))) (setq def (getint (nstr1 prompt))) );if def (if temp (setq def temp) def );if temp );defun nint ;--------------------- (defun dnint (prompt def / temp) (if def (setq temp (getreal (nstr prompt def))) (setq def (getreal (nstr1 prompt))) );if def (if temp (setq def temp) def );if temp );defun nint ;-------------------- (defun ndist (po prompt def / temp) ;nhan kh/cach va luu gia tri mac dinh (if def (setq temp (getdist po (nstr prompt def))) (setq def (getdist po (nstr1 prompt))) )if def (if temp (setq def temp) def );if temp );defun ndist ;----------------------------------- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;; (Defun zoomduy ( ) (command ".zoom" "") (Princ)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;; (Defun thoi () (princ "\nPHAM QUOC DUY Binh Son - Quang ngai") (setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**") (Princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;; -
Đã thế nhờ bác Gia_bach và mọi người sửa luôn giúp cái lisp này để có thể chuyển Mtext vào tâm 1 vật nào đó, thanks các bác
;; free lisp from cadviet.com
(defun c:dt ()
(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)
-
Nhờ các bác sửa giúp cái lisp để có thể move cả text lẫn Mtext vào rectang, cái lisp này chỉ move được mỗi text thôi!
;move text 2 center rectang
(defun c:dtt()
(setvar "cmdecho" 0)
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 32)
(setq P1 (getpoint "\nPick a corner of the rectangle: "))
(setq P2 (getcorner P1 "\nPick opposite corner of the rectangle: "))
(setq A (angle P1 P2))
(setq D (distance P1 P2))
(setq P3 (polar P1 A (/ D 2.0)))
(setq ST (entsel "\nSelect text to center inside rectangle: "))
(while
(= ST nil)
(progn
(prompt "\nText was not selected...")
(setq ST (entsel "\nSelect text to center inside rectangle: "))
)
)
(command "justifytext" ST "" "MC")
(setq TMC (cdr (assoc 11 (entget (car ST)))))
(command "move" ST "" TMC P3)
(setvar "OSMODE" OS)
(princ)
)
-
Thỉnh thoảng em chả hiểu kiểu j mà cái bản vẽ của em nó cứ như bị dở hơi ấy, định zoom bé đi nhìn tổng thể tí mà nó cứ trơ cái mặt ra, ko thể nhỏ hơn được (mặc dù cái hình còn rất to và em đã hết sức để lăn chuột). Em chẳng hiểu nó bị lỗi hay bị đặt chế độ j nữa, có bác nào đã gặp tình huống này thì giúp em cái :s_big:
-
1
-
-
Mình ko học về XD, nhưng công việc của mình lại liên quan 1 số đến XD. Mình đã tìm hiểu qua 1 số ngành bên XD (chủ yếu là bên Kết Cấu). Mình mới mua quyển Sức bền vật liệu của trường XD bán, đọc qua nhưng chưa hiểu lắm về 1 số cái, có lẽ sẽ là vô cùng đơn giản thôi, tuy nhiên mong mọi người hết sức giúp đỡ:
- Mình thấy trong sách thường có cái gọi là liên kết gối di động và gối cố định, mình muốn hiểu chức năng, ví dụ thực tế, và cách phân tích lực của 2 liên kết này
- Có phải ứng lực là các nội lực (lực cắt, mô men, lực dọc), các lực này được phân tích khi mình cắt 1 mặt cắt nào đó (ví dụ trên dầm chẳng hạn), và mình sẽ dựa vào các ngoại lực để tính các nội lực này? Còn nếu để nguyên cả dầm thì chỉ có các ngoại lực tác dụng để dầm cân bằng (phản lực tại gối, tải trọng...)
- Để tính 1 bài toàn về nội lực ta phải tìm hết tất cả các giá trị của ngoại lực (chiếu lên các trục) rồi từ đó tính ứng lực bằng phương pháp mặt cắt...
Mình mới tiếp xúc nhưng thấy phần kết cấu của XD rất hay, tuy nhiên còn nhiều điều chưa rõ lắm, mong các bạn giúp đỡ nhé. Thank all!
Cách vẽ nhanh đường line này như thế nào ạ?
trong Sử dụng AutoCAD
Đã đăng · Trả lời báo cáo
Có 1 điểm A đã xác định, em muốn vẽ nhanh 1 đường line với điểm bắt đầu cách điểm A theo phương x là 30, theo phương y là 50. Có bác nào biết thì mách em với, em xin cảm ơn rất nhiều :tongue2: