Superlong
-
Số lượng nội dung
35 -
Đã tham gia
-
Lần ghé thăm cuối
Bài đăng được đăng bởi Superlong
-
-
có lệnh nào tạo 1 file excel vào vị trí được ghi ra sẳn trong câu lệnh vd "c:\......." mà chỉ tạo file thôi chứ ko tự mở file ra (ý mình là tạo trong âm thầm ^^)
để tip theo dùng lệnh open theo đường dẫn đó và ghi dữ liệu vào file đó không
-
trong câu lệnh (write-line) thì làm thế nào để cho kết quả xuất ra lần lượt theo cột từ trái qua phải
vd: (setq cot1 (+ 1 1)
cot2 (+ 1 2)
cot3 (+1 3))làm sao có thể đưa giá trị của các biến cot1-3 vào write-line để kết quả cho ra phân biệt theo cột thứ tự lần lượt các cột từ trái qua phải để open = excel có thể dễ thao tác hơn chứ nếu nối chuỗi lại thì nó vẫn nằm trong 1 ô thôi
-
em dùng các phần mềm để chuyển mã unicode đưa vào lisp lúc đầu trên thanh command vẫn hiện tiếng việt bình thường nhưng khi dùng cho nhìu lệnh quá thì nó lâu lâu hiện ra nguyên cái mã code luôn không ra tiếng việt nửa nếu copy riêng đoạn copy trong lisp past vào vlide thì lại ok
có ai bị giống vậy có cách khắc phục không -
Bạn tham khảo lisp này (của ai quên mất) rồi tự nghiên cứu thôi. HỌC HỎI là tốt nhưng HỌC nhiều thì tốt hơn HỎI nhiều.
;----- Trim and Delete outside of closed polyline (C¾t vµ xo¸ phÇn bªn ngoµi cña 1 polyline ®ãng). ; Required Express tools. OutSide Contour Delete with Extrim. (defun C:OCD ( / en ss lst ssall bbox) (vl-load-com) (if (and (setq en (car (entsel "\nSelect contour (polyline): "))) (wcmatch (cdr (assoc 0 (entget en))) "*POLYLINE")) (progn (setq bbox (ACET-ENT-GEOMEXTENTS en)) (setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox)) (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3)) (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en))) (command "_.Zoom" "0.95x") (if (null etrim) (load "extrim.lsp")) (etrim en (polar (car bbox) (angle (car bbox) (cadr bbox)) (* (distance (car bbox)(cadr bbox)) 1.1))) (if (and (setq ss (ssget "_CP" lst)) (setq ssall (ssget "_X" (list (assoc 410 (entget en)))))) (progn (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (foreach e1 lst (ssdel e1 ssall)) (ACET-SS-ENTDEL ssall)))))) (princ "\nType OCD to start") (princ)
lisp này cách thức của nó vẫn là dùng etrim và xãy ra lỗi như đầu bài mình đã đề cập cái mình cần hỏi là làm sao lồng extrim vào nếu trong lisp gõ dòng lệnh (c:extrim) thì nó vẫn thực hiện lệnh tuy nhiên kế tiếp yêu cầu select object và chọn side to trim không thể thực hiện = 1 câu lệnh được , gõ vd: (setq ss (entsel "\n Chon boundary để trim")
pt (getpoint "\n CHỌN PHÍA TRIM"))
(etrim (car ss) pt)
thì cad nó hiểu nhưng bị lỗi hay xóa luôn 1 vài pline bên trong boundary mặc dù getpoint là bên ngoài
còn gõ
(setq ss (entsel "\n Chon boundary để trim")
pt (getpoint "\n CHỌN PHÍA TRIM"))
(c:extrim (car ss) pt) thì báo bad function many argument
-
hihi cám ơn bác em sẽ chịu khó dùng chức năng search hơn
-
từ list thứ tự ename ban đầu (10.9715 <Entity name:
7ef03498>) (6.43388 <Entity name: 7ef03490>) (8.86799 <Entity name: 7ef03488>)
code của bác đã sắp xếp ra list đúng yêu cầu rồi (<Entity name: 7ef03490>
<Entity name: 7ef03488> <Entity name: 7ef03498>)
giờ dùng hàm gì để chuyển các ename đó thành 1 tập đối tượng được
hiện tại em phải thay hàm (ssname) bằng (nth) thì mới chạy tiếp các bước tiếp theo của lisp bác thông vấn đề này giúp em được không ạ em đoán mò là hiện tại cad chỉ hiểu (<Entity name: 7ef03490>
<Entity name: 7ef03488> <Entity name: 7ef03498>) như là 1 chuỗi thôi không còn là tập đối tượng nửa phải không ạ -
em chịu thôi hàm này khó em nhờ quá bác ráp zô lisp này giùm em với sort chỗ các polyline được chọn biến (dt) ấy
(defun c:yeah ( / dt dt1 dt2 rec1 rec2 pt ss)
(if (not sc3) (setq sc3 2))
(setq sc1 (getreal (strcat "\nChi\U+1EC1u cao Text <")))
(if (not sc1) (setq sc1 sc3) (setq sc3 sc1))
(setq sc9 (cdr (assoc 1 (entget (car (entsel "\nChon Text Ly Trinh : "))))))
(setq dt (ssget '((0 . "LWPOLYLINE"))))
(setq sdt (sslength dt)
K SDT
i 0)
(while
(setq dt1 (ssname dt i)
dt2 (ssname dt (1+ i))
i (1+ i)
K (- K 1)
rec1 (acet-geom-vertex-list dt1)
rec2 (acet-geom-vertex-list dt2)
pt (nth 0 rec1)
)
(if (and (< (car (nth 0 rec1)) (car (nth 2 rec1))) (< (car (nth 0 rec2)) (car (nth 2 rec2))))
(setq ss (append rec1 (reverse rec2) (list pt))))
(if (and (> (car (nth 0 rec1)) (car (nth 2 rec1))) (> (car (nth 0 rec2)) (car (nth 2 rec2))))
(setq ss (append rec1 (reverse rec2) (list pt))))
(if (and (< (car (nth 0 rec1)) (car (nth 2 rec1))) (> (car (nth 0 rec2)) (car (nth 2 rec2))))
(setq ss (append rec1 rec2 (list pt))))
(if (and (> (car (nth 0 rec1)) (car (nth 2 rec1))) (< (car (nth 0 rec2)) (car (nth 2 rec2))))
(setq ss (append rec1 rec2 (list pt))))
(acet-pline-make (list ss))
(command "area" "o" (entlast))
(setq dientich (getvar "area"))
(setq s (strcat (rtos dientich 2 2)))
(command "INSERT" "DIENTICHL" (nth 1 rec2) SC1 SC1 0 sc9 K S)
)
(princ "\nThanks for Using - Ho\U+00E0ng Long Auto Lisp
Phone:0933118500
Mail:longnguyen4563@gmail.com")
(PRINC)) -
bác cho em hỏi nhiệm vụ của biến ent và lst_ent được không hoặc có tài liệu tiếng việt của hàm mapcar và lambda cũng được
-
đây là lisp vẽ đường phân lớp theo độ dốc nhưng sau khi tạo các đường dốc xong em muốn cho nó vẽ thêm 1 đường pline ở dưới đáy nửa nên lấy toạ độ x của điểm end + 1 và giữ nguyên y ra điểm thứ 1 sau đó lấy x của end -1 giữ nguyên y thành điểm thứ 3 điểm thứ 2 chính là end để vẽ thì nó nhãy loạn cả lên
em nghĩ do ãnh hưởng của hàm nào đó trong lisp này vì ở công đoạn vẽ pline theo độ dốc lisp vẫn tính toán ra kết quả đúng(vl-load-all "C:/Program Files/AutoCAD 2010/Express/extrim.lsp")
(defun c:tpl ()
(setq s1 (entsel "\nCh\U+1ECDn \U+0111\U+01B0\U+1EDDng bao"))
(setq dinh (getpoint "\nCh\U+1ECDn \U+0111\U+1EC9nh")
end (getpoint "\nCh\U+1ECDn \U+0111\U+00E1y"))
(setq dodoc (getreal "\nNh\U+1EADp \U+0111\U+1ED9 d\U+1ED1c c\U+1EE7a \U+0111\U+01B0\U+1EDDng ph\U+00E2n l\U+1EDBp i%: ")
ydinh (cadr dinh)
yend (cadr end)
xdinh (car dinh)
xend (car end)
xtdpl1 (- xdinh 100)
xtdpl2 (+ xdinh 100)
ytdpl (- ydinh DODOC)
dpl1 (list xtdpl1 ytdpl 0)
dpl2 (list xtdpl2 ytdpl 0)
kc (abs(- ydinh yend))
h (getreal "\nNh\U+1EADp b\U+1EC1 d\U+00E0y ph\U+00E2n l\U+1EDBp : ")
nl1 (ATOI (RTOS (/ kc h) 2 0))
nl2 (/ kc h))
(if (> nl1 nl2) (setq nl (- nl1 1 )))
(if (< nl1 nl2) (setq nl nl1))
(setq kr (strcase (getstring "\nCh\U+1ECDn h\U+01B0\U+1EDBng r\U+1EA3i-Tr\U+00EAn xu\U+1ED1ng/D\U+01B0\U+1EDBi l\U+00EAn: ")))
(if (= kr "T") (setq h1 (* h -1)))
(if (= kr "D") (setq h1 h))
(setq phud (entlast))
(command "pline" dpl1 dinh dpl2 "" "")
(setq ss (entlast))
(command "array" ss "" "r" (+ 1 nl) "1" h1)
(setq da (entlast))
(setq pt2 (nth 0 (acet-geom-vertex-list da)))
(setq pt3 (nth 2 (acet-geom-vertex-list da)))
(setq pt4 (+ (car dinh) 2))
(setq pt1 (- (car dinh) 2)
pt5 (list pt4 (+(nth 1 dinh) 0.1) 0)
pt6 (list pt1 (+(nth 1 dinh) 0.1) 0)
goc (list 0 0 0))
(command "extend" s1 "" "f" pt6 pt2)
(command "" "f" pt3 pt5 "" "")
(vl-load-all "C:/Program Files/AutoCAD 2010/Express/extrim.lsp")
(setq
xcut1 (+ (CAR (NTH 0 (acet-geom-vertex-list da))) 1)
xcut2 (- (CAR (NTH 2 (acet-geom-vertex-list da))) 1)
)
(IF (= KR "T")
(SETQ
PCUT1 (LIST XCUT1 YDINH)
PCUT2 (LIST XCUT1 (- YEND 100))
PCUT3 (LIST XCUT2 YDINH)
PCUT4 (LIST XCUT2 (- YEND 100))
))
(IF (= KR "D")
(SETQ
PCUT1 (LIST XCUT1 (- YDINH 100))
PCUT2 (LIST XCUT1 (+ YEND 100))
PCUT3 (LIST XCUT2 (- YDINH 100))
PCUT4 (LIST XCUT2 (+ YEND 100))
))
(COMMAND "_.TRIM" (CAR S1) "" "F" PCUT1 PCUT2 "" "F" PCUT3 PCUT4 "" "")
(setq xphut1 (- xend 5)
xphut2 (+ xend 5)
phut1 (list xphut1 yend 0)
phut2 (list xphut2 yend 0))
(command "pline" phut1 end phut2 "" "")
) -
sẳn cho em hỏi 1 vấn đề về tọa độ trong cad
vd em getpoint chọn 1 điểm trên màn hìnhxong dùng (car en) để lấy tọa độ x (cadr en) để lấy y
xong em + tọa độ x đó cho 1 đơn vị và tạo ra 1 điểm mới là (list (+ x 1) y 0) thì điểm mới này ra tọa độ rất lung tung mặc dù điểm mới em vẫn giữ nguyên tọa độ là y nhưng kết quả trả về tọa độ y mới củng đã được + và kết quả của x mới củng không phải = x+1 bác giải thích giúp em được không
-
cho mình hỏi cách dùng hàm vl-sort để sắp xếp thứ tự các polyline được chọn theo tung độ của các polyline như nào
vd bước đầu là (setq dt (ssget '((0 . "LWPOLYLINE")))) rồi thì làm sao sort các polyline này . điển hình ở đây các polyline đều có 3 đỉnh mình muốn sort theo tung độ của đỉnh thứ 1 , các bạn hướng dẫn mình sao cho sort ra 1 list mới theo yêu cầu như trên là được rồi -
bình thường khi muốn lồng 1 lệnh nào đó vào thì mình dùng (command "tên lệnh" ..... các thuộc tính của lệnh ) nhưng không làm được với lệnh extrim mặc dù gõ lệnh ở ngoài thì vẫn ok . nếu viết trong lisp là (c:extrim) thì vẫn phải làm thủ công các bước chọn boundary và phía trim vì không lồng được câu lệnh (c:extrim boundary phiatrim) với các biến boudary và phiatrim đã được gán trước đó
còn dùng với (etrim ...) thì thường hay lỗi xoá luôn 1 vài đối tượng bên trong boudary mặc dù chọn phía trim là bên ngoài
các tiền bối autolisp có kinh nghiệm về khoảng này không gợi ý em với -
à em hiểu rồi cám ơn bác rất nhìu
(defun c:yeah ( / dt dt1 dt2 rec1 rec2 pt ss)
(setq dt (ssget '((0 . "LWPOLYLINE"))))
(setq dt1 (ssname dt 0)
dt2 (ssname dt 1)
rec1 (acet-geom-vertex-list dt1)
rec2 (acet-geom-vertex-list dt2)
pt (nth 0 rec1)
)
(setq ss (append rec1 (reverse rec2) (list pt)))
(acet-pline-make (list ss))) -
sau khi sửa lại thì nó báo error: bad argument type: listp 6.7799
(defun c:yeah ( / dt dt1 dt2 rec1 rec2 ss)
(setq dt (ssget '((0 . "LWPOLYLINE"))))
(setq dt1 (ssname dt 0)
dt2 (ssname dt 1)
rec1 (acet-geom-vertex-list dt1)
rec2 (acet-geom-vertex-list dt2))
(setq ss (append rec1 rec2))
(acet-pline-make ss)) -
mình vừa bổ sung rồi đó bạn
-
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))
-
1
-
-
em muốn tạo pline kín từ 2 pline không giao nhau nhưng khi chạy thử thì báo lỗi ssget mọi ng giải thích giùm em với
(defun c:yeah
(setq lst (ssget))
(SETQ DT1 (NTH 0 lst)
dt2 (nth 1 lst))
(setq td1 (acet-geom-vertex-list dt1)
td2 (acet-geom-vertex-list dt2))
(setq ss1 (nth 0 td1)
ss2 (nth 1 td2))
(acet-pline-make (list ss1 ss2))) -
BÁC HOANH cho em hỏi sao em dùng lisp trên đổi lại đối tượng là LWPOLYLINE thì lại lỗi
em đang muốn tạo một lisp tính diện tích từ tọa độ của các polyline được chọn theo cách là lấy tọa độ của đường pline có tung độ Y lớn nhất hợp với tọa độ của từng pline -> diện tích của từng vùng nên cần tìm hiểu từng bước mong được bác hoanh và mọi người hướng dẫn -
cám ơn bác doan van ha em thành công rồi
(defun DXF (code elist)
(cdr (assoc code elist))
)
(defun c:ZX(/ dt tenfile f lst lst2 i ls )
(if (not scale) (setq scale 1))
(setq sc1 (getreal (strcat "\n Cao text <"(rtos scale 2 0)">:")))
(if sc1 (setq scale sc1))
(setq sc9 (cdr (assoc 1 (entget (car (entsel "\nChon Text Ly Trinh : "))))))
(setq p (getpoint "\nChon tim trac ngang: "))
(setq TX (Car P))
(setq TY (Cadr P))
(setq ed (entget (car (entsel "\nChon cao do tim : "))))
(setq H0 (read (DXF 1 ed)))
(setq ATLAST (getvar "Attreq"))
(setq dt (ssget '((0 . "LWPOLYLINE")))
sdt (sslength dt)
i 0)
(repeat sdt
(setq dt1 (ssname dt i)
i (1+ i)
rec (acet-geom-vertex-list dt1))
(setq x1 (car (nth 0 Rec))
y1 (cadr (nth 0 Rec))
x2 (car (nth 1 Rec))
y2 (cadr (nth 1 Rec))
x3 (car (nth 2 Rec))
y3 (cadr (nth 2 Rec))
)
(setq kc1 (rtos (- x1 tx) 2 2))
(setq kc2 (rtos (- x3 tx) 2 2))
(setq kctim (rtos (- x2 tx) 2 2))
(setq cd1 (rtos (abs (+ (- y1 ty) H0)) 2 2))
(setq cdtim (rtos (abs (+ (- y2 ty) H0)) 2 2))
(setq cd2 (rtos (abs (+ (- y3 ty) H0)) 2 2))
(setvar "attreq" 1)
(if (not (tblsearch "block" "dimTN"))
(progn (command "insert" "D:\\Lisp CAD\\BLOCK.dwg" 0 "" "" "")
(command "erase" (entlast) "")))
(if (> kc1 KC2) (command "INSERT" "dimTN" (nth 2 rec) scale scale 0 sc9 CD2 KC2 cdtim kctim CD1 KC1))
(if (< kc1 KC2) (command "INSERT" "dimTN" (nth 0 rec) scale scale 0 sc9 CD1 KC1 cdtim kctim CD2 KC2))
))bác cho em hỏi thêm có cách nào sắp xếp các phần tử trong danh sách được chọn theo thứ tự từ lớn tới nhỏ không VD sau khi chọn 5 pline và dùng cadr lọc ra 5 tung độ rồi thì sẽ sắp xếp 5 tung độ đó theo thứ tự từ lớn tới nhỏ để đặt tên từ y1-y5 chứ không phải theo thứ tự chọn
-
làm sao có thể dùng hàm này để lấy tọa độ của nhiều pline cùng lúc không quét chuột chọn 1 lần nhìu đường luôn(acet-geom-vertex-list )
dùng entsel pick từng đường lâu quá mình dùng ssget thì nó lại không hiểu
đoạn code dưới đây mình cần sửa chỗ nào để cho nó lọc danh sách các pline mình chọn để xử lí tọa độ của từng điểm được
mình load vào chọn các pline xog là nó báo lentityp (-1 . <Entity name:
7ef034c0>)vd:
(defun c:yeah(/ dt tenfile f lst lst2 i ls )(vl-load-com)(setq dt (ssget '((0 . "LWPOLYLINE")))(setq sdt (sslength dt)i 0)(repeat sdt(setq dt1 (ssname dt i)i (+1 i)(setq td2 (acet-geom-vertex-list dt1).....các hàm xử lý vs tọa độ của đối tượng thứ i -
đây là lisp độ lại từ lisp của diễn đàn tính diện tích cho trắc ngang theo lớp có phân biệt lý trình tuy nhiên cách tính diện tích của lisp này là tạo boundary mình muốn nhờ sửa lại cách tính diện tích = hatch và giữ lại vùng hatch đó luôn để sau này tiện đối chiếu khối lượng với tư vấn giám sát vì nếu tính theo cách tạo boundary nếu giữ lại các đường bao thì khi pick nhìu vùng thì nó tạo các đường bao độc lập sau này tư vấn nó kiểm tra phải cộng lại còn hatch nó đồng nhất kiểm tra tiện hơn(Defun c:tdt()
(setvar "cmdecho" 0)
(initget "Heso Do")
(setq
cn (getstring "\nNh\U+1EADp th\U+1EE9 t\U+1EF1 l\U+1EDBp <1>: " T))
(if (not sc3) (setq sc3 2))
(setq sc1 (getreal (strcat "\nChi\U+1EC1u cao Text <")))
(if (not sc1) (setq sc1 sc3) (setq sc3 sc1))
(setq sc9 (cdr (assoc 1 (entget (car (entsel "\nChon Text Ly Trinh: "))))))
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "0"))
(setq c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn))
(setq n (vl-string-subst "" c cn))
(while
(setq pt (getpoint "\n chon diem:"))
(if (= pt "Heso")
(progn
(setq am (getreal "\n loccoc259.co.cc : "))
(if (and (null am) (/= ac 0))
(setq am ac)
)
(setq pt (getpoint "\n Chon diem: "))
)
(setq ac am))
(if (or (= am 0) (null am)) (setq am 1))
(setq s 0)
(progn
; (setq pt (getpoint "\n Chon diem: "))
(while pt
(setq entold (cdr (assoc 5 (entget (entlast)))))
(command "BOUNDARY" pt "")
(setq entnew (cdr (assoc 5 (entget (entlast)))))
(if (/= entold entnew)
(progn
(setq entnew (entget (entlast)))
(if (assoc 62 entnew)
(setq entnew (subst (cons 62 (+ 3 (cdr (assoc 62 entnew)))) (assoc 62 entnew) entnew))
(setq entnew (append entnew (list (cons 62 (+ 3 (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8
entnew))))))))))
)
(entmod entnew)
(Command "area" "o" (entlast))
(setq s (+ s (getvar "area")))
(setq pt (getpoint "\n Chon diem: "))
(entdel (entlast))
)
(progn
(princ "chon diem sai")
(setq pt (getpoint "\n Chon diem: "))
)
)
)
)
"(command "" "")"
(princ (* s am))
(princ)
(if (not (tblsearch "block" "DIENTICHL"))
(progn (command "insert" "D:\\Lisp CAD\\BLOCK.dwg" 0 "" "" "")
(command "erase" (entlast) "")))
(setq p (getpoint "\n\U+0110i\U+1EC3m ch\U+00E8n : "))
(if (= n "")
(setq cn (incC cn))
(setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))
)
(setq
dat (entget (entlast))
dat (subst (cons 1 cn) (assoc 1 dat) dat)
)
(setq dt1 (* s am 1 1))
(setq dt (/ dt1 1))
(setq dt (strcat (rtos dt 2 3)))
(command "INSERT" "DIENTICHL" p sc1 sc1 "0" sc9 cn dt)
)
)
)
-
1
-
-
lisp này có thể bổ sung thêm đo k/c tới tim luôn được không bạn kết quả xuất ra khi chèn điểm theo dạng " cao độ / khoảng cách "
-
1
-
-
phần mềm này hay quá bạn cho mail cho mình với được không mình đang làm hoàn công phân lớp thủ công oải quá
longnguyen4563@gmail.com
thanks bạn -
có thể sửa lisp này để đường bo sau khi hồi phục tự hợp lại 1 đường bao tổng ko vì nhìu khi đường hatch đc join từ nhìu hatch mà khôi phục xog nó ra 1 nùi đường bo khó xử lí quá
Hỏi Cách Sửa Lệnh Insert Block Trong Cad 2010 ->
trong AutoLisp
Đã đăng · Trả lời báo cáo
trong cad 2007 thì chỉ cần (command "INSERT" "tên block" (tọa độ base point) "hệ số scale" "angle" "nội dung block")
nhưng trong cad2010 thì chỗ hệ số scale phải nhập 2 lần vì nó phải nhập lần lượt scale theo phương x rồi y
mình muốn hỏi làm cách nào để sửa lệnh insert để cho cad2007 về giống 2010 hoặc từ cad 2010 về cad2007