Info | File | ||
Tác giả: Nguyen Hoanh Bài viết gốc: 14217 Tên lệnh: 00 |
Lisp Bigfont Unicode
Bạn chọn font chữ trọng mục Font name là Romans, sau đó click vào ô Use big font, bạn sẽ thấy tên file vừa copy nằm trong mục Font style.
| ||
Tác giả: trinhhoanghieu090 Bài viết gốc: 332846 Tên lệnh: clt |
Lisp nội suy cao độ thiết kế tim đường
(defun c:CLT (/ CAODO1 CAODO2 CAODO3 CHIEUCAO D D1 D2 DH DHZ ITEM1 ITEM2 PT1 PT2 PT3 STT TDO1 TDO2 TEMP1 TEMP2 X1 X2 X3 Y1 Y2 Y3 Z1 Z2 Z3 loop ) (defun *error* (msg) (if Olmode (setvar 'osmode Olmode) ) (if (not (member msg '("*BREAK,*CANCEL*,*EXIT*"))) (princ (strcat "\nError: " msg)) ) (princ) ... (defun c:CLT (/ CAODO1 CAODO2 CAODO3 CHIEUCAO D D1 D2 DH DHZ ITEM1 ITEM2 PT1 PT2 PT3 STT TDO1 TDO2 TEMP1 TEMP2 X1 X2 X3 Y1 Y2 Y3 Z1 Z2 Z3 loop ) (defun *error* (msg) (if Olmode (setvar 'osmode Olmode) ) (if (not (member msg '("*BREAK,*CANCEL*,*EXIT*"))) (princ (strcat "\nError: " msg)) ) (princ) ) (prompt "Made by thanhduan2407, Edit By trinhhoanghieu090") ; (or *chieucao* (setq *chieucao* 1)) ; (setq ; chieucao (getreal (strcat "\nNh\U+1EADp chi\U+1EC1u cao Text <" ; (rtos *chieucao* 2 2) ; "> :" ; ) ; ) ; ) ; (if (not chieucao) ; (setq chieucao *chieucao*) ; (setq *chieucao* chieucao) ; ) (setq Olmode (getvar "OSMODE")) (if (not sle) (setq sle 2) ) (setq sle0 (getint (strcat "\nChon So Le Thap Phan <" (itoa sle) ">: " ) ) ) (if sle0 (progn (if (< sle0 0) (setq sle0 0) ) (if (> sle0 10) (setq sle0 10) ) (setq sle sle0) ) ) (if (and (setq tdo1 (getpoint "\nChon Diem Thap:")) (setq item1 (entsel "\nChon Text Diem Thap:")) (setq tdo2 (getpoint "\nChon Diem Cao:")) (setq item2 (entsel "\nChon Text Diem Cao:")) ) (progn (progn (setq temp1 (entget (car item1))) ; (setq Tdo1 (TD:Text-Base (car item1))) (setq Caodo1 (cdr (assoc 1 temp1)) x1 (car Tdo1) y1 (cadr Tdo1) ) (setq pt1 (list x1 y1)) (setq z1 (atof Caodo1)) (setq temp2 (entget (car item2))) ; (setq Tdo2 (TD:Text-Base (car item2))) (setq Caodo2 (cdr (assoc 1 temp2)) x2 (car Tdo2) y2 (cadr Tdo2) ) (setq pt2 (list x2 y2)) (setq z2 (atof Caodo2)) ) (setq loop T) (while loop (setq pt3 (getpoint "\nChon Vi Tri Can Noi Suy Cao Do:" ) ) (cond (T (if pt3 (progn ; (setvar "OSMODE" 512) (setq x3 (car pt3)) (setq y3 (cadr pt3)) ; (setq d1 (distance pt1 pt3)) ; (setq d2 (distance pt2 pt3)) ; (setq d (+ d1 d2)) ; (setq dh (- z2 z1)) ; (setq dhz (* dh (/ d1 d))) ; (setq z3 (+ z1 dhz)) (setq d1 (distance pt1 pt2)) (setq d2 (distance pt1 pt3)) (setq dh (- z2 z1)) (setq dhz (* dh (/ d2 d1))) (setq z3 (+ z1 dhz)) (setq Caodo3 (rtos z3 2 sle)) ; (setq pt3 (getpoint pt3 "\nChon Diem Dat Cao Do:")) (setq pt3 (list (car pt3) (cadr pt3) z3)) (entmake (list (cons 0 "TEXT") (cons 10 pt3) (cons 1 Caodo3) (assoc 8 temp1) (assoc 7 temp1) (assoc 40 temp1) (assoc 50 temp1) ) ) ) (setq loop nil) ) ) ) ) ) ) (setvar "OSMODE" Olmode) (princ) ) Tặng bạn, mình đã làm cả cho trường hợp tổng quát nằm phía bên ngoài 2 đầu đoạn thẳng rồi đó (nhưng 3 điểm vẫn phải thẳng hàng thì nội suy mới đúng) <<
| ||
Tác giả: Nguyen Hoanh Bài viết gốc: 14224 Tên lệnh: 00 |
Tịnh tiến đường cong để tiếp xúc với đường thẳng
Xin lỗi, tôi đã hơi máy móc trong suy nghĩ. Với lisp trên, muốn cho đường cong tiếp xúc với đường thẳng bạn làm như sau: 1. Move đường cong đi 1 chút sao nó nằm trọn vẹn trong góc tạo bởi 2 đường thẳng (không giao với đường thẳng nào). 2. Vẽ 2 vector tịnh tiến bằng cách dùng 2 lần lệnh VTT với lần lượt 2 đường thẳng (sẽ tạo được 2 vector màu đỏ). >> Xin lỗi, tôi đã hơi máy móc trong suy nghĩ. Với lisp trên, muốn cho đường cong tiếp xúc với đường thẳng bạn làm như sau: 1. Move đường cong đi 1 chút sao nó nằm trọn vẹn trong góc tạo bởi 2 đường thẳng (không giao với đường thẳng nào). 2. Vẽ 2 vector tịnh tiến bằng cách dùng 2 lần lệnh VTT với lần lượt 2 đường thẳng (sẽ tạo được 2 vector màu đỏ). 3. Tạo vector tịnh tiến bằng tổng 2 vector tịnh tiến vừa vẽ (vector màu vàng). 4. Move đường cong theo vector tịnh tiến tổng (vector màu vàng). Đây là hình vẽ: http://www.cadviet.com/upfiles/vectotinhtien.gif <<
| ||
Tác giả: San_Mocmoc Bài viết gốc: 333679 Tên lệnh: pdm chuyencot |
Lisp phun điểm mia
Nhờ các anh chi em sưa giúp lisp phun diem mia. Mình muốn bỏ phần cao độ Z đi ;CHUONG TRINH PHUN DIEM MIA X,Y,Z ;CAC DIEM TRAM MAY CO CODE=1 SE DUOC NOI LAI VOI NHAU ;-------------DINH DANG MAU---------------------- ;TENDIEM X Y Z CODE ;KV1 0 0 0 1 ;KV2 10 0 0 1 ;1 5 10 0 ;2 10 ... Nhờ các anh chi em sưa giúp lisp phun diem mia. Mình muốn bỏ phần cao độ Z đi ;CHUONG TRINH PHUN DIEM MIA X,Y,Z ;CAC DIEM TRAM MAY CO CODE=1 SE DUOC NOI LAI VOI NHAU ;-------------DINH DANG MAU---------------------- ;TENDIEM X Y Z CODE ;KV1 0 0 0 1 ;KV2 10 0 0 1 ;1 5 10 0 ;2 10 6 0 ;KV3 10 10 0 1 (defun c:pdm (/ ms PR FN thunhat tentram caodotram xtram ytram htram tentrammay tendh ) (bdau) (setq tam ()) (setq i 0) ; (setq ms 1000) (setq FN (getfiled "NhËp file nguån : " "" "" 4 ) ) (SETQ MS (GETREAL "Nhap vao mau so ty le ban do : ")) (setq ms (* ms 2)) (progn (command "-osnap" "") (setvar "cmdecho" 0) (setvar "luprec" 8) (setvar "pdmode" 0) (command "-layer" "m" "diem" "c" "red" "" "") (command "-layer" "m" "caodo" "c" "cyan" "" "") (command "-layer" "m" "sothutu" "c" "magenta" "" "") (command "-layer" "m" "khongche" "c" "red" "" "") (setq st (/ ms 1000)) (setq st1 st) (command "-style" "diemmia" "txt.shx" st1 "1" "0" "n" "n" "n") (setq FN (open FN "r")) (while (and (setq PR (read-line FN)) (/= PR "")) (progn (setq PR (strcat "(" PR ")")) (setq PR (read PR)) (thuchien) (if (= (nth 4 PR) 1);neu code= 1 thi ve (ve) ) ) ;end progn ) ;end while );end progn (close FN) (command "zoom" "e") (kthuc) (princ) ) (defun thuchien (/ TEN ) (setq ten (convtostr (nth 0 PR)));chuyen tu symbol sang string (setq td (list (nth 2 PR) (nth 1 PR) (nth 3 PR))) (setq tam (append tam td));dua toa do diem thu n vao trong list tam (command "-layer" "s" "diem" "") (command "point" td) (command "-style" "diemmia" "txt.shx" st1 "1" "0" "n" "n" "n") (command "-layer" "s" "sothutu" "") (command "text" td "" ten) (command "-style" "diemmia" "txt.shx" st1 "1" "0" "n" "n" "n") (command "-layer" "s" "caodo" "") (command "text" "tl" td "" (rtos (nth 3 PR) 2 1)) ) (defun ve () (setq diemcuoi td) (if (/= i 0) (progn (command "line" diemdau diemcuoi "") ) ) (setq diemdau diemcuoi) (setq i (+ i 1)) ) ;CHUONG TRINH CHUYEN HAI COT X VA Y CHO NHAU ;---------DINH DANG MAU---------- ;TEN X Y Z CODE ;KV1 100.00 50.00 1.5 1 ;KV2 200.00 31.00 2.1 (defun c:chuyencot(/ FN FD i ch PR TEN X Y Z CODE TD XUAT) (setq FN (getfiled "NhËp file nguån : " "" "" 4 ) ) (setq i (strlen FN)) (setq ch "") (while (/= ch "\\") (setq ch (substr FN i 1)) (setq i (- i 1)) ) (setq xuat (substr FN 1 (+ i 1))) (setq FD (getstring "Nhap ten file ket qua : ")) (setq FD (strcat xuat FD)) (setq FD (open FD "w")) (setq FN (open FN "r")) (while (and (setq PR (read-line FN)) (/= PR "")) (progn (setq PR (strcat "(" PR ")")) (setq PR (read PR)) (setq ten (dd (convtostr (nth 0 PR)))) (setq x (dd (convtostr (nth 1 PR)))) (setq y (dd (convtostr (nth 2 PR)))) (setq z (dd (convtostr (nth 3 PR)))) (setq code (nth 4 PR)) (if (/= code nil) (setq td (strcat ten y x z (convtostr code))) (setq td (strcat ten y x z)) ) (write-line td FD) ) ;end progn ) ;end while (close FD) (close FN) ) (defun bdau () (command "_.undo" "begin") (setq cmd (getvar "cmdecho")) (setq plwid (getvar "plinewid")) (setq elev (getvar "elevation")) (setq thick (getvar "thickness")) (setq hh (getvar "osmode")) (setq clay (getvar "clayer")) ) (defun kthuc () (command "plinewid" plwid) (command "elevation" elev) (command "thickness" thick) (command "osmode" hh) (command "_.undo" "end") (command "clayer" clay) (command "cmdecho" cmd) ) (defun ConvtoStr (Sym) (setq ftemp "temp.tmp") (setq ftmp (open ftemp "w")) (princ Sym ftmp) (close ftmp) (setq ftmp (open ftemp "r")) (setq sym (read-line ftmp)) (close ftmp) (princ sym) ) (defun *error*(msg) (princ "\nerror:") (princ msg) (command "osmode" h "") (command "_.undo" "end") (command "clayer" clay) (command "u" "") (alert " - - - - ha ha ha- - - - <Chaudaubac 0913.167111> ") (setq *error* olderr) (princ) ) (defun dd (nhap) (setq len (strlen nhap)) (cond ((= len 1)(setq xuat (strcat nhap " "))) ((= len 2)(setq xuat (strcat nhap " "))) ((= len 3)(setq xuat (strcat nhap " "))) ((= len 4)(setq xuat (strcat nhap " "))) ((= len 5)(setq xuat (strcat nhap " "))) ((= len 6)(setq xuat (strcat nhap " "))) ((= len 7)(setq xuat (strcat nhap " "))) ((= len 8)(setq xuat (strcat nhap " "))) ((= len 9)(setq xuat (strcat nhap ""))) ) ) ________________________________________________ File So Lieu 1 2339097.81 549068.55 1 <<
| ||
Tác giả: nhoclangbat Bài viết gốc: 333832 Tên lệnh: kkl |
[Yêu cầu] viết lisp vẽ Point có cao độ Z
- ý bạn phải vậy hem ^^ (defun c:kkl (/ te1 te2 pt *error* dxf1 dxf2) ;=================================================================== (defun *error* ( msg ) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " msg)) ) (princ) ) ;================================================================== (while (and (setq te1 (car (entsel "\nChon text 1"))) (setq te2(car... - ý bạn phải vậy hem ^^ (defun c:kkl (/ te1 te2 pt *error* dxf1 dxf2) ;=================================================================== (defun *error* ( msg ) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " msg)) ) (princ) ) ;================================================================== (while (and (setq te1 (car (entsel "\nChon text 1"))) (setq te2(car (entsel "\nChon text 2"))) (setq pt (getpoint "\nChon diem dat point :"))) ;///////////////////////////////// (setq dxf1 (cdr (assoc 1 (entget te1))) dxf2 (cdr (assoc 1 (entget te2)))) (setq caodo (- (* (distof dxf1) -1) (/ (distof dxf2) 10.0))) (setq pt (subst caodo (last pt) pt)) (entmake (list (cons 0 "POINT") (cons 100 "AcDbPoint") (cons 10 pt) )) ) (princ) ) <<
| ||
Tác giả: Tue_NV Bài viết gốc: 52873 Tên lệnh: lte |
Lisp vẽ 1 đường Line(có 2 đoạn) sau đó cho phép người dùng nhập ký tự vào 2 text1, text2
Đây bạn : Điều kiện 2 : Chỉ cần Line2 song song với line là đủ rồi bạn ạ Bạn nên rút kinh nghiệm khi post bài phải nói rõ ràng nhé : Chúc thành công.
| ||
Tác giả: nhoclangbat Bài viết gốc: 333957 Tên lệnh: cdx |
Lisp điền cao độ bị lỗi!!!
- ngón này nhoc ko rành lắm, nhoc thử sữa lại theo ý bạn, bạn xem có đúng ko ^^, nhoc chỉ sợ lượt bớt nhiều quá làm sai kết quả ^^ (defun DXFcn (code elist) (cdr (assoc code elist))) ;============================================================ (prompt "\n - GHI CAO DO DIEM TREN TRAC NGANG by Thaistreetz - huuthais@yahoo.com\n") ;============================================================ (defun c:Cdx (/ DZ pt ptside ang... - ngón này nhoc ko rành lắm, nhoc thử sữa lại theo ý bạn, bạn xem có đúng ko ^^, nhoc chỉ sợ lượt bớt nhiều quá làm sai kết quả ^^ (defun DXFcn (code elist) (cdr (assoc code elist))) ;============================================================ (prompt "\n - GHI CAO DO DIEM TREN TRAC NGANG by Thaistreetz - huuthais@yahoo.com\n") ;============================================================ (defun c:Cdx (/ DZ pt ptside ang OT sc1 scale tx ty tx1 ty1 y H0) ; (command "Undo" "BEGIN") (if (= tx nil) (setq tx 1)) (if (= ty nil) (setq ty 1)) (setq tx1 (getreal (strcat "\nTy le theo phuong X <1/"(rtos tx 2 2)">: 1/")) ty1 (getreal (strcat "\nTy le theo phuong Y <1/"(rtos ty 2 2)">: 1/")) ) (if tx1 (setq tx tx1)) (if ty1 (setq ty ty1)) (setq ATLAST (getvar "Attreq")) (setq CMLAST (getvar "cmdecho")) (setq OSLAST (getvar "OSMODE")) (setq DZ (getvar "DIMZIN")) (setq OT (getvar "ORTHOMODE")) (setvar "ORTHOMODE" 0) (setvar "cmdecho" 0) (command "osmode" 99) (setq pt0 (osnap (getpoint "Diem tim TN tu nhien") "end")) (print) (setq x0 (car pt0) y0 (cadr pt0)) ;(setvar 'osmode 0) (setq ed (entget (car (entsel "\nChon cao do tim: ")))) (setq H0 (read (DXFcn 1 ed))) (While (and (setq pt (getpoint "\nChon diem chuan : ")) (setq doitt (car (entsel "\nChon text de chinh sua: ")))) (Progn (setq y (- (cadr pt) y0 (- H0))) (cond ((> y 0) (entmod (subst (cons 1 (strcat "+" (rtos (* y ty) 2 2))) (assoc 1 (entget doitt)) (entget doitt)))) ((< y 0) (entmod (subst (cons 1 (rtos (* y ty) 2 2)) (assoc 1 (entget doitt)) (entget doitt)))) ((= y 0) (entmod (subst (cons 1 "%%p0.00") (assoc 1 (entget doitt)) (entget doitt)))) ) );progn );while (setvar "OSMODE" OSLAST)(setvar "ORTHOMODE" OT)(setvar "cmdecho" CMLAST) (prompt "\n by Thaistreetz - huuthais@yahoo.com\n") (command "Undo" "End") (princ) );end <<
| ||
Tác giả: quansla Bài viết gốc: 334050 Tên lệnh: taodim |
Tạo hàm Lisp từ các lệnh của cad
Không ngưng học hỏi bạn ạ,tích luỹ dần dần rồi sẽ có thôi C1/ Dành cho việc tự nghiên cứu, không dùng tài liệu, Chịu khó khi mở Cad, tìm hiểu các biến liên quan của Cad, ví dụ bạn có thể (với cad đời cao - ví dụ 2012 như máy mình) : mở hộp thoại Dimmentision Mânger di chuột lại gần một thiết lập nào đó, dừng chuột lại đó chờ cho trợ giúp của Cad hiện nên (rất nhanh, khoảng 1-1.5 s thôi) trong đó có thể sẽ có biến liên quan đến thông số đó mà bạn cần. ví dụ DimGap khi di chuột lại gần thông số khoảng cách TextDim và đường ghi kích thước. C2/ Bạn hãy sử dụng lệnh "SYSVDLG" (hoặc menu Express Tool / System variable Editor...) để có thông số về toàn bộ biến của Cad, cùng các trợ giúp liên quan. Bạn có thể sửa giá trị của chúng lẻ lẻ ra ví dụ 1,321342342 sau đó suất ra tập tin svf(sau này cần đổi lại thành txt để đọc) để dễ tìm giá trị của chúng khi thay đổi, hoặc tinh ý tìm ra thay đổi của chúng trên bản vẽ. C3/ Đọc Help của Cad, dò thông tin trên mạng. Hỏi trực tiếp khi gặp vướng mắc. trên là cách mà mình tìm hiểu biến hệ thống của Cad ngày trước, khá hữu ích. Bạn muón sửa thông số Cad có thể sử dụng cách này. Đương nhiên sẽ có nhiều thông số mà bạn không tìm được (không có, không dễ thấy) . bạn có thể tìm cách thiết lập chúng bằng nhiều cách khác. Chẳng hạn dùng lệnh (Scrip/ Líp/ VBA) thực hiện lệnh để làm thiết lập lần lượt như khi thực hiện thủ công Tham khảo nha: Tạo dim style (defun c:taodim() (setvar "cmdecho" 0) (command "DIMBLK" "archtick" "DIMASZ" 1.2 "DIMCEN" 2 "DIMTIH" "off" "DIMTDEC" 2 "DIMZIN" 8 "DIMAZIN" 2 "DIMTOH" "off" "DIMTIH" "off" "DIMDEC" 2 "DIMCLRT" 6 "DIMTIX" "on" "DIMTXT" 2.5 "DIMTAD" 1 "DIMGAP" 0.5 "DIMCLRD" 8 "DIMLTYPE" "bylayer" "DIMLWD" -1 "DIMDLE" 1 ;"DIMSCALE" 100 "DIMCLRE" 8 "DIMLTEX1" "bylayer" "DIMLTEX2" "bylayer" "DIMEXE" 1 "DIMEXO" 0 "DIMLWE" -1 "DIMATFIT" 3 "DIMTMOVE" 0 "DIMTOFL" "on" "DIMDEC" 2 "DIMDSEP" "." "DIMLUNIT" 2 "DIMLWD" -1 "DIMLWE" -1 "DIMJUST" 0 "DIMTAD" 1 "DIMTFILL" 0 ) (IF (NOT (TBLSEARCH "STYLE" "DIM")) (command "-style" "DIM" "tahoma.TTF" "" "" "" "" "" (while (> (getvar "cmdactive") 0) (command "")) ) ) (COMMAND "DIMTXSTY" "DIM") (if (not (tblsearch "DIMSTYLE" "xxxxx100")) (Command ".dimstyle" "s" "xxxxx100") ) (prompt "da tao xong dim xxxxx100 " ) (setvar "cmdecho" 1) (princ) ) hoặc ví dụ về tạo Text Style (defun taotxt(name font txh ) (IF (NOT (TBLSEARCH "STYLE" name )) (command "-style" name font txh "" "" "" "" (while (> (getvar "cmdactive") 0)(command "")) ) ) ) (defun c:taotxt() (tblsearch "style" "t3") (setvar "cmdecho" 0) (taotxt "Dim" "vnromadi.shx" 0 ) (taotxt "Dim2" "tvsimli.shx" 0 ) (taotxt "T1" "vnromadi.shx" 0 ) (taotxt "T2" "VHHELS.TTF" 0 ) (taotxt "T3" "VHAVAN.TTF" 0 ) (princ "\nda tao xong cac text Style ") (setvar "cmdecho" 1) (princ) ) <<
| ||
Tác giả: quansla Bài viết gốc: 334050 Tên lệnh: taotxt |
Tạo hàm Lisp từ các lệnh của cad
Không ngưng học hỏi bạn ạ,tích luỹ dần dần rồi sẽ có thôi C1/ Dành cho việc tự nghiên cứu, không dùng tài liệu, Chịu khó khi mở Cad, tìm hiểu các biến liên quan của Cad, ví dụ bạn có thể (với cad đời cao - ví dụ 2012 như máy mình) : mở hộp thoại Dimmentision Mânger di chuột lại gần một thiết lập nào đó, dừng chuột lại đó chờ cho trợ giúp của Cad hiện nên (rất nhanh, khoảng 1-1.5 s thôi) trong đó có thể sẽ có biến liên quan đến thông số đó mà bạn cần. ví dụ DimGap khi di chuột lại gần thông số khoảng cách TextDim và đường ghi kích thước. C2/ Bạn hãy sử dụng lệnh "SYSVDLG" (hoặc menu Express Tool / System variable Editor...) để có thông số về toàn bộ biến của Cad, cùng các trợ giúp liên quan. Bạn có thể sửa giá trị của chúng lẻ lẻ ra ví dụ 1,321342342 sau đó suất ra tập tin svf(sau này cần đổi lại thành txt để đọc) để dễ tìm giá trị của chúng khi thay đổi, hoặc tinh ý tìm ra thay đổi của chúng trên bản vẽ. C3/ Đọc Help của Cad, dò thông tin trên mạng. Hỏi trực tiếp khi gặp vướng mắc. trên là cách mà mình tìm hiểu biến hệ thống của Cad ngày trước, khá hữu ích. Bạn muón sửa thông số Cad có thể sử dụng cách này. Đương nhiên sẽ có nhiều thông số mà bạn không tìm được (không có, không dễ thấy) . bạn có thể tìm cách thiết lập chúng bằng nhiều cách khác. Chẳng hạn dùng lệnh (Scrip/ Líp/ VBA) thực hiện lệnh để làm thiết lập lần lượt như khi thực hiện thủ công Tham khảo nha: Tạo dim style (defun c:taodim() (setvar "cmdecho" 0) (command "DIMBLK" "archtick" "DIMASZ" 1.2 "DIMCEN" 2 "DIMTIH" "off" "DIMTDEC" 2 "DIMZIN" 8 "DIMAZIN" 2 "DIMTOH" "off" "DIMTIH" "off" "DIMDEC" 2 "DIMCLRT" 6 "DIMTIX" "on" "DIMTXT" 2.5 "DIMTAD" 1 "DIMGAP" 0.5 "DIMCLRD" 8 "DIMLTYPE" "bylayer" "DIMLWD" -1 "DIMDLE" 1 ;"DIMSCALE" 100 "DIMCLRE" 8 "DIMLTEX1" "bylayer" "DIMLTEX2" "bylayer" "DIMEXE" 1 "DIMEXO" 0 "DIMLWE" -1 "DIMATFIT" 3 "DIMTMOVE" 0 "DIMTOFL" "on" "DIMDEC" 2 "DIMDSEP" "." "DIMLUNIT" 2 "DIMLWD" -1 "DIMLWE" -1 "DIMJUST" 0 "DIMTAD" 1 "DIMTFILL" 0 ) (IF (NOT (TBLSEARCH "STYLE" "DIM")) (command "-style" "DIM" "tahoma.TTF" "" "" "" "" "" (while (> (getvar "cmdactive") 0) (command "")) ) ) (COMMAND "DIMTXSTY" "DIM") (if (not (tblsearch "DIMSTYLE" "xxxxx100")) (Command ".dimstyle" "s" "xxxxx100") ) (prompt "da tao xong dim xxxxx100 " ) (setvar "cmdecho" 1) (princ) ) hoặc ví dụ về tạo Text Style (defun taotxt(name font txh ) (IF (NOT (TBLSEARCH "STYLE" name )) (command "-style" name font txh "" "" "" "" (while (> (getvar "cmdactive") 0)(command "")) ) ) ) (defun c:taotxt() (tblsearch "style" "t3") (setvar "cmdecho" 0) (taotxt "Dim" "vnromadi.shx" 0 ) (taotxt "Dim2" "tvsimli.shx" 0 ) (taotxt "T1" "vnromadi.shx" 0 ) (taotxt "T2" "VHHELS.TTF" 0 ) (taotxt "T3" "VHAVAN.TTF" 0 ) (princ "\nda tao xong cac text Style ") (setvar "cmdecho" 1) (princ) ) <<
| ||
Tác giả: nhoclangbat Bài viết gốc: 334067 Tên lệnh: kko |
Nhờ viết LISP xuất dữ liệu ra file excel
- hi mấy lsp dạng này trên 4rum mình nhiều lắm, tết rãnh nhoc luyện viết thử xem ^^ ;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/119469-nho-viet-lisp-xuat-du-lieu-ra-file-excel/ (defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename (setq i 0) (repeat (sslength ss) (setq e (ssname ss i) Le (append Le (list e)) i (1+ i)... - hi mấy lsp dạng này trên 4rum mình nhiều lắm, tết rãnh nhoc luyện viết thử xem ^^ ;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/119469-nho-viet-lisp-xuat-du-lieu-ra-file-excel/ (defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename (setq i 0) (repeat (sslength ss) (setq e (ssname ss i) Le (append Le (list e)) i (1+ i) )) Le) ;================================================================================= (defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))) ;======================================================================= (defun c:kko (/ ss ds_ent ds_laydis layer dis info) (prompt "Quet chon cac Multiline ") (setq ss (ssget '( (0 . "MLINE")))) (if ss (progn (setq ds_ent (ss2ent ss)) (foreach k ds_ent (setq info (entget k)) (setq layer (acet-dxf 8 info)) (setq dis (add_mline info)) (setq ds_laydis (append ds_laydis (list (list layer dis)))) ) ) ) (xls ds_laydis '("LAYER" "CHIEU DAI") nil "Thong ke") ;(princ ds_laydis) (princ) ) ;============================================================================================================================================== (vl-load-com) (defun xls (Data-list header Colhide Name_list / *aplexcel* *books-colection* Currsep *excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols ) (defun Letter (N / Res TMP) (setq Res "") (while (> N 0) (setq TMP (rem N 26) TMP (if (zerop TMP) (setq N (1- N) TMP 26 ) TMP ) Res (strcat (chr (+ 64 TMP)) Res) N (/ N 26) ) ) Res ) (if (null Name_list) (setq Name_list "") ) (setq *AplExcel* (vlax-get-or-create-object "Excel.Application")) (if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook")) (setq *Books-Colection* (vlax-get-property *AplExcel* "Workbooks") *Sheet-Collection* (vlax-get-property *New-Book* "Sheets") *Sheet#1* (vlax-invoke-method *Sheet-Collection* "Add") ) (setq *Books-Colection* (vlax-get-property *AplExcel* "Workbooks") *New-Book* (vlax-invoke-method *Books-Colection* "Add") *Sheet-Collection* (vlax-get-property *New-Book* "Sheets") *Sheet#1* (vlax-get-property *Sheet-Collection* "Item" 1) ) ) (setq *excell-cells* (vlax-get-property *Sheet#1* "Cells")) (setq Name_list (if (= Name_list "") (vl-filename-base (getvar "DWGNAME")) (strcat (vl-filename-base (getvar "DWGNAME")) "&" Name_list ) ) col 0 cols nil ) (if (> (strlen Name_list) 26) (setq Name_list (strcat (substr Name_list 1 10) "..." (substr Name_list (- (strlen Name_list) 13) 14) ) ) ) (vlax-for sh *Sheet-Collection* (setq cols (cons (strcase (vlax-get-property sh 'Name)) cols)) ) (setq row Name_list) (while (member (strcase row) cols) (setq row (strcat Name_list " (" (itoa (setq col (1+ col))) ")")) ) (setq Name_list row) (vlax-put-property *Sheet#1* 'Name Name_list) (setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators")) (vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false ) ;_?? ???????????? ????????? ????????? (vlax-put-property *AplExcel* "DecimalSeparator" ".") ;_??????????? ??????? ? ????? ????? (vlax-put-property *AplExcel* "ThousandsSeparator" " ") ;_??????????? ???¤??? (vla-put-visible *AplExcel* :vlax-true) (setq row 1 col 1 ) (if (null header) (setq header '("X" "Y" "Z")) ) (repeat (length header) (vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (nth (1- col) header)) ) (setq col (1+ col)) ) (setq row 2 col 1 ) (repeat (length Data-list) (setq iz_listo (car Data-list)) (repeat (length iz_listo) (vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)) ) (setq iz_listo (cdr iz_listo) col (1+ col) ) ) (setq Data-list (cdr Data-list)) (setq col 1 row (1+ row) ) ) (setq col (1+ (length header)) row (1+ row) ) (setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate" (strcat "A1:" (letter col) (itoa row)) ) ) ) ;_ end of setq (setq cols (vlax-get-property cell 'Columns)) (vlax-invoke-method cols 'Autofit) (vlax-release-object cols) (vlax-release-object cell) (foreach item ColHide (if (numberp item) (setq item (letter item)) ) (setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate" (strcat item "1:" item "1") ) ) ) (setq cols (vlax-get-property cell 'Columns)) (vlax-put-property cols 'hidden 1) (vlax-release-object cols) (vlax-release-object cell) ) (vlax-put-property *AplExcel* "UseSystemSeparators" Currsep) (mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection* *AplExcel* ) ) (setq *AplExcel* nil) (gc) (gc) (princ) ) ;////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ;http://www.cadviet.com/forum/topic/763-routine-tinh-tong-chieu-dai-cac-doi-tuong/ (defun add_mline ( elist / pt1 mline_len pt2 tot_len) (setq tot_len 0.0) (foreach k elist (cond ((= 10 (car k)) (setq pt1 (cdr k) mline_len 0.0 ) ) ((= 11 (car k)) (setq pt2 (cdr k) mline_len (+ mline_len (distance pt2 pt1)) pt1 pt2 ) ) ) ) (setq tot_len (+ tot_len mline_len)) ) <<
| ||
Tác giả: nhoclangbat Bài viết gốc: 334134 Tên lệnh: kko |
Nhờ viết LISP xuất dữ liệu ra file excel
- hi công nhận viết mấy lsp dạng xử lý danh sách nhức đầu thật, nhoc còn yếu khoảng này ^^, nhìn vô thì thêm có mấy dòng mà mất cả sáng mới nghĩ ra ^^, bạn test thử xem hen ^^ (defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename (setq i 0) (repeat (sslength ss) (setq e (ssname ss i) Le (append Le (list e)) i (1+ i) ... - hi công nhận viết mấy lsp dạng xử lý danh sách nhức đầu thật, nhoc còn yếu khoảng này ^^, nhìn vô thì thêm có mấy dòng mà mất cả sáng mới nghĩ ra ^^, bạn test thử xem hen ^^ (defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename (setq i 0) (repeat (sslength ss) (setq e (ssname ss i) Le (append Le (list e)) i (1+ i) )) Le) ;================================================================================= (defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))) ;======================================================================= (defun c:kko (/ ss ds_ent ds_laydis layer dis info ds_tk ten_layer sl ds_new ko ds_tkk k1 k2 k3 K_join_ds) ;============================ (defun K_join_ds ( lst1 lst2 / tam i ds_moi) (setq i 0) (foreach m lst1 (setq tam (append (nth i lst2) (list m))) (setq ds_moi (append ds_moi (list tam))) (setq i (1+ i)) ) ds_moi) ;================================================ (prompt "Quet chon cac Multiline ") (setq ss (ssget '( (0 . "MLINE")))) (if ss (progn (setq ds_ent (ss2ent ss)) (foreach k ds_ent (setq info (entget k)) (setq layer (acet-dxf 8 info)) (setq dis (add_mline info)) (setq ds_laydis (append ds_laydis (list (list layer dis)))) ) (setq ds_new (LM:_UniqueFuzz ds_laydis 0.00001)) (setq sl (mapcar '(lambda (z) (apply '+ (mapcar '(lambda (j) (if (equal j z 0.00001) 1 0)) ds_laydis))) ds_new)) (setq ds_tk (K_join_ds sl ds_new)) (foreach u ds_tk (setq k1 (LM:InsertNth "\t" 1 u) k2 (LM:InsertNth "\t" 2 k1) k3 (LM:InsertNth "\t" 4 k2)) (setq ds_tkk (append ds_tkk (list k3))) ) ) ) (xls ds_tkk '("LAYER" "\t" "\t" "CHIEU DAI" "\t" "SO LUONG") nil "Thong ke") (princ) ) ;============================================================================================================================ (defun LM:InsertNth ( x n l ) ( (lambda ( i ) (apply 'append (mapcar '(lambda ( a ) (if (= n (setq i (1+ i))) (list x a) (list a))) l) ) ) -1 ) ) ;============================================================================================================================================ (defun LM:_UniqueFuzz ( l fz ) (if l (cons (car l) (LM:_UniqueFuzz (vl-remove-if '(lambda ( x ) (equal x (car l) fz)) (cdr l)) fz ) ) ) ) ;============================================================================================================================================== (vl-load-com) (defun xls (Data-list header Colhide Name_list / *aplexcel* *books-colection* Currsep *excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols ) (defun Letter (N / Res TMP) (setq Res "") (while (> N 0) (setq TMP (rem N 26) TMP (if (zerop TMP) (setq N (1- N) TMP 26 ) TMP ) Res (strcat (chr (+ 64 TMP)) Res) N (/ N 26) ) ) Res ) (if (null Name_list) (setq Name_list "") ) (setq *AplExcel* (vlax-get-or-create-object "Excel.Application")) (if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook")) (setq *Books-Colection* (vlax-get-property *AplExcel* "Workbooks") *Sheet-Collection* (vlax-get-property *New-Book* "Sheets") *Sheet#1* (vlax-invoke-method *Sheet-Collection* "Add") ) (setq *Books-Colection* (vlax-get-property *AplExcel* "Workbooks") *New-Book* (vlax-invoke-method *Books-Colection* "Add") *Sheet-Collection* (vlax-get-property *New-Book* "Sheets") *Sheet#1* (vlax-get-property *Sheet-Collection* "Item" 1) ) ) (setq *excell-cells* (vlax-get-property *Sheet#1* "Cells")) (setq Name_list (if (= Name_list "") (vl-filename-base (getvar "DWGNAME")) (strcat (vl-filename-base (getvar "DWGNAME")) "&" Name_list ) ) col 0 cols nil ) (if (> (strlen Name_list) 26) (setq Name_list (strcat (substr Name_list 1 10) "..." (substr Name_list (- (strlen Name_list) 13) 14) ) ) ) (vlax-for sh *Sheet-Collection* (setq cols (cons (strcase (vlax-get-property sh 'Name)) cols)) ) (setq row Name_list) (while (member (strcase row) cols) (setq row (strcat Name_list " (" (itoa (setq col (1+ col))) ")")) ) (setq Name_list row) (vlax-put-property *Sheet#1* 'Name Name_list) (setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators")) (vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false ) ;_?? ???????????? ????????? ????????? (vlax-put-property *AplExcel* "DecimalSeparator" ".") ;_??????????? ??????? ? ????? ????? (vlax-put-property *AplExcel* "ThousandsSeparator" " ") ;_??????????? ???¤??? (vla-put-visible *AplExcel* :vlax-true) (setq row 1 col 1 ) (if (null header) (setq header '("X" "Y" "Z")) ) (repeat (length header) (vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (nth (1- col) header)) ) (setq col (1+ col)) ) (setq row 2 col 1 ) (repeat (length Data-list) (setq iz_listo (car Data-list)) (repeat (length iz_listo) (vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)) ) (setq iz_listo (cdr iz_listo) col (1+ col) ) ) (setq Data-list (cdr Data-list)) (setq col 1 row (1+ row) ) ) (setq col (1+ (length header)) row (1+ row) ) (setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate" (strcat "A1:" (letter col) (itoa row)) ) ) ) ;_ end of setq (setq cols (vlax-get-property cell 'Columns)) (vlax-invoke-method cols 'Autofit) (vlax-release-object cols) (vlax-release-object cell) (foreach item ColHide (if (numberp item) (setq item (letter item)) ) (setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate" (strcat item "1:" item "1") ) ) ) (setq cols (vlax-get-property cell 'Columns)) (vlax-put-property cols 'hidden 1) (vlax-release-object cols) (vlax-release-object cell) ) (vlax-put-property *AplExcel* "UseSystemSeparators" Currsep) (mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection* *AplExcel* ) ) (setq *AplExcel* nil) (gc) (gc) (princ) ) ;////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ;http://www.cadviet.com/forum/topic/763-routine-tinh-tong-chieu-dai-cac-doi-tuong/ (defun add_mline ( elist / pt1 mline_len pt2 tot_len) (setq tot_len 0.0) (foreach k elist (cond ((= 10 (car k)) (setq pt1 (cdr k) mline_len 0.0 ) ) ((= 11 (car k)) (setq pt2 (cdr k) mline_len (+ mline_len (distance pt2 pt1)) pt1 pt2 ) ) ) ) (setq tot_len (+ tot_len mline_len)) ) <<
| ||
Tác giả: Nguyen Hoanh Bài viết gốc: 334292 Tên lệnh: spa |
Tăng tốc (làm nhẹ) AutoCAD
Nhiều người sử dụng AutoCAD phiên bản mới trên các máy có cấu hình không cao. Hệ quả là máy sẽ giật và chậm. Trong bài viết ACAD đời mới chạy trên máy đời cũ Đã hướng dẫn cách làm nhẹ phần mềm AutoCAD, tuy nhiên, mỗi lần làm lại phải rà soát nhiều tên biến. Lisp dưới đây với... >> Nhiều người sử dụng AutoCAD phiên bản mới trên các máy có cấu hình không cao. Hệ quả là máy sẽ giật và chậm. Trong bài viết ACAD đời mới chạy trên máy đời cũ Đã hướng dẫn cách làm nhẹ phần mềm AutoCAD, tuy nhiên, mỗi lần làm lại phải rà soát nhiều tên biến. Lisp dưới đây với mục đích làm nhẹ AutoCAD bằng cách thay đổi các biến hệ thống, và thực hiện các lệnh để giảm bớt một số tính năng về hiển thị và quản lý trong AutoCAD nhưng về cơ bản không hạn chế các tính năng liên quan đến công việc của AutoCAD. Tên lệnh là SPA (Speed uP Autocad) (defun c:spa ( / svl cml rgl old x) (setq svl '( ("DYNMODE" . 0) ("QPMODE" . 0) ("DRAWORDERCTL" . 0) ("HPDLGMODE" . 1) ("UCSDETECT" . 0) ("LAYERDLGMODE" . 0) ("ROLLOVERTIPS" . 0) ("SELECTIONCYCLING" . 0) ("LOCKUI" . 15) ("LAYERDLGMODE" . 0) ("HPQUICKPREVIEW" . 0) ("NAVVCUBEDISPLAY" . 0) ("NAVBARDISPLAY" . 0) ("INDEXCTL" . 3) ("GRIPOBJLIMIT" . 0) ("SIGWARN" . 0) ("PALETTEOPAQUE" . 1) ("SELECTIONAREA" . 0) ("MAXACTVP" . 5) ("LWDISPLAY" . 0) ("VTENABLE" . 0) ) cml '( (".IMAGEQUALITY" "DRAFT") (".VIEWRES" "Y" "20") ) rgl '( ("InfoCenter" "InfoCenterOn" 0) ) ) (setq old (getvar "cmdecho")) (setvar "cmdecho" 0) (mapcar 'setvar (mapcar 'car svl) (mapcar 'cdr svl)) (foreach x cml (mapcar 'command x)) (foreach x rgl (vl-registry-write (strcat "HKEY_CURRENT_USER" (chr 92) (vlax-user-product-key) (chr 92) (nth 0 x)) (nth 1 x) (nth 2 x))) (setvar "cmdecho" old) (alert "\u+0110\u+00E3 ho\u+00E0n t\u+1EA5t thi\u+1EBFt l\u+1EADp \u+0111\u+1EC3 AutoCAD nh\u+1EB9 h\u+01A1n") (princ) ) <<
| ||
Tác giả: thanhduan2407 Bài viết gốc: 333676 Tên lệnh: 00 |
BÀI TOÁN XỬ LÝ DANH SÁCH
Chào các anh/chị/em! Em đang viết 1 chương trình tính diện tích hàng loạt dựa trên một thuật toán nhưng em đang vướng ở khâu xử lý danh sách. Trong file đính kèm em mô tả và có hình vẽ chi tiết nên các bác xem có thể trợ giúp em được cách xử lý không ạ? Em cảm ơn các bác nhiều! >> Chào các anh/chị/em! Em đang viết 1 chương trình tính diện tích hàng loạt dựa trên một thuật toán nhưng em đang vướng ở khâu xử lý danh sách. Trong file đính kèm em mô tả và có hình vẽ chi tiết nên các bác xem có thể trợ giúp em được cách xử lý không ạ? Em cảm ơn các bác nhiều! http://www.cadviet.com/upfiles/4/36665_danh_sach_tao_vung_2.dwg (defun C:00 ( / FLAT I ID ID+1 L1 L2 LTSREPNT_) (setq i 0) (setq l2 (list)) (setq LtsRePnt_ (list '(1 2 3) '(2 6 4 1) '(3 4 5 1) '(4 6 3 2) '(5 7 3) '(6 7 4 2) '(7 5 6))) (while (< i (- (length LtsRePnt_) 1)) (setq l1 (list)) (setq Flat nil) (setq ID (car (nth i LtsRePnt_))) (setq ID+1 (cadr (nth i LtsRePnt_))) ;;(LM:sublst LtsRePnt_ 2 (- (length LtsRePnt_) 2)) (setq l1 (list ID ID+1)) (setq j 0) (while (and (< j (- (length LtsRePnt_) 1)) (< ID ID+1) (>= j i)) (progn (foreach Lts1 (LM:sublst LtsRePnt_ (- ID+1 1) (- (length LtsRePnt_) (- ID+1 1))) (if (equal (+ (GetVitribyItem ID+1 lts1) 1) (GetVitribyItem ID lts1) ) (progn (setq ID ID+1) (setq ID+1 (mapcar '(lambda (x)(nth (+ (GetVitribyItem ID+1 x) 1) x)) (LM:sublst LtsRePnt_ (- ID 1) (- (length LtsRePnt_) (- ID 1))))) (setq l1 (append (list ID) (list ID+1))) ) ) ;;; (if (not (equal (+ (GetVitribyItem ID+1 lts1) 1) (GetVitribyItem ID lts1) )) ;;; (progn ;;; (setq ID ID+1) ;;; (setq ID+1 (nth (- (GetVitribyItem ID lts1) 1) lts1)) ;;; (setq l1 (list ID ID+1)) ;;; ) ;;; ) ) ) (setq Flat T) (setq j (1+ j)) ) (setq l2 (append l2 (list l1))) (setq i (1+ i)) ) (princ l2) (textscr) (princ) ) ;;;;TIM VI TRI TRONG DANH SACH ;;(GetVitribyItem "D" (list 2 3 4 "D" "R" "er")) (defun GetVitribyItem (Item Ltstim / i ) (setq i 0) (while (<= i (length Ltstim)) (if (equal Item (nth i Ltstim)) (setq Vtri i) ) (setq i (1+ i)) ) Vtri ) ;;;(LM:sublst '(1 2 3 4 5 6 7 8) 2 4) ;;;(LM:sublst '(1 2 3 4 5 6 7 8) 2 nil) (defun LM:sublst ( lst idx len / rtn ) (setq len (if len (min len (- (length lst) idx)) (- (length lst) idx)) idx (+ idx len) ) (repeat len (setq rtn (cons (nth (setq idx (1- idx)) lst) rtn))) ) <<
| ||
Tác giả: thanhduan2407 Bài viết gốc: 334393 Tên lệnh: 99 |
BÀI TOÁN XỬ LÝ DANH SÁCH
Em mới viết với các đối tượng Line thôi bác ạ! Còn các đối tượng là đường cong thì em chưa viết! Chương trình viết mới dựa trên thuật toán tạo vùng TOPOLOGY của em. >>
Em mới viết với các đối tượng Line thôi bác ạ! Còn các đối tượng là đường cong thì em chưa viết! Chương trình viết mới dựa trên thuật toán tạo vùng TOPOLOGY của em. (vl-load-com) (prompt (strcat "\nCh\U+01B0\U+01A1ng tr\U+00ECnh t\U+00EDnh di\U+1EC7n t\U+00EDch h\U+00E0ng lo\U+1EA1t" "\nL\U+1EC7nh: TOPOLOGY" "\nNg\U+01B0\U+1EDDi vi\U+1EBFt: Nguy\U+1EC5n Th\U+00E0nh Du\U+00E2n" "\nEmail: heaven2407@gmail.com" "\nMobile: 0972.0168.25" ) ) ;;;(Alert (strcat "\nCh\U+01B0\U+01A1ng tr\U+00ECnh t\U+00EDnh di\U+1EC7n t\U+00EDch h\U+00E0ng lo\U+1EA1t" ;;; "\nL\U+1EC7nh: TOPOLOGY" ;;; "\nNg\U+01B0\U+1EDDi vi\U+1EBFt: Nguy\U+1EC5n Th\U+00E0nh Du\U+00E2n" ;;; "\nEmail: heaven2407@gmail.com" ;;; "\nMobile: 0972.0168.25" ;;; ) ;;;) (defun c:99 ( / LTSAREA LTSGETAREA LTSIDLINE LTSIDPNT LTSLINE LTSPNT LTSPV_ID X S1 S2);;;;TOPOLOGY (setvar "CMDECHO" 0) ;;;;;LAM VIEC VOI POINT (setq LtsLine (acet-ss-to-list (ssget (list (cons 0 "LINE"))))) (or *Caochu* (setq *Caochu* 0.2)) (setq Caochu (getreal (strcat "\nNh\U+1EADp chi\U+1EC1u cao Text ghi di\U+1EC7n t\U+00EDch <" (rtos *Caochu* 2 2) ">: " ) ) ) (if (not Caochu) (setq Caochu *Caochu*) (setq *Caochu* Caochu) ) (setq s1 ((lambda (sec) (+ (* 86400 (- sec (fix sec))) 60)) (getvar "DATE"))) ;;;;;CONVERT, FILTER AND SORT XY (setq LtsPnt (SortAB (CVLine2Pnt LtsLine))) ;;;;GET ID POINT (setq LtsIDPnt (GetIDPnt LtsPnt)) ;;;(mapcar '(lambda(x) (wtxt (rtos (car x) 2 0) (cadr x) 15.0 0 "L" 2)) LtsIDPnt) ;;;;DANH SO HIEU VA LOC CANH TRUNG (setq LtsIDLine (SortAB (GetIDLine LtsLine LtsIDPnt))) ;;; ;;; ;;;;;LAP QUAN HE GIUA CAC DIEM DUA VAO GOC PHUONG VI (setq LtsPV_ID (RelationPntIDbyGPV LtsIDPnt LtsIDLine )) ;;;;;; ;;;;;;;;;;;;;;;;TAO VUNG;;;;;;;;;;;;;;;;;;;;;;;;; (setq LtsArea (GetAreabyID LtsPV_ID)) ;;; ;;; ;;;;;;TINH DIEN TICH VA TOA DO TAM VUNG (setq LtsGetArea (mapcar '(lambda(x) (GetArea_TamVung x LtsIDPnt)) LtsArea)) (mapcar '(lambda(x) (wtxt (rtos (car x) 2 3) (cadr x) 10 0 "C" 4)) LtsGetArea) (setq s2 ((lambda (sec) (+ (* 86400 (- sec (fix sec))) 60)) (getvar "DATE"))) (prompt (strcat "Thoi gian thuc hien chuong trinh la: " (rtos (- s2 s1) 2 3) " giay")) (princ) ) ;;;(RemovePnt (list '(1 3) '(2 3) '(3 5) '(4 8) '(5 6) '(6 34) '(7 334) '(8 76)) (list '(1 2) '(1 5) '(2 3) '(3 2) '(3 5) '(3 7))) (defun RemovePnt ( l1 l2 / I ID ID1 L1A ) (setq l1a l1) (foreach v l2 (setq i 0) (setq ID1 (car v)) (while (< i (length l1)) (setq ID (car (nth i l1))) (if (equal ID ID1) (setq l1 (vl-remove (nth i l1) l1)) ) (setq i (1+ i)) ) ) (setq LtsFilterIDPnt (LM:ListDifference l1a l1)) LtsFilterIDPnt ) ;;;;CONVERT LINE TO POINT AND FILTER (defun CVLine2Pnt (LtsLine / L1 P1 P2 ) (setq l1 (list)) (foreach e LtsLine (setq P1 (cdr (assoc 10 (entget e)))) (setq P2 (cdr (assoc 11 (entget e)))) (setq l1 (append l1 (list P1) (list P2))) ) (setq LtsPnt1 (TD:FilterDeldup l1 0.000001 )) LtsPnt1 ) ;;;;;;;;;;;LOC DIEM TRUNG;;;;;;;;;;;;;; (defun TD:FilterDeldup (l fz ) (if l (cons (car l) (TD:FilterDeldup (vl-remove-if '(lambda (x) (equal x (car l) fz )) (cdr l)) fz) ) ) ) ;;;;;;;;;;SAP XEP THEO X , NEU X BANG NHAU THI SAP XEP THEO Y;;;; (defun SortAB (lstPnt /) (setq Lts-Sort (vl-sort (vl-sort lstPnt '(lambda (e1 e2) (< (cadr e1) (cadr e2)))) '(lambda (e1 e2)(< (car e1) (car e2))))) Lts-Sort ) (defun SortX (lstPnt /) (setq Lts-Sort (vl-sort lstPnt '(lambda (e1 e2)(< (car e1) (car e2))))) Lts-Sort ) (defun SortXT (lstPnt /) (setq Lts-Sort (vl-sort lstPnt '(lambda (e1 e2)(< (car e1) (car e2))))) Lts-Sort ) (defun SortYT (lstPnt /) (setq Lts-Sort (vl-sort lstPnt '(lambda (e1 e2)(< (cadr e1) (cadr e2))))) Lts-Sort ) ;;;;DANH SO HIEU CHO POINT (defun GetIDPnt (ss_list / I ID_PNT ) (setq i 0) (setq LtsIDpnt (list)) (while (< i (length ss_list)) (progn (setq ID_Pnt (list)) (setq ID_Pnt (list (+ i 1) (nth i ss_list))) (setq LtsIDpnt (append LtsIDpnt (list ID_Pnt))) ) (setq i (1+ i)) ) LtsIDpnt ) ;;;;;;;GAN SO HIEU CHO LINE, LOC CANH TRUNG VA SAP XEP (defun GetIDLine (LtsLine LtsIDPoint / ID1 ID2 L1 L2 L3 P1 P2 X ) (setq l2 (list)) (setq l3 (list)) (foreach e LtsLine (setq l1 (list)) (setq P1 (cdr (assoc 10 (entget e)))) (setq P2 (cdr (assoc 11 (entget e)))) (setq ID1 (last (vl-remove nil (mapcar '(lambda(x) (if (equal P1 (cadr x) 0.01) (car x) nil)) LtsIDPoint)))) (setq ID2 (last (vl-remove nil (mapcar '(lambda(x) (if (equal P2 (cadr x) 0.01) (car x) nil)) LtsIDPoint)))) (setq l1 (list ID1 ID2)) (setq l2 (list ID2 ID1)) (setq l3 (append l3 (list l1) (list l2))) ) (setq LtsIDLine (Remove_SHLineOne (TD:FilterDeldup l3 0.0000001))) LtsIDLine ) ;;;;XOA DANH SACH LINE THEO SO HIEU ID1 VA ID2 ;;;;;; ;;;(Remove_LineID 2 3 (setq l (list '(1 2) '(1 5) '(2 3) '(3 2) '(3 5)))) (defun Remove_LineID (ID1 ID2 l1 / ) (vl-remove nil (mapcar '(lambda(x)(if (or (and (equal ID1 (car x)) (equal ID2 (cadr x))) (and (equal ID1 (cadr x)) (equal ID2 (car x))) ) nil x)) l1) ) ) ;;;;;;;XOA DANH SACH LINE THEO SO HIEU ID DAU TIEN ;;;;;;VD: ;;;;;(Remove_SHLineOne (list '(1 2) '(1 5) '(2 3) '(3 2) '(3 5) '(3 7))) (defun Remove_SHLineOne (l / ID1 ID2 IDLINE L1 V X) (foreach v l (setq l1 (vl-remove nil (mapcar '(lambda(x) (if (= (car x) (car v)) x nil)) l))) (if (= (length l1) 1) (progn (setq IDLine (last l1)) (setq ID1 (car IDLine)) (setq ID2 (cadr IDLine)) (setq l (Remove_LineID ID1 ID2 l)) ) ) ) l ) ;;;;;;;;;;;;;;;;;;DOI RADIAN SANG DO;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun Rad2Deg (radian / Do) (setq Do (/ (* radian 180.0) pi)) ) ;;;;;;;;;;;;;;;;;;;;;;RADIAN SANG DO PHUT GIAY ;;;;;;;;;;;;;;;;;; (defun R2DPG (gocR / DO GIAY PHUT PHUT1 TOANDO) (setq DPG (list)) (setq Toando (Rad2Deg gocR)) (setq Do (fix Toando)) (setq Phut1 (* (- Toando Do) 60.0)) (setq Phut (fix Phut1)) (setq Giay (atof (rtos (* (- phut1 phut) 60.0) 2 3))) (setq DPG (list Do Phut giay)) DPG ) (defun D2DPG (Toando / DO GIAY PHUT PHUT1 ) (setq DPG (list)) (setq Do (fix Toando)) (setq Phut1 (* (- Toando Do) 60.0)) (setq Phut (fix Phut1)) (setq Giay (atof (rtos (* (- phut1 phut) 60.0) 2 3))) (setq DPG (list Do Phut giay)) DPG ) ;;;;;;;LAP MOI QUAN HE GIUA CAC DIEM THEO GOC PHUONG VI ;;(setq LtsPV_ID (RelationPntIDbyGPV LtsIDPnt LtsIDLine )) (defun RelationPntIDbyGPV (LtsIDPnt LtsIDLine / ID ID1 ID2 L1 L2 L2A L2B LTSIDLINE2 LTSIDPOINT1 P1 P2 PV12 X ) (setq LtsIDPoint1 (RemovePnt LtsIDPnt LtsIDLine)) (setq LtsRePnt (list)) (foreach e1 LtsIDPoint1 (setq l2a (list)) (setq ID (car e1)) (setq LtsIDLine2 (vl-remove nil (mapcar '(lambda(x) (if (= (car x) ID) x nil)) LtsIDLine))) (foreach e2 LtsIDLine2 (setq l1 (list)) (setq ID1 (car e2)) (setq P1 (GetPntbyID ID1 LtsIDPoint1 )) (setq ID2 (cadr e2)) (setq P2 (GetPntbyID ID2 LtsIDPoint1 )) (setq PV12 (TinhPV P1 P2)) (setq l1 (list PV12 ID1 ID2)) (setq l2a (append l2a (list l1))) (setq l2b (vl-sort l2a '(lambda (x1 x2) (< (car x1) (car x2))))) ) (setq l2 (append (list ID) (mapcar '(lambda(x) (caddr x)) l2b))) (setq LtsRePnt (append LtsRePnt (list l2))) ) LtsRePnt ) ;;;;GET POINT BY ID;;;;;;; (defun GetPntbyID (ID LtsIDPoint2 / ) (setq PntbyID (last (vl-remove nil (mapcar '(lambda(x) (if (equal ID (car x)) (cadr x) nil)) LtsIDPoint2)))) PntbyID ) (defun TinhPV (P1 P2 / ) (setq GocPV (rem (- 450.0 (* (angle p1 p2) (/ 1 pi) 180.0)) 360.0)) GocPV ) (defun GhepList ( l / l1 ID1 ID2) (setq l1 (list)) (setq l2 (list)) (setq ID1 (car l)) (setq i 0) (while (< i (- (length l) 1)) (setq ID2 (nth (+ i 1) l)) (setq l1 (list ID1 ID2)) (setq l2 (append l2 (list l1))) (setq i (1+ i)) ) l2 ) (defun GetAreabyID ( LtsRePnt_ / 1-VT FLAG ID ID+1 ID+N L1 L2 L3 L6 PTDT V1 VT) (setq l3 (list)) (setq l4 (list)) (foreach v2 LtsRePnt_ (setq v1 (GhepList v2)) (setq l1 (list)) (setq l2 (list)) (foreach v v1 (if (and (not (member v l6)) (< (car v) (cadr v))) (progn (setq ID (car v) PTDT (car v) ID+1 (cadr v) Flag T l1 (list ID ID+1) ) (while Flag (setq ID+n (assoc ID+1 LtsRePnt_) vt (vl-position ID ID+n) 1-vt (nth (1- vt) ID+n) ) (if (/= ID+1 PTDT) (if (/= 1-vt ID+1) (setq l1 (append l1 (list (nth (1- vt) ID+n))) ID ID+1 ID+1 (nth (1- vt) ID+n) l6 (append l6 (list (list ID ID+1))) ) (if (= 1-vt ID+1) (setq l1 (append l1 (list (nth (- (length ID+n) 1) ID+n))) ID ID+1 ID+1 (nth (- (length ID+n) 1) ID+n) l6 (append l6 (list (list ID ID+1))) ) ) ) (setq Flag nil) ) ) (setq l2 (append l2 (list l1))) ) ) ) (setq l3 (append l3 l2)) ) (setq l4 (cdr (SortLength (TD:LoaiVung1 l3)))) l4 ) (defun TD:LoaiVungtrung (l fz) (if l (cons (car l) (TD:LoaiVungtrung (vl-remove-if '(lambda (x) (equal (Sort1PT x) (Sort1PT (car l)) fz ) ) (cdr l)) fz) ) ) ) (defun FilterArea ( LtsVung / I ID1 ID1A ) (setq DsArea (TD:LoaiVungtrung LtsVung 0.0001)) (foreach v DsArea (setq i 0) (while (< i (- (length v) 2)) (setq ID1 (nth i v)) (setq ID1a (nth (+ i 2) v)) (if (equal ID1 ID1a) (setq DsArea (vl-remove v DsArea)) ) (setq i (1+ i)) ) ) DsArea ) (defun PV_LineEnd ( Vung LtsIDPnt / Id_c Id_gc P1 P2 ) (setq Id_c (nth (- (length Vung) 1) Vung)) (setq Id_gc (nth (- (length Vung) 2) Vung)) (setq P1 (GetPntbyID Id_c LtsIDPnt )) (setq P2 (GetPntbyID Id_gc LtsIDPnt )) (setq PVLineEnd (TinhPV P2 P1)) PVLineEnd ) ;;;(Tachlist (list 4 7 11 12 15 16 13 14 10 8 6 5 3 2 1 4)) ;;;====>>>> ((4 7) (7 11) (11 12) (12 15) (15 16) (16 13) (13 14) (14 10) (10 8) (8 6) (6 5) (5 3) (3 2) (2 1) (1 4)) (defun Tachlist ( l / l1 ID1 ID2) (setq l1 (list)) (setq l2 (list)) (setq i 0) (while (< i (- (length l) 1)) (setq ID1 (nth i l)) (setq ID2 (nth (+ i 1) l)) (setq l1 (list ID1 ID2)) (setq l2 (append l2 (list l1))) (setq i (1+ i)) ) l2 ) (defun Sort1PT (lstPnt /) (setq Lts-Sort1 (vl-sort lstPnt '(lambda (e1 e2) (< e1 e2)))) Lts-Sort1 ) (defun SortLength (lstPnt /) (setq Lts-Sort1 (vl-sort lstPnt '(lambda (e1 e2) (> (length e1) (length e2))))) Lts-Sort1 ) ;;;;;;(LM:ListDifference '(1 2 3 4 5) '(2 4 6 7 8 8 9 888 999 999 9 7 5) ) (defun LM:ListDifference ( l1 l2 ) (if l1 (if (member (car l1) l2) (LM:ListDifference (cdr l1) l2) (cons (car l1) (LM:ListDifference (cdr l1) l2)) ) ) ) ;;HAM LAY RA CAC PHAN TU GIONG NHAU TU 2 DANH SACH ;;;;(TD:ListSemilar '(2 4 6 45 67 76) '(1 2 ) ) (defun TD:ListSemilar ( l1 l2 ) (if l1 (if (not (member (car l1) l2)) (TD:ListSemilar (cdr l1) l2) (cons (car l1) (TD:ListSemilar (cdr l1) l2)) ) ) ) (defun TD:LoaiVung1 (l / ) (if l (cons (car l) (TD:LoaiVung1 (vl-remove-if '(lambda (x) (TD:ListSemilar (Tachlist x) (Tachlist (car l)) ) ) (cdr l))) ) ) ) (defun GetAreabyLtsID ( LtsID LtsIDPnt / DT1 DT2 I L1 L2 LTSIDPNT LTSPNT P1 P2 PTT X) (setq l1 (mapcar '(lambda(x) (GetPntbyID x LtsIDPnt)) LtsID)) (setq LtsPnt (append l1 (list (car l1)))) (setq i 0) (setq DT2 (list)) (setq Dtich 0) (while (< i (- (length LtsPnt) 1)) (setq DT1 (list)) (setq P1 (nth i LtsPnt)) (setq P2 (nth (+ i 1) LtsPnt)) (setq DT1 (list (/ (* (+ (cadr P1) (cadr P2)) (- (car P2) (car P1))) 2))) (setq DT2 (append DT2 DT1)) (setq i (1+ i)) ) (setq Dtich (abs (apply '+ DT2))) Dtich ) (defun GetArea_TamVung ( LtsID LtsIDPnt / DT1 I L1 LTSIDPNT LTSXTB LTSYTB P1 P2 X XTB YTB ) (setq Dtich (GetAreabyLtsID LtsID LtsIDPnt )) (setq l1 (mapcar '(lambda(x) (GetPntbyID x LtsIDPnt)) LtsID)) (setq Xmin (caar (SortXT l1))) (setq Xmax (car (last (SortXT l1)))) (setq Ymin (cadar (SortYT l1))) (setq Ymax (cadr (last (SortYT l1)))) (setq Xtb (/ (+ Xmin Xmax) 2)) (setq Ytb (/ (+ Ymin Ymax) 2)) (setq DT_TV (list Dtich (list Xtb Ytb ))) DT_TV ) (defun wtxt (string Point Height Ang justify Color / Lst) (setq Lst (list '(0 . "TEXT") (cons 10 point) (cons 40 Height) (cons 1 string) (cons 62 Color) (if Ang (cons 50 Ang)) (cons 7 (if Style Style (getvar "Textstyle")))) justify (strcase justify)) (cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point))))) ((= justify "L") (setq Lst (append Lst (list (cons 72 0)(cons 73 0) (cons 10 point))))) ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point))))) ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point))))) ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3))))) ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3))))) ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3))))) ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2))))) ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2))))) ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2))))) ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1))))) ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1))))) ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))) (entmake Lst) ) File Test http://www.cadviet.com/upfiles/4/36665_test.dwg <<
| ||
Tác giả: pphung183 Bài viết gốc: 334456 Tên lệnh: chtd |
Lisp gán DIMSTYLE và TEXTSTYLE
Thử xem có phải thế này không... >>
Thử xem có phải thế này không :) (defun c:chtd (/ sset tst dst len i entg et ed) (princ "\nChon Text hoặc Dim can thay doi Style :") (setq sset (ssget '((0 . "*TEXT,DIMENSION")))) (setq tst (getstring t "\nNhap loai Textstyle :") dst (getstring t "\nNhap loai Dimstyle :")) (if sset (progn (setq len (sslength sset) i 0) (repeat len (setq entg (entget (ssname sset i)) i (1+ i)) (IF (wcmatch (cdr (assoc 0 entg)) "*TEXT") (progn (setq et (subst (cons 7 tst) (assoc 7 entg) entg)) (entmod et) )) (IF (wcmatch (cdr (assoc 0 entg)) "DIMENSION") (progn (setq ed (subst (cons 3 dst) (assoc 3 entg) entg)) (entmod ed) ))))) (princ)) <<
| ||
Tác giả: nguyendbk48 Bài viết gốc: 279453 Tên lệnh: gin |
Lisp copy nhiều text theo nhiều phương khác nhau
Copy các text cao độ màu hồng (nằm trên các đường thẳng b ) từ vị trí 1 sang vị thí 2 theo:
1. Khoảng cách a người dùng tự nhập 2. Hướng là từ điểm đầu đến điểm cuối đường thẳng b Và chuyển các text cao độ mới về cùng 1 layer (để tiện lọc đối tượng)
| ||
Tác giả: lontraubabanh Bài viết gốc: 280000 Tên lệnh: gcddm |
Đưa bình đồ dạng đường đồng mức về bình đồ dạng cao độ
<<
| ||
Tác giả: Tot77 Bài viết gốc: 335549 Tên lệnh: kn |
Xin lips cắt chân dim cách 1 đường thẳng giá trị cố định.
Bạn thử cái này. Chỉ dùng với dimlinear và đuong giới hạn là line. (defun c:kn(/ CAOC G1 G2 LI SS TT10 TT13 TT14 TT9) (defun dxf(id v) (cdr (assoc id (entget v)))) (defun doi (id tri v) (entmod (subst (cons id tri) (assoc id (entget v)) (entget v)))) (defun dxf9(v / tt10 tt13 tt14 tt50 tt9) (setq tt10 (dxf 10 v) tt13 (dxf 13 v) tt14 (dxf 14 v) tt50 (dxf 50 v) tt9 (inters tt10 (polar tt10 tt50 1) tt13 (polar tt13... Bạn thử cái này. Chỉ dùng với dimlinear và đuong giới hạn là line. (defun c:kn(/ CAOC G1 G2 LI SS TT10 TT13 TT14 TT9) (defun dxf(id v) (cdr (assoc id (entget v)))) (defun doi (id tri v) (entmod (subst (cons id tri) (assoc id (entget v)) (entget v)))) (defun dxf9(v / tt10 tt13 tt14 tt50 tt9) (setq tt10 (dxf 10 v) tt13 (dxf 13 v) tt14 (dxf 14 v) tt50 (dxf 50 v) tt9 (inters tt10 (polar tt10 tt50 1) tt13 (polar tt13 (angle tt14 tt10) 1) nil) ) ) ;;; (princ "\n Chon Kich thuoc:") (setq ss (ssget '((0 . "DIMENSION")))) (princ "\n Chon Line:") (setq li (ssname (ssget ":S:E" '((0 . "LINE") )) 0)) (setq caoc (getreal (strcat "\n Cach khoang <" (if gl_caoc (rtos gl_caoc) (rtos (setq gl_caoc 0.02))) ">: "))) (if caoc (setq gl_caoc caoc)) (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq tt13 (dxf 13 obj) tt14 (dxf 14 obj) tt10 (dxf 10 obj) tt9 (dxf9 obj) g1 (inters (dxf 10 li) (dxf 11 li) tt10 tt14 nil) g2 (inters (dxf 10 li) (dxf 11 li) tt9 tt13 nil) ) (if g1 (doi 14 (polar g1 (angle g1 tt10) gl_caoc) obj)) (if g2 (doi 13 (polar g2 (angle g2 tt9) gl_caoc) obj)) ) ) <<
| ||
Tác giả: Tot77 Bài viết gốc: 335622 Tên lệnh: tes |
[Yêu cầu] Vẽ đường thẳng nối 2 polyline
Có phải như vầy không? (defun c:tes(/ D2 EL GD LEN SS V1 V2) (defun ints (o1 o2 mo) (defun get3(l) (if (cdddr l) (cons (list (car l) (cadr l) (caddr l)) (get3 (cdddr l))) (list l))) (get3 (vlax-Invoke (vlax-EName->vla-Object o1) "IntersectWith" (vlax-EName->vla-Object o2) mo)) ) ;;; (princ "\nChon 2 polyline:") (setq ss (ssget '((0 . "LWPOLYLINE"))) len (getreal (strcat "\nChieu dai duong thang noi 2 pline <" (if gl_len... Có phải như vầy không? (defun c:tes(/ D2 EL GD LEN SS V1 V2) (defun ints (o1 o2 mo) (defun get3(l) (if (cdddr l) (cons (list (car l) (cadr l) (caddr l)) (get3 (cdddr l))) (list l))) (get3 (vlax-Invoke (vlax-EName->vla-Object o1) "IntersectWith" (vlax-EName->vla-Object o2) mo)) ) ;;; (princ "\nChon 2 polyline:") (setq ss (ssget '((0 . "LWPOLYLINE"))) len (getreal (strcat "\nChieu dai duong thang noi 2 pline <" (if gl_len (rtos gl_len) (rtos (setq gl_len 1))) ">:"))) (if len (setq gl_len len)) (if (= 2 (sslength ss)) (setq v1 (ssname ss 0) v2 (ssname ss 1) d2 (cdr (assoc 10 (entget v2))) )) (command ".offset" gl_len v1 d2 "" ) (setq el (entlast) gd (ints el v2 acextendnone)) (if (car gd) (foreach d gd (entmake (list '(0 . "LINE") (cons 10 d) (cons 11 (vlax-curve-getclosestpointto v1 d)))))) (entdel el) (princ) ) <<
| ||
Tác giả: namntq_wru70 Bài viết gốc: 335858 Tên lệnh: sth |
Lisp thống kê cốt thép
Mình có 1 lisp thống kê cốt thép, lisp sử dụng để chỉnh sữa block thuộc tính trong file cad đính kèm. Lisp sửa thép: ;---------------------------------------- >> Mình có 1 lisp thống kê cốt thép, lisp sử dụng để chỉnh sữa block thuộc tính trong file cad đính kèm. Lisp sửa thép: ;----------------------------------------
Mình muốn thêm công thức như sau: Tổng chiều dài các đoạn thép thành phần = chiều dài. Ví dụ như ảnh trên thì: 50+350+14400+350+50=15200 (2 ô màu vàng) Tức là khi mình chỉnh sữa các số 50, 350, 14400, 350, 50 thì số 15200 cũng nhảy theo. Hy vọng được mọi người giúp đỡ. Cám ơn!!!
File lisp: http://www.cadviet.com/upfiles/4/96055_suathep.lsp File cad: http://www.cadviet.com/upfiles/4/96055_bangtkt.dwg File tl (giải nén file rar): http://www.cadviet.com/upfiles/4/96055_tl_1.rar <<
|
Trang 190/330