quocmanh04tt
-
Số lượng nội dung
1123 -
Đã tham gia
-
Lần ghé thăm cuối
-
Ngày trúng
153
Bài đăng được đăng bởi quocmanh04tt
-
-
Scale text block
trong AutoLisp
Mình đi theo hướng như đã nói ở trên.
(defun c:tt (/ blc cen ent llp mid obj ss1 ss2 urp) (if (setq ss1 (ssget '((0 . "INSERT") (2 . "N_THUA_*")))) (while (and (setq ent (ssname ss1 0)) (ssdel ent ss1)) (vla-getboundingbox (setq obj (vlax-ename->vla-object ent)) 'llp 'urp) (setq llp (vlax-safearray->list llp) urp (vlax-safearray->list urp) mid (mapcar '(lambda (m n) (* (+ m n) 0.5)) llp urp) cen nil) (cond ((setq ss2 (ssget "C" llp urp '((0 . "INSERT") (2 . "CENTRD_1")))) (while (and (setq blc (ssname ss2 0)) (ssdel blc ss2)) (setq cen (cons (cdr (assoc 10 (entget blc))) cen))) (setq cen (vl-sort cen '(lambda (x y) (< (distance mid x) (distance mid y))))) (vlax-invoke obj 'scaleentity (car cen) 0.01))))) (princ))-
1
-
1
-
-
Scale text block
trong AutoLisp
Bài này nếu quét chọn block "N_THUA*" trước, với từng block xác định Boundingbox, từ đây quét block "CENTRD_1", sẽ ít gặp rắc rối hơn và không gặp vấn đề như trên.
-
1
-
-
-
9 giờ trước, hawking312 đã nói:cảm ơn bác đã giúp đỡ, nhưng chưa phải ý của mình, nó như thế này. Nó là 1 lisp trong bộ cài Speedcad, lệnh R90 để rotate 90 độ, R-90 để rotate ngược lại 90 độ, ... Mong muốn nhờ mọi người giúp viết lại thành lisp để có thể thêm lệnh R0, Nhờ bác giúp ạ, cảm ơn bác
https://files.fm/f/2h7t6bc95
- Ố ố ... Lisp của mình đáp ứng được mà! Bạn gõ lệnh R90 hay R91, R92, R-93 ... R130... đều được (số bất kỳ nằm sau R là được).
- Còn cái R0 bạn nói thì may ra làm được với *Text, Block (các đối tượng có thông tin về góc xoay), với nhóm đối tượng bất kỳ thì khó mà khả thi.
-
-
Hehehe...
- Chỉ là giải quyết bài toán của chủ thớt thì lisp ổn rồi, cũng như chỉ cần lisp của Mr. Cuong ở trên cũng đã ok mà lại ngắn gọn (chỉ cần đưa hệ toạ độ về đúng vị trí của nó - thông qua lệnh UCS, nếu là cad đời cao chỉ cần pick vào cái biểu tượng và kéo là được).
- Ở trên thấy bác nói không dùng command, việc này đồng nghĩa với việc phải sử dụng nhiều kiến thức về lisp hơn (nhất là liên quan đến UCS), nên anh em chờ bác post để tham khảo (nói như Mr. alisp ở trên).
- Vấn đề này thì chỉ sửa lại lisp của Mr. Cuong chút xíu... là đáp ứng được.
Vào lúc 27/10/2021 tại 11:38, thiep đã nói:từ điểm pick, lisp hiểu sẽ tạo 2 dimordinate ở 2 điểm quadrant nào, không nên cứng nhắc chỉ là tạo 2 dimordinate dưới và phải.
(defun c:tt (/ cen ent lsp poi rad sel)
(while (setq sel (entsel "\nPick duong tron:"))
(setq ent (entget (car sel))
cen (trans (acet-dxf 10 ent) 0 1)
rad (acet-dxf 40 ent)
poi (cadr sel)
lsp (mapcar '(lambda (x / p) (setq p (polar cen (* x pi) rad)) (list p (polar p (* x pi) 1.2)))
'(0 1 0.5 1.5))
lsp (vl-sort lsp '(lambda (x y) (> (distance (car x) poi) (distance (car y) poi)))))
(mapcar '(lambda (x) (command "_dimordinate" "_none" (car x) "_none" (cadr x)))
(cddr lsp)))
(princ)) -
21 phút trước, thiep đã nói:Cũng có thể @quocmanh, bới vậy khi BV đang ở UCS, Thiệp đưa về WCS, sau khi chạy lisp thì trả về UCS cũ. Tuy nhiên, cũng chưa biết có ổn không, Thiệp thử ở cad 2007 thấy ok.
Bác thử xoay UCS 1 góc nào đó để kiểm tra.
Bản vẽ của chủ thớt hình như là lĩnh vực cơ khí, không phải chuyên môn nhưng mình đoán bốn điểm của hình tròn cần đo là các điểm mà khi chiếu vuông góc xuống các trục toạ độ sẽ có các giá trị cực tiểu và cực đại.
Lisp của bác 4 điểm đó với tính chất trên lại luôn thuộc WCS.
-
2 giờ trước, thiep đã nói:Lệnh po0: tạo điểm quy chiếu, (giống như dời điểm gốc hệ toạ độ (0 0 0) về điểm này)
Lệnh TDT: tạo DimOrdinate cho CIRCLE, ARC
;;;Lisp AdddimOrdinate cho tâm CIRCLE, ARC by Trân Thiêp 10/2021, tel 0918841230 (defun c:po0 (/) (setq po0 (getpoint '(0 0 0) "\nPick 1 \U+0111i\U+1EC3m to\U+1EA1 \U+0111\U+1ED9 quy chi\U+1EBFu" ) ) ) (defun c:tdt (/ doc *model ucs_old po13_1 po14_1 po13_2 po14_2 90d 270d 360d ent centpo eng ang R obdX obdY engX engY entodimX entodimY sel popick ) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) *model (vla-get-modelspace doc) ) (defun *error* (msg) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")) ) (acet-sysvar-restore) (vla-EndUndoMark doc) (princ) ) (vla-StartUndoMark doc) (acet-sysvar-set (list "cmdecho" 0 "osmode" 33)) (setq ucs_old (acet-ucs-get nil)) (acet-ucs-cmd '("w")) (setq 90d (/ pi 2) 360d (* pi 2) 270d (* 90d 3) ) (or po0 (setq po0 (getpoint "\nPick 1 \U+0111i\U+1EC3m to\U+1EA1 \U+0111\U+1ED9 quy chi\U+1EBFu"))) (setvar "osmode" 0) (while (OR (NOT (setq sel (entsel "\nPick a CIRCLE, ARC"))) (NOT (wcmatch (acet-dxf 0 (setq eng (entget (setq ent (car sel))))) "CIRCLE,ARC" ) ) ) (prompt "\nPick ch\U+01B0a Ðúng CIRCLE, ARC vui lòng pick l\U+1EA1i") ) (setq popick (cadr sel)) (setq centpo (trans (acet-dxf 10 eng) 0 1) R (acet-dxf 40 eng) ) (setq ang (angle centpo popick)) (cond ((< 0 ang 90d) (setq po13_1 (polar centpo 0 R) po14_1 (polar po13_1 0 10) po13_2 (polar centpo 90d R) po14_2 (polar po13_2 90d 10) ) ) ((< 90d ang pi) (setq po13_1 (polar centpo pi R) po14_1 (polar po13_1 pi 10) po13_2 (polar centpo 90d R) po14_2 (polar po13_2 90d 10) ) ) ((< pi ang 270d) (setq po13_1 (polar centpo pi R) po14_1 (polar po13_1 pi 10) po13_2 (polar centpo 270d R) po14_2 (polar po13_2 270d 10) ) ) ((< 270d ang 360d) (setq po13_1 (polar centpo 0 R) po14_1 (polar po13_1 0 10) po13_2 (polar centpo 270d R) po14_2 (polar po13_2 270d 10) ) ) ) (setq obdX (vla-AddDimOrdinate *model (vlax-3d-point (trans po13_1 1 0)) (vlax-3d-point (trans po14_1 1 0)) :vlax-false ) ) (setq obdY (vla-AddDimOrdinate *model (vlax-3d-point (trans po13_2 1 0)) (vlax-3d-point (trans po14_2 1 0)) :vlax-true ) ) (setq engX (entget (setq entodimX (vlax-vla-object->ename obdX)))) (entmod (subst (cons 10 po0) (assoc 10 engX) engX)) (entupd entodimX) (setq engY (entget (setq entodimY (vlax-vla-object->ename obdY)))) (entmod (subst (cons 10 po0) (assoc 10 engY) engY)) (entupd entodimY) (acet-sysvar-restore) (acet-ucs-set ucs_old) (vla-EndUndoMark doc) (princ "\nOk") (princ) )
Chúc vui vẻ. Thiep
@thiepCó vẻ chưa ổn trong UCS bác ạ!
-
-
Vào lúc 1/8/2021 tại 00:41, moitapchoicad đã nói:Nếu lisp của bạn giải quyết được đối tượng là line, arc, spline, và có thể lấy được miền trong của chi tiết chính như các lỗ, cắt khoét thì tốt.
Tưởng là thì gì khác, chứ thì tốt thì mình chịu. hehehe ...
Tuy nhiên bài toán của bạn có thể giải quyết được, bằng cách viết lại lisp khác.
-
20 giờ trước, benanphal93 đã nói:Nếu các chi tiết như hình là các pline (1 chi tiết là 1 lwpolyline), text (không phải Mtext, Rtext), thì bạn dùng lisp này:
-
-
Lisp này nằm ở đây:
-
1
-
-
Chia sẻ là đáng quý!
Nếu ai dùng Win10 có thể dùng tổ hợp phím "Windows key + Shift + S", khỏi cần tool.
-
1
-
-
Vào lúc 27/6/2021 tại 12:34, thiep đã nói:Theo Thiep nghĩ, bạn đã dùng 1 lisp để insert block thép dầm này, trong lisp có liên kết field chiều dài polyline vào trong ATT, nếu bạn có thể share cho lisp này cho Thiep xem thì quý hoá. Thiệp cũng lisp liên kết chiều dài kiểu này vào trong ATT nhưng chiều dài không phải là 1 polygon mà là 1 thuộc tính động của block động.
Bạn cũng nên đổi tên block thành không dấu, cho không bị lỗi vặt.
Cái block trên kia giá trị chiều dài cũng là tổng mấy cái thuộc tính (Parameter) của block động mà bác!
-
- Topic tham khảo là slide_image, còn code minh họa lại là vector_image, 2 loại này có khác nhau đó bạn.
- Với code bạn gửi, bạn thử thay hàm logo trong lisp bằng hàm mới dưới đây xem sao:
(defun logo (key / hei wid vec)
(setq wid (dimx_tile "logo")
hei (dimy_tile "logo")
vec (lambda (d l) (mapcar '(lambda (x) (fix (+ d (* x (/ d -10))))) l)))
(start_image key)
(mapcar 'vector_image
(vec wid '(1 1 9))
(vec hei '(4 6 6))
(vec wid '(1 9 9))
(vec hei '(6 6 4))
'(1 1 1))
(end_image))P/s: Bạn test với nhiều trường hợp (thay đổi: width = ... height = ... của tile logo xem).
-
1
-
-
Vào lúc 20/6/2021 tại 11:06, thanhdn đã nói:nhân tiện các anh chị có thể thêm vào lisp dòng nhắc
+ chọn cao độ text khi xuất ra hoặc chọ text có sẵn
+ số lẻ sau dấu phảy
để cho nó phù hợp với các bản vẽ không ạ, xin cảm ơn các anh chị đã đọc
Dòng màu đỏ là sao bạn nhỉ???
-
-
3 phút trước, chien_lv đã nói:dạ em dùng 2007 anh a.
Uh, cad 2011 về sau mới có cái đó. Vậy bạn dùng cái này xem:
P/s: Năm 2021 rồi mà còn dùng 2007, hiện tại đã có Cad 2022 rồi. Lạc hậu ghê... hehehe...
-
1
-
-
Bạn dùng Cad nào vậy?
-
-
Vào lúc 31/5/2021 tại 18:45, vanhuyou đã nói:Bạn ơi cho mình hỏi là lúc pick để lấy Tag của Block Att thì được, nhưng khi bấm Ok để quét các đối tượng block thì nó lại không nhận đối tượng là sao nhỉ
Hình như bản này không dùng cho block động (Dynamic block).
-
1
-
-
4 giờ trước, vanthienckhd đã nói:Mình đã liên hệ với bạn Quốc Mạnh, và bạn ấy share lisp dùng rất tốt, mình gởi lên đây ae ai cần tham, khảo ạ. tks
Ủa...! Lisp này đâu phải mình viết???
-


Scale text block
trong AutoLisp
Đã đăng · Trả lời báo cáo
Về lý thuyết thì đúng như vậy bạn, nhưng đây là bài toán thực tế và mình cũng đã nói ở trên "... ít gặp rắc rối hơn..."
Có lẽ Zoom lên để quét vùng lớn...
(defun c:tt (/ blc cen ent llp mid obj ss1 ss2 urp) (if (setq ss1 (ssget '((0 . "INSERT") (2 . "N_THUA_*")))) (while (and (setq ent (ssname ss1 0)) (ssdel ent ss1)) (vla-getboundingbox (setq obj (vlax-ename->vla-object ent)) 'llp 'urp) (vla-ZoomWindow (vlax-get-acad-object) llp urp) (setq llp (vlax-safearray->list llp) urp (vlax-safearray->list urp) mid (mapcar '(lambda (m n) (* (+ m n) 0.5)) llp urp) cen nil) (cond ((setq ss2 (ssget "C" llp urp '((0 . "INSERT") (2 . "CENTRD_1")))) (while (and (setq blc (ssname ss2 0)) (ssdel blc ss2)) (setq cen (cons (cdr (assoc 10 (entget blc))) cen))) (setq cen (vl-sort cen '(lambda (x y) (< (distance mid x) (distance mid y))))) (vlax-invoke obj 'scaleentity (car cen) 0.01))) (vla-ZoomPrevious (vlax-get-acad-object)))) (princ))