Info | File |
Tác giả: thanhduan2407
Bài viết gốc: 325484
Tên lệnh: xtdpl |
cần giúp đở lấy tọa độ các điểm polyline
(defun c:XTDPL ( / e ss item Tdo Code LtsVer i j n X Y Z STT L1 L2 L3 L4 L5 Dem);;;;;;;;;;;;;;;;;XUAT TOA DO PLINE
(vl-load-com)
(setvar "CMDECHO" 0)
(setq L5 (list))
(setq j 0)
(setq Dem 0)
(setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE"))))
(while
(setq item (nth j (acet-ss-to-list ss)))
(setq i 0)
(setq L1 (list))
(setq L2 (list))
(setq L3 (list))
(setq L4 (list))
(setq LtsVer (acet-geom-vertex-list item))
(setq L1 (list (strcat...
>>
(defun c:XTDPL ( / e ss item Tdo Code LtsVer i j n X Y Z STT L1 L2 L3 L4 L5 Dem);;;;;;;;;;;;;;;;;XUAT TOA DO PLINE
(vl-load-com)
(setvar "CMDECHO" 0)
(setq L5 (list))
(setq j 0)
(setq Dem 0)
(setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE"))))
(while
(setq item (nth j (acet-ss-to-list ss)))
(setq i 0)
(setq L1 (list))
(setq L2 (list))
(setq L3 (list))
(setq L4 (list))
(setq LtsVer (acet-geom-vertex-list item))
(setq L1 (list (strcat "Polyline co tat ca: " (rtos (length LtsVer) 2 0) " dinh")))
(while (setq P (nth i LtsVer))
(setq L2 (list (rtos (+ i 1) 2 0) (rtos (cadr p) 2 3) (rtos (car p) 2 3) (rtos (caddr p) 2 3) ))
(setq L3 (append L3 (list L2)))
(setq i (1+ i))
)
(setq L3 (append (list L1) L3))
(setq L5 (append L5 L3))
(setq j (1+ j))
(setq Dem (1+ Dem))
)
(if (vlax-get-or-create-object "Excel.Application")
(WriteToExcel L5)
(WriteToCSV L5)
)
(alert (strcat "\nC\U+00F3 t\U+1EA5t c\U+1EA3 " (rtos Dem 2 0) " \U+0111\U+01B0\U+1EE3c phun t\U+1ECDa \U+0111\U+1ED9"))
(princ)
)
(defun WriteToExcel (lst_data / col row x xlApp xlCells)
(setq xlApp (vlax-get-or-create-object "Excel.Application")
xlCells (vlax-get-property
(vlax-get-property
(vlax-get-property
(vlax-invoke-method
(vlax-get-property xlApp "Workbooks")
"Add"
)
"Sheets"
)
"Item" 1
)
"Cells"
)
)
(setq row 1)
(foreach pt lst_data
(setq col 1)
(foreach coor pt
(vlax-put-property xlCells 'Item row col coor)
(setq col (1+ col)))
(setq row (1+ row))
)
(vla-put-visible xlApp :vlax-true)
(mapcar
(function (lambda (x)
(vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x))))))
)
(list xlCells xlApp)
)
(gc)
(gc)
)
(defun WriteToCSV (lst_data / fl)
(if (setq fl (getfiled "Output File" "" "csv" 1))
(if (setq fl (open fl "w"))
(progn
(foreach pt lst_data
(write-line (strcat (rtos (car pt)) "," (rtos (cadr pt)) "," (rtos (caddr pt))) fl)
)
(close fl)
)
)
)
(princ)
)
Bạn thử xem
<<
|
Filename: 325484_xtdpl.lsp
|
|
Tác giả: thehost31
Bài viết gốc: 325485
Tên lệnh: tl cd |
Nhờ các bạn am hiểu lisp giúp mình với.
Thuylinh313 code rất hay. Vuvuzela cũng có ý hay. Tớ code hơi chuối nhưng thêm ý của vuvuzela cho tiện thao tác. Tuy nhiên, sẽ có sai sót nếu bản vẽ của bạn có khác đôi chút.
code của bạn đây. Chạy luôn cả ngàn MCN cho bạn. Lệnh: cd(defun c:tl()
(setq #tl (getreal "\nNh\U+1EADp t\U+1EF7 l\U+1EC7 v\U+1EBD cao: "))
)
(defun Find_Mlevel(pt1 pt2 / ssmss ti ent texi t_po cdo hl Mlevel)
(setq ssmss (ssget "_W" pt1...
>> Thuylinh313 code rất hay. Vuvuzela cũng có ý hay. Tớ code hơi chuối nhưng thêm ý của vuvuzela cho tiện thao tác. Tuy nhiên, sẽ có sai sót nếu bản vẽ của bạn có khác đôi chút.
code của bạn đây. Chạy luôn cả ngàn MCN cho bạn. Lệnh: cd(defun c:tl()
(setq #tl (getreal "\nNh\U+1EADp t\U+1EF7 l\U+1EC7 v\U+1EBD cao: "))
)
(defun Find_Mlevel(pt1 pt2 / ssmss ti ent texi t_po cdo hl Mlevel)
(setq ssmss (ssget "_W" pt1 pt2 '((0 . "TEXT"))) ti 0)
(while (< ti (sslength ssmss))
(setq ent (entget (ssname ssmss ti))
texi (cdr (assoc 1 ent))
t_po (cdr (assoc 10 ent))
)
(if (= (substr texi 1 5) "MSS: ")
(progn
(setq cdo (atof (substr texi 6 (- (strlen texi) 9)))
hl (ssget "_F" (list t_po (polar t_po (* 1.5 pi) 6.0)))
Mlevel (cadr (cdr (assoc 10 (entget (ssname hl 0)))))
ti (sslength ssmss)
)
)
)
(setq ti (1+ ti))
)
(list cdo Mlevel)
)
(defun Add_Line(pt1 pt2 / modelSpace ourLine)
(setq modelSpace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))))
(setq Line (vla-addline modelSpace (vlax-3d-point pt1) (vlax-3d-point pt2)))
)
(defun c:cd(/ ssx si dc_point C1 C2 T1 T2 mlevel ele sste cdo YYY)
(if (= #tl nil) (c:tl))
(prompt "\nCh\U+1ECDn ch\U+1EEF nh\U+1EADt bao toàn b\U+1ED9 tr\U+1EAFc ngang")
(setq pt1 (getpoint "\n\U+0110i\U+1EC3m th\U+1EE9 1: "))
(setq pt2 (getcorner "\n\U+0110i\U+1EC3m \U+0111\U+1ED1i di\U+1EC7n: " pt1))
(command ".zoom" "w" pt1 pt2)
(setq ssb (ssget "_W" pt1 pt2 '((0 . "INSERT") (2 . "Dau_co"))))
(command ".zoom" "p" "")
(setq pt (cdr (assoc 10 (entget (ssname ssb 0)))))
(setq #CX1 (- (car pt) (car pt1))
#CY1 (- (cadr pt) (cadr pt1))
#CX2 (- (car pt) (car pt2))
#CY2 (- (cadr pt) (cadr pt2))
)
(prompt "\nCh\U+1ECDn ch\U+1EEF nh\U+1EADt bao g\U+1ECDn text ch\U+1EE9a cao \U+0111\U+1ED9")
(setq pt1 (getpoint "\n\U+0110i\U+1EC3m th\U+1EE9 1: "))
(setq pt2 (getcorner "\n\U+0110i\U+1EC3m \U+0111\U+1ED1i di\U+1EC7n: " pt1))
(command ".zoom" "w" pt1 pt2)
(setq sst (ssget "_W" pt1 pt2 '((0 . "TEXT"))))
(command ".zoom" "p")
(setq #TX1 (- (car pt) (car pt1))
#TY1 (- (cadr pt) (cadr pt1))
#TX2 (- (car pt) (car pt2))
#TY2 (- (cadr pt) (cadr pt2))
)
(setq ssx (ssget "_X" '((0 . "INSERT") (2 . "Dau_co"))) si 0)
(while (< si (sslength ssx))
(setq dc_point (cdr (assoc 10 (entget (ssname ssx si)))))
(setq C1 (list (- (car dc_point) #CX1) (- (cadr dc_point) #CY1))
C2 (list (- (car dc_point) #CX2) (- (cadr dc_point) #CY2))
T1 (list (- (car dc_point) #TX1) (- (cadr dc_point) #TY1))
T2 (list (- (car dc_point) #TX2) (- (cadr dc_point) #TY2))
)
(command ".zoom" "w" C1 C2)
(setq mlevel (FIND_MLEVEL C1 C2))
(setq sste (ssget "_W" T1 T2 '((0 . "TEXT"))))
(setq cdo (atof (cdr (assoc 1 (entget (ssname sste 0))))))
(setq YYY (+ (* (- cdo (car mlevel)) #tl) (cadr mlevel)))
(ADD_LINE (list (car C1) YYY 0.0) (list (car C2) YYY 0.0))
(setq si (1+ si))
)
(princ)
(princ)
)
Video mình chạy thử để bạn dễ hình dung:
https://www.youtube.com/watch?v=j9jTEQLBM20&feature=youtu.be
<<
|
Filename: 325485_tl_cd.lsp
|
|
Tác giả: nhoclangbat
Bài viết gốc: 325643
Tên lệnh: ghichu |
Nhờ viết lisp ghi chú kích thước
- bạn test thử xem đúng ý chưa hì ^^
;;;;;;;;;;;============================================================
(defun K:pline (listpoint closed Layer clr / Lst)
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if clr clr 256))
'(100 . "AcDbPolyline")
(cons 90 (length listpoint))
(cons 70 (if closed 1 0))))
(foreach PP listpoint (setq Lst (append Lst (list (cons 10...
>> - bạn test thử xem đúng ý chưa hì ^^
;;;;;;;;;;;============================================================
(defun K:pline (listpoint closed Layer clr / Lst)
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if clr clr 256))
'(100 . "AcDbPolyline")
(cons 90 (length listpoint))
(cons 70 (if closed 1 0))))
(foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP)))))
(entmakex Lst))
;end;=================================
;=================================HAM ENTMAKE VE CICLE
(defun K:tron (point R Layer Color)
(entmakex (list '(0 . "CIRCLE")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
(cons 10 point)
(cons 40 R)
)))
;end;=================================
;;ham tao text 3
(defun K:text(pt height string justify layer textstyle mau ang / lst)
(setq lst (list '(0 . "TEXT")
(cons 10 pt)
(cons 40 height)
(cons 1 string)
(cons 50 (if ang ang 0))
(cons 8 layer)
(cons 7 textstyle)
(cons 62 (if mau mau 256))
)
justify (strcase justify))
(cond ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 pt)))))
((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt)))))
((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt)))))
((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt)))))
)
(entmakex Lst)
) ;end K:text
;hàm t?o textstyle
(defun K:style (MyStyle MyFont)
(entmake (list (cons 0 "STYLE")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbTextStyleTableRecord")
(cons 2 MyStyle) (cons 3 MyFont)
(cons 70 0))))
;===============================================****************************++++++++++BAI 4+++++++++*********************===========
(defun K:layer (ten clr)
(if (null (tblsearch "LAYER" ten))
(entmakex (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
(cons 2 ten)
(cons 62 clr))
)
)
)
;===========================================================================================
(defun C:ghichu(/ old oldd pt pt1 pt2 pt3 vttext h w goc str1 str2 bk pt4 lenstr1 lstp pdau pcuoi kcx obj)
(vl-load-com)
(setq old (getvar "OSMODE") oldd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (null (tblsearch "style" "VHELVEI")) (K:style "VHELVEI" "VHELVEI.ttf"))
(if (null (tblsearch "layer" "GHI-CHU")) (K:layer "GHI-CHU" 7))
(setq str2 (getint "\nNhap so text trong tam:"))
(setq bk (getreal "\nNhap ban kinh:"))
(setvar "OSMODE" 512)
(initget 1)
(setq pt1 (getpoint "\nChon diem dau: "))
(setvar "OSMODE" 0)
(setq pt2 (getpoint pt1 "\ndiem thu 2: "))
(setq goc (angle pt1 pt2))
(setq str1 (getstring 1 "\nNhap text ngang: "))
(setq lenstr1 (strlen str1))
(setq pt3 (getpoint pt2 "\nHuong diem cuoi: "))
(if (< (car pt2) (car pt3))
(progn
(setq vttext (polar pt2 (/ pi 4) 1.5))
(setq obj (K:text vttext 2.5 str1 "L" "GHI-CHU" "VHELVEI" nil nil))
(setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp))
(setq pdau (vlax-safearray->list minp))
(setq pcuoi (vlax-safearray->list maxp))
(setq kcx (- (car pcuoi) (car pdau)))
(setq pt3 (polar pt2 0 (+ 2.0 kcx)))
(setq pt4 (polar pt3 0 bk))
)
(progn
(setq vttext (polar pt2 (+ (/ pi 2) (/ pi 4)) 1.5))
(setq obj (K:text vttext 2.5 str1 "R" "GHI-CHU" "VHELVEI" nil nil))
(setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp))
(setq pdau (vlax-safearray->list minp))
(setq pcuoi (vlax-safearray->list maxp))
(setq kcx (- (car pcuoi) (car pdau)))
(setq pt3 (polar pt2 PI (+ 2 kcx)))
(setq pt4 (polar pt3 pi bk))
)
);if
(K:pline (list pt1 pt2 pt3) nil "GHI-CHU" nil)
(K:tron pt4 bk "GHI-CHU" nil)
(K:text pt4 3.0 (itoa str2) "M" "GHI-CHU" "VHELVEI" nil nil)
(setvar "OSMODE" old)
(setvar "cmdecho" oldd)
(princ)
)
<<
|
Filename: 325643_ghichu.lsp
|
|
Tác giả: nhoclangbat
Bài viết gốc: 325703
Tên lệnh: ghichu |
Nhờ viết lisp ghi chú kích thước
;;;;;;;;;;;============================================================
(defun K:pline (listpoint closed Layer clr / Lst)
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if clr clr 256))
'(100 . "AcDbPolyline")
(cons 90 (length listpoint))
(cons 70 (if closed 1 0))))
(foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP)))))
(entmakex...
>>
;;;;;;;;;;;============================================================
(defun K:pline (listpoint closed Layer clr / Lst)
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if clr clr 256))
'(100 . "AcDbPolyline")
(cons 90 (length listpoint))
(cons 70 (if closed 1 0))))
(foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP)))))
(entmakex Lst))
;end;=================================
;=================================HAM ENTMAKE VE CICLE
(defun K:tron (point R Layer Color)
(entmakex (list '(0 . "CIRCLE")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
(cons 10 point)
(cons 40 R)
)))
;end;=================================
;ham tao text 3
(defun K:text(pt height string justify layer textstyle mau ang / lst)
(setq lst (list '(0 . "TEXT")
(cons 10 pt)
(cons 40 height)
(cons 1 string)
(cons 50 (if ang ang 0))
(cons 8 (if layer layer (getvar 'clayer)))
(cons 7 (if textstyle textstyle (getvar 'textstyle)))
(cons 62 (if mau mau 256))
)
justify (strcase justify))
(cond ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 pt)))))
((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt)))))
((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt)))))
((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt)))))
)
(entmakex Lst)
);end K:text
;hàm t?o textstyle
(defun K:style (MyStyle MyFont)
(entmake (list (cons 0 "STYLE")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbTextStyleTableRecord")
(cons 2 MyStyle) (cons 3 MyFont)
(cons 70 0))))
;===============================================****************************++++++++++BAI 4+++++++++*********************===========
(defun K:layer (ten clr)
(if (null (tblsearch "LAYER" ten))
(entmakex (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
(cons 2 ten)
(cons 62 clr))
)
)
)
;===========================================================================================
(defun C:ghichu(/ old oldd pt pt1 pt2 pt3 vttext h w goc str1 str2 bk pt4 lenstr1 lstp pdau pcuoi kcx obj)
(vl-load-com)
(setq old (getvar "OSMODE") oldd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq str2 (getint "\nNhap so text trong tam:"))
(setq bk (getreal "\nNhap ban kinh:"))
(setvar "OSMODE" 512)
(initget 1)
(setq pt1 (getpoint "\nChon diem dau: "))
(setvar "OSMODE" 0)
(setq pt2 (getpoint pt1 "\ndiem thu 2: "))
(setq goc (angle pt1 pt2))
(setq str1 (getstring 1 "\nNhap text ngang: "))
(setq lenstr1 (strlen str1))
(setq pt3 (getpoint pt2 "\nHuong diem cuoi: "))
(if (< (car pt2) (car pt3))
(progn
(setq vttext (polar pt2 (/ pi 4) 1.5))
(setq obj (K:text vttext 2.5 str1 "L" "GHI-CHU" "VHELVEI" nil nil))
(setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp))
(setq pdau (vlax-safearray->list minp))
(setq pcuoi (vlax-safearray->list maxp))
(setq kcx (- (car pcuoi) (car pdau)))
(setq pt3 (polar pt2 0 (+ 2.0 kcx)))
(setq pt4 (polar pt3 0 bk))
)
(progn
(setq vttext (polar pt2 (+ (/ pi 2) (/ pi 4)) 1.5))
(setq obj (K:text vttext 2.5 str1 "R" nil nil nil nil))
(setq lstp (vla-getBoundingBox (vlax-ename->vla-object obj) 'minp 'maxp))
(setq pdau (vlax-safearray->list minp))
(setq pcuoi (vlax-safearray->list maxp))
(setq kcx (- (car pcuoi) (car pdau)))
(setq pt3 (polar pt2 PI (+ 2 kcx)))
(setq pt4 (polar pt3 pi bk))
)
);if
(K:pline (list pt1 pt2 pt3) nil nil nil)
(K:tron pt4 bk nil nil)
(K:text pt4 3.0 (itoa str2) "M" nil nil nil nil)
(setvar "OSMODE" old)
(setvar "cmdecho" oldd)
(princ)
)
- hi tối giờ nhoc bận, đã sữa cho bạn theo hiện hành ^^
<<
|
Filename: 325703_ghichu.lsp
|
|
Tác giả: xuanduc1031
Bài viết gốc: 325917
Tên lệnh: gload123 |
nhờ chỉnh sửa lisp phân biệt (tab) và (cách) trong text
; DANG XUAN DUC - TEL: 0987987785
; ch¬ng tr×nh xuÊt tõ exed sang cad, hæ trî phiªn b¶n Autocad r14
;=================================================================
(defun c:gload123( / tl ent i n mangthuc ents ten x y fin f mang tt_chu tct dt dt1
dt2 dt3 dt4 dt5 dt6 dt7 dt8 dt9 dt10 dt11 dt12 dt13 dt14 dt15 dt16 dt17 dt18 dt19
lrd ptct tam xl xr xlrd ylrd ytt_chu xtct xdt xdt1...
>>
; DANG XUAN DUC - TEL: 0987987785
; ch¬ng tr×nh xuÊt tõ exed sang cad, hæ trî phiªn b¶n Autocad r14
;=================================================================
(defun c:gload123( / tl ent i n mangthuc ents ten x y fin f mang tt_chu tct dt dt1
dt2 dt3 dt4 dt5 dt6 dt7 dt8 dt9 dt10 dt11 dt12 dt13 dt14 dt15 dt16 dt17 dt18 dt19
lrd ptct tam xl xr xlrd ylrd ytt_chu xtct xdt xdt1 xdt2 xdt3 xdt4 xdt5 xdt6
xdt7 xdt8 xdt9 xdt10 xdt11 xdt12 xdt13 xdt14 xdt15 xdt16 xdt17 xdt18 xdt19
ytct ydt ydt1 ydt2 ydt3 ydt4 ydt5 ydt6 ydt7 ydt8 ydt9 ydt10 ydt11
ydt12 ydt13 ydt14 ydt15 ydt16 ydt17 ydt18 ydt19 tcttxt )
(command "layer" "N" "tct-11" "c" "cyan" "tct-11" "")
(command "layer" "N" "cen-11" "c" "white" "cen-11" "")
(command "layer" "lock" "tct" "")
(command "osnap" "none")
(setq tbl(tblsearch "layer" "LRD-11"))
(if(= tbl nil)(command "layer" "N" "lrd-11" "c" "green" "lrd-11" ""))
(setq tbl(tblsearch "layer" "dt-11"))
(if(= tbl nil)(command "layer" "N" "dt-11" "c" "white" "dt-11" ""))
(setq tbl(tblsearch "layer" "dt-111"))
(if(= tbl nil)(command "layer" "N" "dt-111" "c" "white" "dt-111" ""))
(setq tbl(tblsearch "layer" "dt-112"))
(if(= tbl nil)(command "layer" "N" "dt-112" "c" "white" "dt-112" ""))
(setq tbl(tblsearch "layer" "dt-113"))
(if(= tbl nil)(command "layer" "N" "dt-113" "c" "white" "dt-113" ""))
(setq tbl(tblsearch "layer" "dt-114"))
(if(= tbl nil)(command "layer" "N" "dt-114" "c" "white" "dt-114" ""))
(setq tbl(tblsearch "layer" "dt-115"))
(if(= tbl nil)(command "layer" "N" "dt-115" "c" "red" "dt-115" ""))
(setq tbl(tblsearch "layer" "dt-116"))
(if(= tbl nil)(command "layer" "N" "dt-116" "c" "red" "dt-116" ""))
(setq tbl(tblsearch "layer" "dt-117"))
(if(= tbl nil)(command "layer" "N" "dt-117" "c" "red" "dt-117" ""))
(setq tbl(tblsearch "layer" "dt-118"))
(if(= tbl nil)(command "layer" "N" "dt-118" "c" "red" "dt-118" ""))
(setq tbl(tblsearch "layer" "dt-119"))
(if(= tbl nil)(command "layer" "N" "dt-119" "c" "red" "dt-119" ""))
(setq tbl(tblsearch "layer" "dt-1110"))
(if(= tbl nil)(command "layer" "N" "dt-1110" "c" "red" "dt-1110" ""))
(setq tbl(tblsearch "layer" "dt-1111"))
(if(= tbl nil)(command "layer" "N" "dt-1111" "c" "red" "dt-1111" ""))
(setq tbl(tblsearch "layer" "dt-1112"))
(if(= tbl nil)(command "layer" "N" "dt-1112" "c" "red" "dt-1112" ""))
(setq tbl(tblsearch "layer" "dt-1113"))
(if(= tbl nil)(command "layer" "N" "dt-1113" "c" "red" "dt-1113" ""))
(setq tbl(tblsearch "layer" "dt-1114"))
(if(= tbl nil)(command "layer" "N" "dt-1114" "c" "red" "dt-1114" ""))
(setq tbl(tblsearch "layer" "dt-1115"))
(if(= tbl nil)(command "layer" "N" "dt-1115" "c" "red" "dt-1115" ""))
(setq tbl(tblsearch "layer" "dt-1116"))
(if(= tbl nil)(command "layer" "N" "dt-1116" "c" "red" "dt-1116" ""))
(setq tbl(tblsearch "layer" "dt-1117"))
(if(= tbl nil)(command "layer" "N" "dt-1117" "c" "red" "dt-1117" ""))
(setq tbl(tblsearch "layer" "dt-1118"))
(if(= tbl nil)(command "layer" "N" "dt-1118" "c" "red" "dt-1118" ""))
(setq tbl(tblsearch "layer" "dt-1119"))
(if(= tbl nil)(command "layer" "N" "dt-1119" "c" "red" "dt-1119" ""))
(setq tbl(tblsearch "layer" "tt_chu-11"))
(if(= tbl nil)(command "layer" "N" "tt_chu-11" "c" "cyan" "tt_chu-11" ""))
(setq tl(getvar "dimcen") p(list 10 10))
(setq ent(ssget "X" (list (cons 8 "tct")(cons 0 "text"))))
(if(= ent nil)(alert "b¹n ph¶i nhËp sè hå s¬ tríc khi load vµo th«ng tin vµo !!!"))
(if(/= nil ent)
(progn
(setq i 0 n(sslength ent) mangthua())
(while (< i n)
(setq ents(entget(ssname ent i)))
(setq tcu(ATOI(cdr(assoc 1 ents))))
(setq x(cadr (assoc 11 ents)) y(caddr (assoc 11 ents)))
(setq y(- y tl))
(setq mangthua(append mangthua (list (list tcu (list x y)))))
(setq caomoi(cons 40 (* tl 1.5)))
(setq ents(subst caomoi (assoc 40 ents) ents))
(entmod ents)
(setq i(+ i 1))
)
(setq mang())
(command "textstyle" "vntime")
(setq fin(getfiled " §Æng Xu©n §øc - TEL : 0987 987 785 " "*.xlw" "xlw" 12))
(setq ftct (open fin "r"))
(if ftct
(progn
(while (setq inrec(read-line ftct))
(if (/= nil inrec)
(progn
(arrayele inrec)
(if(/= nil $$$)
(progn
(setq tct(atoi (nth 0 $$$)) tt_chu(nth 1 $$$) dt(nth 2 $$$) dt1(nth 3 $$$) dt2(nth 4 $$$) dt3(nth 5 $$$) dt4(nth 6 $$$) dt5(nth 7 $$$) dt6(nth 8 $$$) dt7(nth 9 $$$) dt8(nth 10 $$$) dt9(nth 11 $$$) dt10(nth 12 $$$) dt11(nth 13 $$$) dt12(nth 14 $$$) dt13(nth 15 $$$) dt14(nth 16 $$$) dt15(nth 17 $$$) dt16(nth 18 $$$) dt17(nth 19 $$$) dt18(nth 20 $$$) dt19(nth 21 $$$) lrd(nth 22 $$$))
(if (= nil lrd)(setq lrd "&"))
(timtctSH tct)
(setq mang(append mang(list (list tct tt_chu dt dt1 dt2 dt3 dt4 dt5 dt6 dt7 dt8 dt9 dt10 dt11 dt12 dt13 dt14 dt15 dt16 dt17 dt18 dt19 lrd ptct))))
)
)
)))
)
)
(setq i 0 n(length mang) mangthua nil)
(while (< i n)
(setq tam(nth i mang))
(setq tct(itoa (nth 0 tam))
tt_chu(nth 1 tam) dt(nth 2 tam) dt1(nth 3 tam) dt2(nth 4 tam) dt3(nth 5 tam) dt4(nth 6 tam) dt5(nth 7 tam) dt6(nth 8 tam) dt7(nth 9 tam) dt8(nth 10 tam) dt9(nth 11 tam) dt10(nth 12 tam) dt11(nth 13 tam) dt12(nth 14 tam) dt13(nth 15 tam) dt14(nth 16 tam) dt15(nth 17 tam) dt16(nth 18 tam) dt17(nth 19 tam) dt18(nth 20 tam) dt19(nth 21 tam) lrd(nth 22 tam) p(nth 23 tam))
(if (/= p nil)
(progn
(setq x(car p) y(cadr p))
(setq xl(- x (* tl 20.2)) xr(+ x (* tl 20.0)) )
(setq xlrd(- x (* tl 81.06)) ylrd(- y (* tl 15.00)))
(setq ytct(- y (* tl 5.00)) ytt_chu(- y (* tl 15.00)))
(setq xdt(- x (* tl 15.00)) ydt(- y (* tl 11.31)))
(setq xdt1(- x (* tl 121.06)) ydt1(- y (* tl 21.06)))
(setq xdt2(- x (* tl 5.00)) ydt2(- y (* tl 13.31)))
(setq xdt3(- x (* tl 15.00)) ydt3(- y (* tl 14.31)))
(setq xdt4(- x (* tl 16.00)) ydt4(- y (* tl 15.31)))
(setq xdt5(- x (* tl 18.00)) ydt5(- y (* tl 16.31)))
(setq xdt6(- x (* tl 35.00)) ydt6(- y (* tl 17.31)))
(setq xdt7(- x (* tl 65.00)) ydt7(- y (* tl 18.31)))
(setq xdt8(- x (* tl 25.00)) ydt8(- y (* tl 19.31)))
(setq xdt9(- x (* tl 36.00)) ydt9(- y (* tl 20.31)))
(setq xdt10(- x (* tl 45.00)) ydt10(- y (* tl 21.31)))
(setq xdt11(- x (* tl 157.00)) ydt11(- y (* tl 22.31)))
(setq xdt12(- x (* tl 12.00)) ydt12(- y (* tl 23.31)))
(setq xdt13(- x (* tl 234.00)) ydt13(- y (* tl 24.31)))
(setq xdt14(- x (* tl 543.00)) ydt14(- y (* tl 25.31)))
(setq xdt15(- x (* tl 76.00)) ydt15(- y (* tl 26.31)))
(setq xdt16(- x (* tl 89.00)) ydt16(- y (* tl 27.31)))
(setq xdt17(- x (* tl 198.00)) ydt17(- y (* tl 28.31)))
(setq xdt18(- x (* tl 654.00)) ydt18(- y (* tl 29.31)))
(setq xdt19(- x (* tl 23.00)) ydt19(- y (* tl 30.31)) )
; (command "layer" "s" "cen-11" "")
; (command "line" (list xl y) (list xr y) "")
(command "layer" "s" "tct-11" "")
(command "text" "j" "c" (list x ytct) (* tl 2.0) "0" tt_chu)
(command "layer" "s" "dt-11" "")
(command "text" "j" "tc" (list x ydt) (* tl 2.0) "0" dt)
(command "layer" "s" "dt-111" "")
(command "text" "j" "tc" (list xdt1 ydt1) (* tl 2.0) "0" dt1)
(command "layer" "s" "dt-112" "")
(command "text" "j" "tc" (list xdt2 ydt2) (* tl 2.0) "0" dt2)
(command "layer" "s" "dt-113" "")
(command "text" "j" "tc" (list xdt3 ydt3) (* tl 2.0) "0" dt3)
(command "layer" "s" "dt-114" "")
(command "text" "j" "tc" (list xdt4 ydt4) (* tl 2.0) "0" dt4)
(command "layer" "s" "dt-115" "")
(command "text" "j" "tc" (list xdt5 ydt5) (* tl 2.0) "0" dt5)
(command "layer" "s" "dt-116" "")
(command "text" "j" "tc" (list xdt6 ydt6) (* tl 2.0) "0" dt6)
(command "layer" "s" "dt-117" "")
(command "text" "j" "tc" (list xdt7 ydt7) (* tl 2.0) "0" dt7)
(command "layer" "s" "dt-118" "")
(command "text" "j" "tc" (list xdt8 ydt8) (* tl 2.0) "0" dt8)
(command "layer" "s" "dt-119" "")
(command "text" "j" "tc" (list xdt9 ydt9) (* tl 2.0) "0" dt9)
(command "layer" "s" "dt-1110" "")
(command "text" "j" "tc" (list xdt10 ydt10) (* tl 2.0) "0" dt10)
(command "layer" "s" "dt-1111" "")
(command "text" "j" "tc" (list xdt11 ydt11) (* tl 2.0) "0" dt11)
(command "layer" "s" "dt-1112" "")
(command "text" "j" "tc" (list xdt12 ydt12) (* tl 2.0) "0" dt12)
(command "layer" "s" "dt-1113" "")
(command "text" "j" "tc" (list xdt13 ydt13) (* tl 2.0) "0" dt13)
(command "layer" "s" "dt-1114" "")
(command "text" "j" "tc" (list xdt14 ydt14) (* tl 2.0) "0" dt14)
(command "layer" "s" "dt-1115" "")
(command "text" "j" "tc" (list xdt15 ydt15) (* tl 2.0) "0" dt15)
(command "layer" "s" "dt-1116" "")
(command "text" "j" "tc" (list xdt16 ydt16) (* tl 2.0) "0" dt16)
(command "layer" "s" "dt-1117" "")
(command "text" "j" "tc" (list xdt17 ydt17) (* tl 2.0) "0" dt17)
(command "layer" "s" "dt-1118" "")
(command "text" "j" "tc" (list xdt18 ydt18) (* tl 2.0) "0" dt18)
(command "layer" "s" "dt-1119" "")
(command "text" "j" "tc" (list xdt19 ydt19) (* tl 2.0) "0" dt19)
(if (/= lrd "&")
(progn
(command "layer" "s" "lrd-11" "")
(command "text" "j" "mc" (list xlrd ylrd) (* tl 1.8) "0" lrd)
(command "layer" "Freeze" "tt_chu" "")
(command "layer" "Freeze" "lrd" "")
(command "layer" "Freeze" "tc1t" "")
(command "layer" "Freeze" "to_bd" "")
(command "layer" "Freeze" "thuatam" "")
(command "layer" "Freeze" "dt" "")
(command "layer" "Freeze" "cen" "")
(command "layer" "Freeze" "sh_mia" "")
(command "layer" "Freeze" "diem" "")
(command "layer" "Freeze" "code" "")
)
)
))
(setq i(+ i 1))
)
)) ; if ent <> nil
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;------------------------------------------------------------------------------------------------------------------------------------------------
<<
|
Filename: 325917_gload123.lsp
|
|
Tác giả: trinhhoanghieu090
Bài viết gốc: 325244
Tên lệnh: tinhtien |
Chương 5.5 : Bài tập
Em nộp trước 3 bài thầy ketxu ơi, các bài sau em sẽ update luôn vào mục này sau. :D
- Update 08/12/2014: Em làm thêm bài nhập khoảng cách và sửa lại hàm ipos rồi thầy ketxu ơi, hàm getdist luôn luôn trả về số thực nên em mạo muội dùng phương án khác là getstring + hàm read thầy ạ. Hi hi
- Update 09/12/2014: Em nộp bài 5.5, 5.6. Bài 5.5 câu a có xem qua đáp án, các câu khác tự biên tự diễn thầy...
>> Em nộp trước 3 bài thầy ketxu ơi, các bài sau em sẽ update luôn vào mục này sau. :D
- Update 08/12/2014: Em làm thêm bài nhập khoảng cách và sửa lại hàm ipos rồi thầy ketxu ơi, hàm getdist luôn luôn trả về số thực nên em mạo muội dùng phương án khác là getstring + hàm read thầy ạ. Hi hi
- Update 09/12/2014: Em nộp bài 5.5, 5.6. Bài 5.5 câu a có xem qua đáp án, các câu khác tự biên tự diễn thầy ạ
(defun c:ll(/ p1 p2) ; 5.1 ve line tu diem A den B
(setq p1 (getpoint "\n Pick Diem Dau:"))
(setq p2 (getpoint p1 "\n Pick Diem Cuoi:"))
(if (equal (distance p1 p2) 0 0.00001)
(setq p2 (getpoint p1 "\n Pick Diem Cuoi:")) )
(command ".line" "non" p1 "non" p2 "")
);end defun
(defun ipos( n lst); 5.2 tra ve phan tu thu n trong list
(if (and (>= n 1 ) (<= (- n 1) (length lst) )) ;if 1
(setq phantu (nth (- n 1) lst))
); end if 1
); end defun
(defun c:test(); nhap bien #d
(or #d1 (setq #d1 10.0) )
(setq #d (getreal (strcat "\nNhap so d <" (rtos #d1 2 2) "> :") ))
(if (not #d) (setq #d #d1) (setq #d1 #d))
); end defun
(defun c:kc() ; kiem tra bang ham getdist
(setq kc (read (getstring "\nBan Hay nhap khoang cach:")) )
(if (and (numberp kc)(= (type kc) 'REAL))
(alert "Ban Da Nhap vao so thuc"))
(if (and (numberp kc)(= (type kc) 'INT))
(alert "Ban Da Nhap vao so Nguyen"))
(if (not (numberp kc))
(alert "Ban da khong nhap so"))
);end defun
(defun c:tinhtien(/ giatien soluong banhang getgiatien tienbanhang hangtonkho hangcu tentungloai soluongtungloai thongbao listen listsoluong hanghet) ;bai 5.5
(setq giatien (list (CONS "A" 100) (CONS "B" 200) (CONS "C" 300) (CONS "D" 400) (CONS "E" 500))
Soluong (list (CONS "A" 2) (CONS "B" 3) (CONS "C" 4) (CONS "D" 5) (CONS "E" 6))
banhang '( "A" "B" "A" "C" "C" "D" "B" "B" "E" "E" "C") )
; Tinh toan tien ban hang trong ngay============================================
(defun getgiatien( x)
(cdr(assoc x giatien))
)
(setq tienbanhang (apply '+ (append (mapcar 'getgiatien banhang )) ) )
(princ "\nSo tien ban hang trong ngay la: ")
(princ tienbanhang)
(princ)
; Tinh toan so luong con lai cua cac mat hang trong kho===========================
(defun hangtonkho( x / hangcu)
(setq hangcu (cdr(assoc x soluong))
soluong (subst (cons x (- hangcu 1) ) (cons x hangcu ) soluong))
)
(mapcar 'hangtonkho banhang)
(defun tentungloai( x)
(car (assoc (car x) soluong))
)
(defun soluongtungloai( x)
(cdr (assoc (car x) soluong))
)
(defun thongbao( ten soluong)
(princ (strcat "\nSo Luong mat hang " ten " con " (itoa soluong)))
(princ)
)
(setq listten (append (mapcar 'tentungloai soluong)))
(setq listsoluong (append (mapcar 'soluongtungloai soluong)))
(mapcar 'thongbao listten listsoluong)
; Thong bao mat hang da het====================================================
(defun hanghet( x)
(if (eq (soluongtungloai x) 0)
(progn
(princ (strcat"\nMat hang " (tentungloai x) " da het") )
(princ)
);end progn
(princ)
)
)
(mapcar 'hanghet soluong)
)
; Bai 5.6:
And có thể thay được if, Or có thể thay được cond, bản chất And If là trả về true hoặc nil, còn Or cond trả về giá trị của biểu thức.
Vd: thay bài 5.1 bằng and:
(and
(setq p1 (getpoint "\n Pick Diem Dau:"))
(setq p2 (getpoint p1 "\n Pick Diem Cuoi:"))
(equal (distance p1 p2) 0 0.00001)
)
(command ".line" "non" p1 "non" p2 "")
<<
|
Filename: 325244_tinhtien.lsp
|
|
Tác giả: nhoclangbat
Bài viết gốc: 326132
Tên lệnh: kki |
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
- hi nhoc thử viết dựa trên ý tưởng của bạn, bạn xem thử, nếu danh sách text của bạn đã sếp theo thứ tự mong mún, và danh sách đó là ename của các text rùi thì công việc đỡn hơn ^^
(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 c:kki (/ ss_nametext i td_text ds_kc...
>> - hi nhoc thử viết dựa trên ý tưởng của bạn, bạn xem thử, nếu danh sách text của bạn đã sếp theo thứ tự mong mún, và danh sách đó là ename của các text rùi thì công việc đỡn hơn ^^
(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 c:kki (/ ss_nametext i td_text ds_kc ds_tdtext)
(setq ss_nametext (ss2ent (ssget '((0 . "TEXT")))))
(if ss_nametext
(progn
(setq i 0)
(foreach v ss_nametext
(setq td_text (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget v))))
(setq ds_tdtext (append ds_tdtext td_text))
)
(repeat (1- (length ds_tdtext))
(setq kc (distance (nth i ds_tdtext) (nth (setq i (1+ i)) ds_tdtext)))
(setq ds_kc (append ds_kc (list (rtos kc 2 2))))
)
)
)
(princ (vl-princ-to-string ds_kc))
(princ)
)
- lsp nhoc viết để chạy thử ^^, kết quả cuối cùng trả về là danh sách khoảng cách giữa các text, biến ds_kc, từ đó bạn làm tiếp hen, nhoc chưa học xuất qua txt ^^
<<
|
Tác giả: nguyentuyen6
Bài viết gốc: 113393
Tên lệnh: fd |
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
hì hì!!!
@ bác tu:
Cách của bác hay thật. nhưng e muốn nó chạy ở bất cứ cái khung tên nào mà ko cần phải vào chỉnh trong block. Nhỡ đâu lúc có người dùng lisp này lại không biết là phải đặt cái rectang đó ở 1 layer nhất định thì nó ko chạy đc.
@bác Thanhbinh:
Thank bác nhiều lắm. Em đang gặm dở con của bác Tue.Nên cũng chưa kịp xem code của bác, Đợi xong con này em sẽ... >> hì hì!!!
@ bác tu:
Cách của bác hay thật. nhưng e muốn nó chạy ở bất cứ cái khung tên nào mà ko cần phải vào chỉnh trong block. Nhỡ đâu lúc có người dùng lisp này lại không biết là phải đặt cái rectang đó ở 1 layer nhất định thì nó ko chạy đc.
@bác Thanhbinh:
Thank bác nhiều lắm. Em đang gặm dở con của bác Tue.Nên cũng chưa kịp xem code của bác, Đợi xong con này em sẽ gặm nốt con của bác luôn, hehe
E đang tét thử cái này thấy nó vẽ rectang ko chuẩn, không trùng vào cái rectang đã lấy đc entname kia là sao các bác nhỉ???
Và khi di chuyển cái block khung đấy ra chỗ khác thực hiện lại líp thì nó vẫn vẽ cái rectang ở chỗ cũ. E muốn nó chạy theo block cơ. Hjx <<
|
Tác giả: phamngoctukts
Bài viết gốc: 117496
Tên lệnh: vg |
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
Bạn sai 2 dòng này
(Command "LINE" point(Polar Point Ang 100) "")
(Command "LINE" Point(Polar Point Ang2 50) "")
hàm polar dùng góc radian không phải là degrees.
Bạn thử cái này xem
|
Tác giả: Tue_NV
Bài viết gốc: 116891
Tên lệnh: cn |
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
Hàm con Load_Change sẽ load Linetype trong ACADTAM.LIN và đổi Linetype cho đối tượng chọn bởi ssget
ACADTAM.LIN nằm trong Support file search Path của CAD
Nếu không nằm trong Support file search Path của CAD thì phải khai đầy đủ đường dẫn cho nó khi hàm findfile trả về nil, tức là không tìm thấy ACADTAM.LIN trong Support file search Path
Mình viết cho Linetype BOSONG52, Các đường nét khác, bạn... >>
Hàm con Load_Change sẽ load Linetype trong ACADTAM.LIN và đổi Linetype cho đối tượng chọn bởi ssget
ACADTAM.LIN nằm trong Support file search Path của CAD
Nếu không nằm trong Support file search Path của CAD thì phải khai đầy đủ đường dẫn cho nó khi hàm findfile trả về nil, tức là không tìm thấy ACADTAM.LIN trong Support file search Path
Mình viết cho Linetype BOSONG52, Các đường nét khác, bạn cứ theo đó mà viết tiếp
<<
|
Tác giả: 18011985
Bài viết gốc: 109733
Tên lệnh: ctob | |
Tác giả: gia_bach
Bài viết gốc: 47978
Tên lệnh: thu | |
Tác giả: luhaivinh
Bài viết gốc: 310328
Tên lệnh: bt2-1 bt2-2 |
Chữa bài tập chương 2
Cảm ơn bạn nhiều
Do trong đề bài không yêu cầu loại bỏ biến a b c nên mình cứ tưởng ý của đề bài là để các hàm sau kế thừa các giá trị của a b c.
Hy vọng lần nầy sẽ không còn sai nữa :)
;Chuong 2
(defun c:BT2-1(/ x y z e);cau 1
(setq...
>> Cảm ơn bạn nhiều
Do trong đề bài không yêu cầu loại bỏ biến a b c nên mình cứ tưởng ý của đề bài là để các hàm sau kế thừa các giá trị của a b c.
Hy vọng lần nầy sẽ không còn sai nữa :)
;Chuong 2
(defun c:BT2-1(/ x y z e);cau 1
(setq x (+ 2 7) y (- 3 1.25) z 5.0)
(setq e (+ z (* 0.4 (- x y))))
(setq ketqua (+ x y z e))
)
(defun c:BT2-2(/ a b c);cau 2
(setq ketqua nil)
(setq a 2000)
(setq b 1000)
(setq c (* a b 0.5))
)
;cau 3
;vi 2 la so nguyen nen se cho ket qua la so nguyen, khi tich a*b khong chia het cho 2 se cho ket qua sai. khi nhan voi 0.5 la so thuc nen cho ket qua la so thuc nen chinh xac.
(defun trungbinhcongbaso(a b c);cau 4
(/ (+ a b c) 3.0)
)
(defun dientichtamgiac(a b);cau 5
(* a b 0.5)
)
(defun tichbonso(a b c d);cau 6
(* a b c d)
)
(defun lapphuongmotso(a);cau 7
(* a a a)
;cau 8
Command: (trungbinhcongbaso 1.1 2.2 3.3)
2.2
Command: (dientichtamgiac a b)
1.0e+006
Command: (tichbonso 1 2 3 4)
24
Command: (lapphuongmotso 5)
125
<<
|
Filename: 310328_bt2-1_bt2-2.lsp
|
|
Tác giả: kaka912511
Bài viết gốc: 316090
Tên lệnh: bt2-1 bt2-2 |
Chữa bài tập chương 2
;BT1
(defun c:BT2-1( / x y z e)
(setq x (+ 2 7))
(setq y (- 3 1.25))
(setq z 5.0 )
(setq e (+ z (* 0.4 (- x y ))))
(setq kq (+ x y z e ))
)
;BT2
(defun c:BT2-2 (/ a b )
(setq kq nil)
(setq c ( / (* (setq a 2000 ) (setq b 1000) ) 2.0 ) )
)
;trung binh cong 3 so
(defun trungbinhcong ( a b c )
(/ (+ a b c ) 3.0 ) )
; ham tinh dien tich
(defun dientich ( a b )
(/ (* a b ) 2.0 ))
;ham tinh tich 4 so
(defun tich ( a b...
>>
;BT1
(defun c:BT2-1( / x y z e)
(setq x (+ 2 7))
(setq y (- 3 1.25))
(setq z 5.0 )
(setq e (+ z (* 0.4 (- x y ))))
(setq kq (+ x y z e ))
)
;BT2
(defun c:BT2-2 (/ a b )
(setq kq nil)
(setq c ( / (* (setq a 2000 ) (setq b 1000) ) 2.0 ) )
)
;trung binh cong 3 so
(defun trungbinhcong ( a b c )
(/ (+ a b c ) 3.0 ) )
; ham tinh dien tich
(defun dientich ( a b )
(/ (* a b ) 2.0 ))
;ham tinh tich 4 so
(defun tich ( a b c d )
( * a b c d ))
;ham tinh lap phuong 1 so
(defun lapphuong ( a )
( * a a a ))
;cau3 vi cac so nhap vao deu la kieu nguyen , vi vay (a+b)/2 la 1 so nguyen ,
;neu tong 2 so khong chia het cho 2 thi ketqua se sai.
;BT2-2
(defun dtvanhkhan ( a b )
; a ban kinh duong tron ngoai , b ban kinh duong tron trong
(* 3.14 ( - (* a a ) (* b b ) ))
)
( defun dttamgiac ( a b c )
; a+b > c neu khong ket qua sai
( setq p ( * ( + a b c ) 0.5 ))
( sqrt ( * p (- p a ) (- p b ) ( - p c )))
)
(defun dttheptron ( d )
( * 3.14 ( / d 2 ) (/ d 2 ) )
)
(defun klthanhthep ( d )
; d : meter
( * (/ d 2 ) (/ d 2 ) 3.14 7850 11.7 )
)
(defun klthephop ( a x )
; a mm , x mm
; a chieu dai canh ngoai , x be day
(* (- ( * 4 a x ) (* 4 x x ) ) 7850 0.000001 11.7 ))
(defun klthephop1 ( a b )
;a mm, b mm
; a canh ngoai b canh trong
(* ( - ( * a a ) ( * b b ) ) 7850 0.000001 11.7 ))
http://www.cadviet.com/upfiles/3/129539_bt21_bt22_2.lsp
<<
|
Filename: 316090_bt2-1_bt2-2.lsp
|
|
Tác giả: blamouse
Bài viết gốc: 14041
Tên lệnh: dra |
Vẽ nhiều tỷ lệ trong một bản vẽ
Tuy làm vậy nhưng vẫn không được. 1 bản vẽ cho 2 viewport tỉ lệ khác nhau khi update Dim, Dim nó đổi theo chung luôn...
Hơn nữa chữ phải chỉnh thế nào? Các con số đều không thấy được ... hic!
|
Tác giả: tientracdia
Bài viết gốc: 308387
Tên lệnh: lkk |
lisp ghi kích thước không dùng dim
1. Bạn xoá cái dòng (setq tl (getint "\n don vi ban do ht (500): "))
2. Sửa lại (command "PLINE" pt4 "W" 0.0 w pt14 "W" 0.0 0.0 pt11 "")
3. (command "TEXT" "M" pt h (RTD goc) canh )
(command "TEXT" "M" pt h (+ (RTD goc) 180) canh ) xoá dấu "" ở cuối.
;; free lisp from cadviet.com
;;; this lisp was...
>> 1. Bạn xoá cái dòng (setq tl (getint "\n don vi ban do ht (500): "))
2. Sửa lại (command "PLINE" pt4 "W" 0.0 w pt14 "W" 0.0 0.0 pt11 "")
3. (command "TEXT" "M" pt h (RTD goc) canh )
(command "TEXT" "M" pt h (+ (RTD goc) 180) canh ) xoá dấu "" ở cuối.
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/108679-nho-chinh-sua-lisp-ghi-kich-thuoc-khong-dung-dim/page-2
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/108679-nho-chinh-sua-lisp-ghi-kich-thuoc-khong-dung-dim/
(defun RTD (a) (* 180 (/ a PI)))
(defun C:lkk (/ h k d w x f so canh goc goc90 pt pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13 pt14 text noidung diem hieu old echo)
(setq echo (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "layer" "m" "B-Canh1" "c" "7" "" "")
(command "style" "VHELVCN" "vni-Helve-Condense" 0 1 0 "" "")
(setq old (getvar "OSMODE"))
(setvar "OSMODE" 33)
(command ".layer" "s" "B-CANH1" "")
(if (tblsearch "style" "VHELVCN") (setvar "TEXTSTYLE" "VHELVCN"))
(command "UNDO" "BE" "")
;;(setq tl (getint "\n don vi ban do ht (500): "))
(if (= tl nil) (setq tl 500))
(setq tl1 (getint (strcat "\n don vi ban do ht (" (rtos tl 2 0) "): ")))
(if tl1 (setq tl tl1))
;co so lan: x
(setq x (/ 1000 tl))
;(setq h (/ 1.7 x))
(while (= (setq h (/ 1.7 x)) 0))
(setq d (/ 1.6 x)
w (/ 0.48 x)
k 2.50
f (/ 0.90 x)) ; khoang cach mui ten voi canh can do
(while (and (/= (setq pt1 (getpoint "\nDiem dau: ")) nil)
(/= (setq pt2 (getpoint pt1 "\nDiem cuoi: ")) nil))
(setvar "OSMODE" 0)
(setq goc (angle pt1 pt2) so (distance pt1 pt2)
canh (rtos so 2 2) )
(setq pt8 (polar pt1 goc (/ so 2))
pt7 (getpoint pt8 "\nPhia:")
pt10 (inters pt1 pt2 pt7 (polar pt7 (+ goc (/ PI 2)) 1) nil)
goc90 (angle pt10 pt7))
(setq pt3 (polar pt1 goc90 f)
pt4 (polar pt2 goc90 f)
pt5 (polar pt3 goc d)
pt6 (polar pt5 goc d)
pt9 (polar pt3 goc (/ so 2))
pt (polar pt8 goc90 (/ 1.4 x))
pt11 (polar pt6 goc (- so (* 4 d)))
pt14 (polar pt11 goc d))
(if (or (<= (RTD goc) 90) (>= (RTD goc) 270))
(command "TEXT" "M" pt h (RTD goc) canh "")
(command "TEXT" "M" pt h (+ (RTD goc) 180) canh "")
);if
(setq text (entlast)
noidung (entget text)
diem (cdr (assoc 10 noidung)))
(setq pt12 (inters pt3 pt4 diem (polar diem goc90 20) nil)
pt13 (polar pt12 goc (* 2 (distance pt12 pt9)))
)
(setq hieu (- (distance pt6 pt11) (distance pt12 pt13)))
(if (>= hieu (- 0 0.01))
(progn
(command "PLINE" pt3 "W" 0.0 w pt5 "W" 0.0 0.0 pt6 "")
(command "PLINE" pt11 "W" 0.0 0.0 pt14 "W" w 0.0 pt4 "")
;(command "MIRROR" "L" "" pt9 pt8 "")
);progn
);if
(setvar "OSMODE" 33)
);while
(command "UNDO" "E" "")
(setvar "OSMODE" old)
(setvar "cmdecho" echo)
)
Con phần này sửa ở đâu, mong bạn giữp
2. Sửa lại (command "PLINE" pt4 "W" 0.0 w pt14 "W" 0.0 0.0 pt11 "")
3. (command "TEXT" "M" pt h (RTD goc) canh )
(command "TEXT" "M" pt h (+ (RTD goc) 180) canh ) xoá dấu "" ở cuối. <<
|
Tác giả: gia_bach
Bài viết gốc: 59936
Tên lệnh: test | |
Tác giả: gia_bach
Bài viết gốc: 63989
Tên lệnh: openfile |
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
Chào thiep
Bạn copy&paste vào command line:
(vla-open (vla-get-documents (vlax-get-acad-object)) "C:\\Program Files\\AutoCAD 2007\\Sample\\Lineweights.dwg")
Hay
|
Filename: 63989_openfile.lsp
|
|
Tác giả: gia_bach
Bài viết gốc: 70540
Tên lệnh: test | |
Tác giả: taybacincc
Bài viết gốc: 326196
Tên lệnh: br sb |
Bring to front, send to back
(defun c:BR ()
(princ "\nChon doi tuong: ")
(command ".DRAWORDER" (ssget) "" "f")
(princ)
)
;;;;
(defun c:SB ()
(princ "\nChon doi tuong: ")
(command ".DRAWORDER" (ssget) "" "b")
(princ)
)
Lệnh tắt trong cad là DR bạn nha. Bạn có thể dùng tạm code này nha. Đánh lệnh rồi chọn đối tượng
|
Filename: 326196_br_sb.lsp
|
|