Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#3621 3d.decor

3d.decor

    biết vẽ arc

  • Members
  • PipPip
  • 44 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 13 June 2011 - 08:40 AM

Lại vấp chỗ add text rồi, hem bít sao nữa :( bạn thử dùng thằng này thay thế xem sao. Chú ý : tạo text theo style + height hiện thời, bạn nên chọn style trước nhé

(defun c:tkh (/ lst msp pt ss lay ar txtsiz pt)
;(mapcar '(lambda(x) (set x nil)) '(lst msp pt ss lay ar txtsiz pt))
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1)
(progn
(vl-load-com)
(acet-sysvar-set (list "cmdecho" 0))
(grtext -1 "S\U+01A1n T\U+00F9ng' Lisp")
(Princ "\nCh\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Hatch \U+0111\U+1EC3 t\U+00EDnh di\U+1EC7n t\U+00EDch : ")
(if (setq ss (ssget(list (cons 0 "HATCH"))))
(progn
(foreach e (mapcar 'vlax-ename->vla-object (st-ss->ent ss))
(setq lay (vlax-get-property e 'Layer))
(if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-area (list e))))
(setq ar (* 0.000001 (vlax-get-property e 'Area)))
(progn
(setq ar 0)(princ (strcat "\nC\U+00F3 Hatch thu\U+1ED9c layer " lay " kh\U+00F4ng t\U+00EDnh \U+0111\U+01B0\U+1EE3c di\U+1EC7n t\U+00EDch.\n\U+0110\U+00E3 highlight v\U+00E0 t\U+00EDnh di\U+1EC7n t\U+00EDch b\U+1EB1ng 0"))
(redraw (vlax-vla-object->ename e) 3)
)
)
(if (not (assoc lay lst))
(setq lst (cons (cons lay ar) lst))
(setq lst (subst (cons lay (+ ar (cdr (assoc lay lst))))
(assoc lay lst) lst))))
(setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))

txtsiz (* (getvar "dimtxt")(getvar "dimscale"))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) i -1)

(while (setq e (nth (setq i (1+ i)) lst))
(wtxt_l (strcat (car e) " : " (rtos (cdr e) 2 2) "m2") '(0 0 0))
(setq pt (ACET-SS-DRAG-MOVE (ssadd (entlast)) '(0 0 0) (strcat "\n\U+0110i\U+1EC3m \U+0111\U+1EB7t ghi ch\U+00FA t\U+1ED5ng di\U+1EC7n t\U+00EDch Hatch thu\U+1ED9c layer " (car e))))
(command ".move" (entlast) "" '(0 0 0) pt)
)
(princ "\n\U+0110\U+00E3 th\U+1EF1c hi\U+1EC7n xong !")
)
(alert "Kh\U+00F4ng c\U+00F3 Hatch n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn !"))
)
(alert "Phi\U+00EAn b\U+1EA3n CAD c\U+1EE7a b\U+1EA1n kh\U+00F4ng h\U+1ED7 tr\U+1EE3 t\U+00EDnh di\U+1EC7n t\U+00EDch Hatch !")
)
(acet-sysvar-restore)(princ))
(defun st-ss->ent (ss / n e l)
(setq n -1)
(while (setq e (ssname ss (setq n (1+ n))))
(setq l (cons e l))
)
)
(defun wtxt_l(txt p / sty d h1 h2 wf h);;;Write txt on graphic screen at p
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h1 (cdr (assoc 40 d))
h2 (cdr (assoc 42 d))
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 1)(cons 11 p) (cons 1 txt) (cons 10 p))))

mình dùng thử đã ổn rồi pro à
chắc có khi cùng lỗi với bạn ở trên
thank you
pro có thể viết thêm cùng loại hatch thì tính 1 diện tích ( về file lớn như quy hoạch có thể dùng rất tốt)
chứ chọn lần lượt từng ô về cơ bản không khác lisp DT là mấy
  • 0

#3622 beba

beba

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 13 June 2011 - 10:34 AM

Em tìm được cái Lisp nối Line đã bị break thành 2 đoạn rời nhau, nhưng nó chỉ nối được với Line,
còn Polyline thì không được
Nhờ mấy anh sửa cho nối được với Polyline


(defun C:lJ (/ ob1 ob2 ob3 ent1 ent2 ent3 s1 e1 l1 s2 e2 l2
p1 p2 p3 p4 p5 ang1 ang2 loop lineerr test mloop)
(graphscr)
(defun lineerr(err)
(if (and (/= err "Function cancelled")(/= err "quit / exit abort"))
(progn
(princ (strcat "\n>>Error: " err))
(princ)
)
(princ)
)
(if (and ob1 (/= ob1 "Exit"))(redraw (car ob1) 4))
(if (and ob2 (/= ob2 "Exit"))(redraw (car ob2) 4))
(command "_.UNDO" "_End")
(setvar "cmdecho" 1)
(setq *error* olderr)
)
(setvar "cmdecho" 0)
(setq olderr *error*
*error* lineerr
mloop T
);** setq end **
(command "_.UNDO" "_Group")
(while mloop
(setq loop T)
(while loop
(initget "Exit")
(setq ob1 (entsel "\n>>> Select the first Line or [Exit]: "))
(cond
((= ob1 "Exit")(exit))
((= ob1 nil)(princ "None found."))
((progn
(setq test (cdr (assoc 0 (entget (car ob1)))))
(if (/= test "LINE")(princ "This is not a Line")(setq loop nil))
))
)
);** while end **
(setq ent1 (entget (car ob1))
loop T
test nil
);** setq end **
(redraw (car ob1) 3)
(while loop
(initget "Exit")
(setq ob2 (entsel "\n>>> Select the second Line or [Exit]: "))
(cond
((= ob2 "Exit")(exit))
((= ob2 nil)(princ "None found."))
((eq (car ob1) (car ob2))(princ "Duplicated select"))
((progn
(setq test (cdr (assoc 0 (entget (car ob2)))))
(if (/= test "LINE")(princ "This is not a Line")(setq loop nil))
))
)
);** while end **
(setq ent2 (entget (car ob2))
s1 (cdr (assoc 10 ent1))
e1 (cdr (assoc 11 ent1))
l1 (cdr (assoc 8 ent1))
s2 (cdr (assoc 10 ent2))
e2 (cdr (assoc 11 ent2))
l2 (cdr (assoc 8 ent2))
p1 (distance s1 s2)
p2 (distance e1 s2)
p3 (distance s1 e2)
p4 (distance e1 e2)
la 1
lin 1
test nil
);** setq end **
(if (> p1 p2)
(progn
(setq p5 p1
sp (list '10 (car s1) (cadr s1))
ep (list '11 (car s2) (cadr s2))
);** setq end **
);** progn end **
(progn
(setq p5 p2
sp (list '10 (car e1) (cadr e1))
ep (list '11 (car s2) (cadr s2))
);** setq end **
);** progn end **
);** if end **
(if (< p5 p3)
(progn
(setq p5 p3
sp (list '10 (car s1) (cadr s1))
ep (list '11 (car e2) (cadr e2))
);** setq end **
);** progn end **
);** if end **
(if (< p5 p4)
(progn
(setq p5 p4
sp (list '10 (car e1) (cadr e1))
ep (list '11 (car e2) (cadr e2))
);** setq end **
);** progn end **
);** if end **
(setq ang1 (atof (angtos (angle (cdr sp) (cdr ep)) 0 3))
ang2 (atof (angtos (angle s1 e1) 0 3))
);** setq end **
(if (>= ang1 270) (setq ang1 (- ang1 180)))
(if (>= ang1 180) (setq ang1 (- ang1 180)))
(if (>= ang2 270) (setq ang2 (- ang2 180)))
(if (>= ang2 180) (setq ang2 (- ang2 180)))
(if (= ang1 ang2)
(progn
(command "_.Erase" ob2 "")
(setq ent1 (subst sp (assoc 10 ent1) ent1)
ent1 (subst ep (assoc 11 ent1) ent1)
);** setq end **
(entmod ent1)
(princ "Done")
(terpri)
);** progn end **
(progn
(redraw (car ob1) 4)
(redraw (car ob2) 4)
(alert "These 2 lines cannot be joined. Because\nthey are parellel or intersecting\nor they are not coplanar.")
);** else progn end **
);** if end **
)
(setq *error* olderr)
(command "_.UNDO" "_Group")
(setvar "cmdecho" 1)
(prin1)
);** end of lisp **

(defun c:LINEJOIN()(c:LJ))

(princ)


  • 0

#3623 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 13 June 2011 - 02:15 PM

Em dùng thử thấy tốt và ưng ý rồi anh ơi,
nhưng em muốn sửa lại thêm 1 cái nữa cho đơn giản là :
Không cần : "\n Nhap chieu cao text: ""\n Kind of area : "
Chỉ cần ra kết quả là được rồi
Anh sửa thêm giúp em. Cảm ơn

Hề hề hề,
Thứ nhất, cái vụ nhập chiều cao text vốn là do bạn yêu cầu cơ mà, sao nay lại bỏ đi???
Thứ hai, nếu muốn bỏ đi như yêu cầu ở đây thì bạn hãy làm như sau:
1/- Với chiều cao text:
Xóa các dòng code
(setq h0 2)
(setq ht (getreal "\n Nhap chieu cao text: "))
(if (= ht nil)
(setq ht h0)
(setq h0 ht)
)

Thay thế bằng dòng code:
(setq ht 2)
hoặc thay giá trị 2 bằng giá trị mà bạn thích.

2/- Với kind of Area:
Xóa các dòng code:
(Setq ldt (Getstring t "\n Kind of area : "))
(cond

)

Thay thế bằng dòng code:
(setq ldt "")


Hề hề hề,
Chúc bạn vui.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3624 thuilathui

thuilathui

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 13 June 2011 - 04:17 PM

Các bro nào giúp em vụ này cái.
Em dùng lisp sau: link down về (My link)

Em sử dụng công cụ dimension, mỗi lần nhập tỉ lệ thì các thông số của dimension cũng thay đổi theo. Nói chung rất ok, chỉ có điều công ty em dùng dấu mũi tên là closed filled mà trong lisp lại mặc định là oblique, em lại ko biết sửa trong lisp như thế nào cho đúng, bro nào giỏi giúp em sửa lại chỗ đó nha. Em cám ơn nhìu ...!!!

Có thể gởi mail về địa chỉ cho em luôn được ko? Mail em đây: trandinhthuan@namtienco.com

Chúc các bro sức khỏe và thành công!!!!
  • 0

#3625 beba

beba

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 13 June 2011 - 07:45 PM

Hề hề hề,
Thứ nhất, cái vụ nhập chiều cao text vốn là do bạn yêu cầu cơ mà, sao nay lại bỏ đi???
Thứ hai, nếu muốn bỏ đi như yêu cầu ở đây thì bạn hãy làm như sau:


Cảm ơn anh Thanh Bình nhiều nha
Em bỏ phần " chiều cao text " khi làm trên bản vẽ tính
Còn Lisp đầu " nhập chiều cao text " em làm trên bản vẽ trực tiếp không cần chỉnh sửa
  • 0

#3626 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 14 June 2011 - 03:55 PM

Base.dcl là Dialog cơ sở của CAD, không hiểu tại sao lại không thấy trong Express (máy em) ^^. Bác Bình cũng thấy thế thì xơi tạm code của nó và cho vào support nè : (tên file Base.dcl )
// Next available MSG number is    15 
// MODULE_ID BASE_DCL_
/* Next available MSG number is 24 */

// BASE.DCL Version 1.1
//
// Copyright 1991-1994,1996-1997 by Autodesk, Inc.
//
// Permission to use, copy, modify, and distribute this software
// for any purpose and without fee is hereby granted, provided
// that the above copyright notice appears in all copies and
// that both that copyright notice and the limited warranty and
// restricted rights notice below appear in all supporting
// documentation.
//
// AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
// AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
// MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
// DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
// UNINTERRUPTED OR ERROR FREE.
//
// Use, duplication, or disclosure by the U.S. Government is subject to
// restrictions set forth in FAR 52.227-19 (Commercial Computer
// Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
// (Rights in Technical Data and Computer Software), as applicable.
//
//.
//
// Define common prototypes and subassemblies for use by
// ACAD.DCL and user-defined dialogs (AutoCAD), and by
// ACLT.DCL (AutoCAD LT).

// (The primitive widgets are set up automatically by init_dialog. The
// equivalent DCL is shown here (commented out) for reference.)

// dialog {
// layout = vertical;
// is_enabled = false;
// }
//
// cluster {
// layout = horizontal;
// }
//
// radio_cluster {
// layout = horizontal;
// is_enabled = true;
// }
//
// tile {
// layout = horizontal;
// is_enabled = true;
// }
//
// text : tile {
// fixed_height = true; // inhibit vertical expansion
// }
//
// image : tile {
// }
//
// button : tile {
// fixed_height = true;
// is_tab_stop = true;
// }
//
// image_button : button {
// is_tab_stop = true;
// }
//
// toggle : tile {
// fixed_height = true;
// is_tab_stop = true;
// }
//
// radio_button : tile {
// fixed_height = true;
// is_tab_stop = true;
// }
//
// list_box : tile {
// is_tab_stop = true;
// height = 10;
// width = 10;
// }
//
// edit_box : tile {
// fixed_height = true;
// is_tab_stop = true;
// }
//
// popup_list : tile {
// is_tab_stop = true;
// fixed_height = true;
// }
//
// slider : tile {
// is_tab_stop = true;
// }
//
// spacer : tile {
// }

//----- Styles of clusters.

row : cluster {
horizontal_margin = none;
vertical_margin = none;
children_alignment = centered;
}

column : cluster {
layout = vertical;
horizontal_margin = none;
vertical_margin = none;
}

boxed_row : cluster {
label = " ";
boxed = true;
children_alignment = centered;
}

boxed_column : cluster {
layout = vertical;
label = " ";
boxed = true;
}

//----- Styles of radio clusters.

radio_row : radio_cluster {
horizontal_margin = none;
vertical_margin = none;
children_alignment = centered;
}

radio_column : radio_cluster {
layout = vertical;
horizontal_margin = none;
vertical_margin = none;
}

boxed_radio_row : radio_cluster {
label = " ";
boxed = true;
children_alignment = centered;
}

boxed_radio_column : radio_cluster {
layout = vertical;
label = " ";
boxed = true;
}

//----- Horizontal and vertical blocks of running text.

concatenation : cluster {
fixed_width = true;
fixed_height = true;
children_alignment = centered;
}

paragraph : cluster {
layout = vertical;
fixed_height = true;
}

text_part : text {
horizontal_margin = none;
vertical_margin = none;
}

text_25 : text {
width = 25;
}

//----- Common spacers.

spacer_0 : spacer {
height = 0;
width = 0;
horizontal_margin = none;
vertical_margin = none;
}

spacer_1 : spacer {
height = 1;
width = 1;
horizontal_margin = none;
vertical_margin = none;
}

//----- The normal default widget.

default_button : button {
is_default = true;
}

//----- Standard prototype for making consistent "dialog retirement buttons".
// Used below for the predefined retirement buttons, and for user-defined
// dialogs that need retirement buttons with specialized verbs.

retirement_button : button {
fixed_width = true;
width = 8;
alignment = centered;
}

//----- Standard dialog retirement buttons. Unless one is building a dialog
// retirement subassembly containing specialized verbs, these will
// normally not be used directly by DCL code outside of base.dcl; use
// the pre-built subassemblies in the next section.

ok_button : retirement_button {
label = " OK ";
key = "accept";
is_default = true;
}

cancel_button : retirement_button {
label = "Cancel";
key = "cancel";
is_cancel = true;
}

help_button : retirement_button {
label = "&Help";
key = "help";
is_help = true;
}

info_button : retirement_button {
label = "&Info...";
key = "info";
}

//----- Pre-built arrays of dialog bottom-line buttons.

ok_only : column {
fixed_width = true;
alignment = centered;
: ok_button {
is_cancel = true;
}
}

ok_cancel : column {
: row {
fixed_width = true;
alignment = centered;
ok_button;
: spacer { width = 2; }
cancel_button;
}
}

ok_cancel_help : column {
: row {
fixed_width = true;
alignment = centered;
ok_button;
: spacer { width = 2; }
cancel_button;
: spacer { width = 2; }
help_button;
}
}

ok_cancel_help_info : column {
: row {
fixed_width = true;
alignment = centered;
ok_button;
: spacer { width = 2; }
cancel_button;
: spacer { width = 2; }
help_button;
: spacer { width = 2; }
info_button;
}
}

//----- Error reporting tiles.

errtile : text {
label = "";
key = "error";
width = 35; // must be long enough to hold error msgs
is_error_tile = true;
}

// A custer consisting of OK, Cancel, and Help on one line with the error tile
// below.

ok_cancel_help_errtile : column {
ok_cancel_help;
errtile;
}

// The same thing without the Help button for subdialogues that have no help
// available.

ok_cancel_err : column {
ok_cancel;
errtile;
}

//----- Currently, the only dcl setting is the audit_level which controls the
// level of semantic error checking applied during a load_dialog operation.
// (0 = none, 1 = errors, 2 = warnings, 3 = hints)
// See AutoCAD's README for details.
default_dcl_settings : tile {
audit_level = 1;
}

//----- Miscellaneous parts used by ACAD.DCL (AutoCAD) & ACLT.DCL (AutoCAD LT).

image_block : image {
key = "show_image";
height = 1;
width = 1;
}

icon_image : image_button {
color = 0;
width = 12;
aspect_ratio = 0.66;
allow_accept = true;
fixed_height = true;
fixed_width = true;
}

edit12_box : edit_box {
edit_width = 12;
edit_limit = 148; // 18 * 8 (CIF/MIF size)
}

edit32_box : edit_box {
edit_width = 32;
edit_limit = 2048; // MAX_VALUE (256 * 8 (CIF/MIF size))
}

// The following are for the color-selection dialogs

swatch : image_button {
vertical_margin = none;
horizontal_margin = none;
fixed_height = true;
fixed_width = true;
height = 1.5;
width = 3;
allow_accept = true;
}

color_palette_1_7 : row { // Standard colors 1-7
: swatch { color = 001; key = "001"; }
: swatch { color = 002; key = "002"; }
: swatch { color = 003; key = "003"; }
: swatch { color = 004; key = "004"; }
: swatch { color = 005; key = "005"; }
: swatch { color = 006; key = "006"; }
: swatch { color = 007; key = "007"; }
}

color_palette_1_9 : row { // Standard colors, plus 8 and 9
color_palette_1_7;
: swatch { color = 008; key = "008"; }
: swatch { color = 009; key = "009"; }
}

color_palette_0_9 : row { // Standard colors, plus 0, 8, and 9
: swatch { color = 000; key = "000"; }
color_palette_1_9;
}

color_palette_250_255 : row { // Grey shades 250-255
: swatch { color = 250; key = "250"; }
: swatch { color = 251; key = "251"; }
: swatch { color = 252; key = "252"; }
: swatch { color = 253; key = "253"; }
: swatch { color = 254; key = "254"; }
: swatch { color = 255; key = "255"; }
}

std_rq_color :column{
:column {
:boxed_row {
fixed_width = true;
label = "Standard Colors";
color_palette_1_9;
}
:row {
:boxed_row {
fixed_width = true;
label = "Gray Shades";
color_palette_250_255;
}
:boxed_row {
fixed_width = true;
label = "Logical Colors";
:button {
label = "BY&LAYER";
key = "256";
}
:button {
label = "BY&BLOCK";
key = "000";
}
}
}
}
:boxed_column {
label = "Full Color Palette";
:image_button{
key = "hiside";
alignment = centered;
width = 40;
height = 4;
allow_accept = true;
is_enabled = false;
}
:image_button{
alignment = centered;
key = "loside";
width = 40;
height = 4;
allow_accept = true;
is_enabled = false;
}
}
:row {
fixed_width = true;
alignment = centered;
children_alignment = bottom;
:edit12_box {
label = "Color:";
key = "color_edit";
allow_accept = true;
}
:swatch {
key = "color_image";
}
}
ok_cancel_help_errtile;
}

// The preceding are for color-selection dialogs


// Top and bottom sub-assemblies for the files dialogue
files_topdf : column {
: edit_box {
key = "pedit";
label = "&Pattern:";
edit_width = 35;
}
: row {
: text {
label = "Directory:";
}
: text {
key = "dirtext";
width = 35;
}
}
}

files_bottomdf : column {
: edit_box {
key = "fedit";
label = "&File:";
allow_accept = true;
}
ok_cancel;
errtile;
}

fcf_ibut : image_button {
horizontal_margin = none;
width = 3.5;
height = 1.2;
color = 0;
alignment = bottom;
}

fcf_ebox : edit_box {
horizontal_margin = none;
edit_width = 7;
fixed_width = true;
alignment = bottom;
}

fcf_ebox1 : edit_box {
horizontal_margin = none;
edit_width = 3;
edit_limit = 3;
fixed_width = true;
alignment = bottom;
}

fcf_ibut1 : image_button {
width = 5.0;
aspect_ratio = 0.66;
color = 0;
allow_accept = true;
}

Base.dcl là Dialog cơ sở của CAD, không hiểu tại sao lại không thấy trong Express (máy em) ^^. Bác Bình cũng thấy thế thì xơi tạm code của nó và cho vào support nè : (tên file Base.dcl )

Thằng này nhiều khi nó nằm sâu thăm thẳm bác Ketxu ạ!
Chẳng hạn:
c:\Documents and Settings\vanha.DTVKSTKMT\Application Data\Autodesk\AutoCAD 2007\R17.0\enu\Support\base.dcl
c:\Program Files\AutoCAD 2007\UserDataCache\Support\base.dcl

Thằng này nhiều khi nó nằm sâu thăm thẳm bác Ketxu ạ!
Chẳng hạn:
c:\Documents and Settings\vanha.DTVKSTKMT\Application Data\Autodesk\AutoCAD 2007\R17.0\enu\Support\base.dcl
c:\Program Files\AutoCAD 2007\UserDataCache\Support\base.dcl

CHính xác là mình phải lấy code này cho bác Bình từ khu vực dành cho Thùng rác của ổ .... D

D:\$RECYCLE.BIN\S-1-5-21-4002689898-964897584-2226308410-1002\$RXX19GM\CAD2008\en-us\Acad\Program Files\Root\UserDataCache\Support

Thật là phi thường :)

CHính xác là mình phải lấy code này cho bác Bình từ khu vực dành cho Thùng rác của ổ .... D
Thật là phi thường :)

DVH :
Ủa, không có nó sao Cad chạy được?

Thế mềnh mới dùng từ Phi thường ^^ Xin phép hợp nhất bài lại cho đỡ loãng topic
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3627 3d.decor

3d.decor

    biết vẽ arc

  • Members
  • PipPip
  • 44 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 15 June 2011 - 09:52 AM

pro nào rảnh viết hộ lisp dọn mặt bằng để chuyển sang 3d EXTRUDE hộ mình được không
bao gồm dùng lệnh OVERKILL nối và tẩy tất cả line trùng nhau
nối tất các line hở kể cả line song song ( nối hai đầu hở )
nếu tẩy các nét thừa và giao nhau ( phía trong ) như lisp WALL không biết pro nào viết thì tốt
( nhưng đây là mặt bàng bên kiến trúc chuyển có tường rồi )
sau đó hàn kín lại như lệnh BOUNDARY thành một đối tượng
chuyển sang 3d max EXTRUDE là OK
pro nào viết được thì em rất nhàn em vẽ 3d ngày tẩy mấy cái mặt bằng rất mất công

rất cảm ơn a
  • 0

#3628 vietthang228

vietthang228

    Chưa sử dụng CAD

  • Members
  • Pip
  • 2 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 15 June 2011 - 09:57 AM

Tình hình là e đang rất khó khăn, nhờ các bác cho e xin 1 lisp như sau:
E có 1 chuỗi các text. VD như: một hai ba bốn năm sáu (các text này nằm trong 1 văn bản word)
bây giờ e muốn đưa nó vào cad mà khi chọn vị trí thứ nhất nó hiện một, chọn vị trí thứ hai nó chọn hai...
E đã thử viết mà chưa được!
Mong các bro giúp đỡ e!
Địa chỉ email của e: vietthang228@gmail.com hoặc bác nào có thời gian xin chỉ giáo qua yahô: vthangpecc1
E xin chân thành cảm ơn các bác!
  • 0

#3629 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 15 June 2011 - 10:15 AM

pro nào rảnh viết hộ lisp dọn mặt bằng để chuyển sang 3d EXTRUDE hộ mình được không
bao gồm dùng lệnh OVERKILL nối và tẩy tất cả line trùng nhau
nối tất các line hở kể cả line song song ( nối hai đầu hở )
nếu tẩy các nét thừa và giao nhau ( phía trong ) như lisp WALL không biết pro nào viết thì tốt
( nhưng đây là mặt bàng bên kiến trúc chuyển có tường rồi )
sau đó hàn kín lại như lệnh BOUNDARY thành một đối tượng
chuyển sang 3d max EXTRUDE là OK
pro nào viết được thì em rất nhàn em vẽ 3d ngày tẩy mấy cái mặt bằng rất mất công

rất cảm ơn a

Có những thứ máy móc không làm thay con người được bạn ạ :)

Tình hình là e đang rất khó khăn, nhờ các bác cho e xin 1 lisp như sau:
E có 1 chuỗi các text. VD như: một hai ba bốn năm sáu (các text này nằm trong 1 văn bản word)
bây giờ e muốn đưa nó vào cad mà khi chọn vị trí thứ nhất nó hiện một, chọn vị trí thứ hai nó chọn hai...
E đã thử viết mà chưa được!
Mong các bro giúp đỡ e!
Địa chỉ email của e: vietthang228@gmail.com hoặc bác nào có thời gian xin chỉ giáo qua yahô: vthangpecc1
E xin chân thành cảm ơn các bác!

Với những thông tin bạn đưa ra thì .. gần như vô vọng :)
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3630 traitimsat034

traitimsat034

    biết vẽ pline

  • Members
  • PipPip
  • 61 Bài viết
Điểm đánh giá: 15 (tàm tạm)

Đã gửi 15 June 2011 - 07:37 PM

Bạn sửa lại 1 tí như vầy :) Brgs

(defun c:rtt(/ ss sst)
(setq ss (ssadd))
(while (or
(= (setq sst (acet-list-to-ss (vl-remove-if '(lambda(x) (null (wcmatch (acet-dxf 0 (entget x)) "*TEXT"))) (acet-ss-to-list ss)))) nil)
(>(sslength sst) 1))
(Prompt "\nXin h\U+00E3y ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng :")
(setq ss (ssget))
)
(command ".rotate" ss "" (acet-dxf 10 (entget(ssname sst 0))) (* 180.0 (/ (getangle "\nG\U+00F3c quay :") pi)))
)


Bác KETXU ơi làm ơn sửa lisp này giúp mình với.
sau một thời gian sử dụng thì mình thấy hơi bất tiện nên đành phải nhờ bạn lần nữa.
vấn đề là khi text của mình hợp với phương ngang 1 góc khác 0 thì khi sử dụng lệnh nó lại quay theo một góc không đúng theo ý mình. bạn có thể sửa sao cho phương của text là trùng với phương của 2 điểm pick. cám ơn bạn, ngại quá.
  • 0

#3631 3d.decor

3d.decor

    biết vẽ arc

  • Members
  • PipPip
  • 44 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 15 June 2011 - 09:23 PM

pro nào rỗi tẩy xoá hộ mình đoạn lisp ofset đường trục giữa của tường
chỉ giữ lại doạn sau là trim các điểm giao nhau của tường được không
lisp WALL
rất cám ơn ạ

(defun c:wall ()
(command "trim" "" "e" "e" "p" "n" "")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setq hl (getvar "highlight"))
(setq tbl (tblsearch "layer" "center"))
(if (= tbl nil) (command "-layer" "n" "center" "c" "8" "center" ""))
(setq tbl (tblsearch "layer" "cut"))
(if (= tbl nil) (command "-layer" "n" "cut" "c" "1" "cut" "l" "center" "cut" ""))
(setq tbl (tblsearch "layer" "wall"))
(if (= tbl nil) (command "-layer" "n" "wall" ""))
(setvar "clayer" "wall")
(setvar "osmode" 0)
(setq ss (ssget '((0 . "line"))))
(setq day (cond (day) (220)))
(setq oldday day)
(setq day (getint (strcat "\nnhap chieu day tuong <"(rtos oldday 2 1)"> : ")))
(if (null day)
(setq day oldday)
)
(setq day1 (/ (* day 7) 15))
(command "change" ss "" "p" "la" "center" "")
(setq i 0)
(setq lp nil)
(setq ssml nil)
(setq ssml (ssadd))
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
lp (append (list (append (list p1) (list p2))) lp)
)
(command "mline" "j" "z" "s" day p1 p2 "")
(command "explode" "l")
(setq ssline (ssget "p"))
(setq line1 (ssname ssline 0))
(setq line2 (ssname ssline 1))
(setq ssml (ssadd line1 (ssadd line2 ssml)))
(setq i (1+ i))
)
(command "-layer" "off" "center" "")
(setq j 0)
(setvar "highlight" 0)
(while (< j (length lp))
(setq nhom (nth j lp)
pt1 (car nhom)
pt2 (last nhom)
angf (+ (angle pt1 pt2) (/ pi 2))
t1 (polar pt1 angf day1)
t2 (polar pt1 (+ angf pi) day1)
t3 (polar pt2 (+ angf pi) day1)
t4 (polar pt2 angf day1)
)
(command "trim" ssml "" "f" t1 t2 t3 t4 t1 "" "")
(setq j (1+ j))
)
(setq q 0)
(setq ssml (ssget "x" '((0 . "line") (8 . "center"))))
(while (< q (sslength ssml))
(setq l1 (ssname ssml q)
pf1 (cdr (assoc 10 (entget l1)))
pf2 (cdr (assoc 11 (entget l1)))
)
(setq k 0)
(while (< k (sslength ssml))
(setq l2 (ssname ssml k)
pf3 (cdr (assoc 10 (entget l2)))
pf4 (cdr (assoc 11 (entget l2)))
d1 (distance pf1 pf3)
d2 (distance pf1 pf4)
d3 (distance pf2 pf3)
d4 (distance pf2 pf4)
)
(if (or (and (< (fix d1) (* day1 2)) (> d1 0)) (and (< (fix d2) (* day1 2)) (> d2 0)) (and (< (fix d3) (* day1 2)) (> d3 0))
(and (< (fix d4) (* day1 2)) (> d4 0)))
(command "fillet" l1 l2)
)
(setq k (1+ k))
)
(setq q (1+ q))
)
(command "change" ssml "" "p" "la" "center" "")
(dimtuong)
(setvar "clayer" old_layer)
(command "-layer" "on" "wall" "")
(setvar "osmode" snap)
(setvar "highlight" hl)
(setvar "cmdecho" 1)
(command "undo" "e")
(command "trim" "" "e" "n" "")
)

  • 0

#3632 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 15 June 2011 - 09:41 PM

pro ơi có tính được từng loại hatch ko

Mình không hiểu ý bạn ? Mình trả lời rất kỹ trên mỗi bài viết rồi!

Chú ý bạn 3d.decor : Nếu bạn yêu cầu liên tục như thế này, sẽ khó có người giúp bạn kịp. Hãy nghĩ kỹ trước khi post 1 yêu cầu , và phải nghiêm túc với nó.Cố gắng tránh post vài bài liền nhau 1, cũng như vài yêu cầu trong 1 bài
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3633 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 16 June 2011 - 11:17 AM

Trên diễn đàn có 1 lisp chuyển tất cả font trong text style về font mình muốn nhưng lại không chỉnh trong mục width factor về 1,kính nhờ các bác chỉnh sửa thêm chức năng đưa width factor bằng 1 giùm e.Thanks.

Bạn 790312 có thâm niên post bài rồi, mình nhắc bạn cho code vào trong thẻ code, không lại có những khi bị xóa thì thật phí :)
Yêu cầu của bạn đã được giải quyết ở Đây
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3634 3d.decor

3d.decor

    biết vẽ arc

  • Members
  • PipPip
  • 44 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 16 June 2011 - 05:35 PM

bác nào viết hộ lisp này với
link: http://www.cadviet.c...p?showtopic=507
nọi dung

Command: pe
PEDIT Select polyline or [Multiple]: m
Select objects: Specify opposite corner: 11 found
Select objects:
Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Undo]: j
Join Type = Extend
Enter fuzz distance or [Jointype] <8.0270>: 5.0
10 segments added to polyline
Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Undo]:

viết cho dễ sử dụng
gõ lệnh
seleck
go kich thuoc noi line
ok

rất cảm ơn
không có bác nào chịu khó tấy lisp wall bỏ lisp offset
chỉ giữ lại trim hộ mình sao
  • 0

#3635 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 16 June 2011 - 06:12 PM

bác nào viết hộ lisp này với
link: http://www.cadviet.c...p?showtopic=507
nọi dung

Command: pe
PEDIT Select polyline or [Multiple]: m
Select objects: Specify opposite corner: 11 found
Select objects:
Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Undo]: j
Join Type = Extend
Enter fuzz distance or [Jointype] <8.0270>: 5.0
10 segments added to polyline
Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Undo]:

viết cho dễ sử dụng
gõ lệnh
seleck
go kich thuoc noi line
ok

rất cảm ơn
không có bác nào chịu khó tấy lisp wall bỏ lisp offset
chỉ giữ lại trim hộ mình sao

Những dòng không phải code mà là trích lại từ command bạn cho vào Quote cho đẹp bài viết.

không có bác nào chịu khó tấy lisp wall bỏ lisp offset
chỉ giữ lại trim hộ mình sao

là những câu nói tối nghĩa, mong bạn tôn trọng người đọc một chút :)
Còn yêu cầu trên của bạn, bạn ngó qua Bài này , bạn đọc những dòng sau chữ command và liên hệ với các thao tác thủ công của bạn, bạn sẽ tìm thấy điểm tương đồng, từ đó có thể chủ động chỉnh sửa theo ý mình. Mình không nghĩ nó quá khó, hơn nữa, tốt nhất là nên biết mình dùng cái gì bạn à.
Phong cách post bài của bạn khiến liên tưởng đến mem leejang, dạo này ít thấy xuất hiện :rolleyes:
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3636 hugo007

hugo007

    biết lệnh erase

  • Members
  • PipPipPip
  • 103 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 16 June 2011 - 08:07 PM

Đây là đoạn lisp chuyển text về text style doifont,nhờ các bác thêm chức năng cho chuyển thêm mtext giùm e.Thanks.
(defun c:ET ()
(command "undo" "be")
(command "-style" "doifont" ".VnHelvetInsH Medium" "0" "1" "0" "n" "n")
(prompt "\nChon chu muon chinh.")
(setq ss (ssget))
(setq c 0)
(if ss (setq e (ssname ss c)))
(while e
(setq e (entget e))
(if (= (cdr (assoc 0 e)) "TEXT")
(progn
(setq txt "doifont")
(setq e (subst (cons 7 txt) (assoc 7 e) e))
(entmod e)
)
)
(setq c (1+ c))
(setq e (ssname ss c))
)
(command "undo" "end")
(Princ)
)

  • 0

#3637 hugo007

hugo007

    biết lệnh erase

  • Members
  • PipPipPip
  • 103 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 17 June 2011 - 03:13 PM

Đây là đoạn lisp chuyển text về text style doifont,nhờ các bác thêm chức năng cho chuyển thêm mtext giùm e.Thanks.

(defun c:ET ()
(command "undo" "be")
(command "-style" "doifont" ".VnHelvetInsH Medium" "0" "1" "0" "n" "n")
(prompt "\nChon chu muon chinh.")
(setq ss (ssget))
(setq c 0)
(if ss (setq e (ssname ss c)))
(while e
(setq e (entget e))
(if (= (cdr (assoc 0 e)) "TEXT")
(progn
(setq txt "doifont")
(setq e (subst (cons 7 txt) (assoc 7 e) e))
(entmod e)
)
)
(setq c (1+ c))
(setq e (ssname ss c))
)
(command "undo" "end")
(Princ)
)

Không bác nào giúp được e sao?Mong các bác giúp giùm e với.Thanks.
  • 0

#3638 lenhatanh

lenhatanh

    biết vẽ polygon

  • Members
  • PipPip
  • 75 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 17 June 2011 - 03:39 PM

Em nhờ các Bác sửa cho em đoạn lisp sau:
- Nhập liên tục các điểm thuộc mặt cắt ngang trên bình đồ.
- Nhập liên tục các điểm cao độ...
- Nhập liên tục khoảng cách giữa các điểm cao độ...
- Làm hiện thứ tự số điểm cao độ trên Listbox "TT", hiện trị số cao độ, khoảng cách
trên Listbox "CD" "KC" của Hộp thoại... (Hiện thông số vừa nhập lên Listbox).
Em xin cảm ơn trước !

(defun Get_tt (/ g:tt)
(set_tile "error" "")
(setq g:tt (get_tile "tt"))
(setq tt g:tt)
)
;------------------------------------------
(defun Get_cd (/ g:cd)
(set_tile "error" "")
(setq g:cd (get_tile "cd"))
(setq cd g:cd)
)
;------------------------------------------
(defun Get_kc (/ g:kc)
(set_tile "error" "")
(setq g:kc (get_tile "kc"))
(setq kc g:kc)
)
;------------------------------------------
(defun Get_li()
(start_list "tt" 3)
(foreach ch1 ltt (add_list ch1))
(end_list)
(start_list "cd")
(foreach ch2 lcd (add_list (rtos ch2 2 2)))
(end_list)
(start_list "kc")
(foreach ch3 lkc (add_list (rtos ch3 2 2)))
(end_list)
(mode_tile "start" 0)
(start_dialog)
)
;----------------------------------------------------------------------------------------------------------
(defun nhapdiem (/ di ki tlb tim tti)
(setq ldi '() lcd '() lkc '() ltt '() tti 1)
(setq tlb (getreal "\n Tile Cua Binh Do: "))
(setq tim (getreal "\n Khoang Cach Tu Mep Den Tim Kenh: "))
(while
(setq di (getpoint "\n Pick point...(<Retern>to end) :"))
(command "color" 40 "donut" "0" "0.15" di "")
(setq ldi (cons di ldi) ltt (cons (itoa tti) ltt))
(setq tii (+ tii 1))
)
(while
(setq di (getreal "\n Nhap Cao Do...(<Retern> to end) :"))
(setq lcd (cons di lcd))
)
(while
(setq ki (getreal "\n Nhap Khoang Cach...(<Retern> to end) :"))
(setq lkc (cons ki lkc))
)
(Get_li)
)
;******************************************************************************************
;----------------------------- Chuong trinh chinh -----------------------------------------
(defun C:Ve-MCN (/ gii mss cdo tt done)

(if (= (getvar "cmdecho") 1) (setvar "cmdecho" 0))
(setq datafile nil filename nil ltt nil lkc nil lcd nil)

(setq gii (load_dialog "Ve_Mcn.dcl"))
(setq done 3)

(while (> done 1)
(if (not (new_dialog "vemcn" gii)) (exit))
(action_tile "tt" "(Get_tt)")
(action_tile "cd" "(Get_cd)")
(action_tile "kc" "(Get_kc)")
(action_tile "nd" "(done_dialog 2)")
(action_tile "start" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq done (start_dialog))
(cond
((= done 2) (nhapdiem))
)
);---dong while
(unload_dialog gii)
(command "color" "bylayer" "ortho" "on" "osmode" 33 "REDRAW")
)
;-------------------------------------------------------------
;;;----------------Code file Ve_Mcn.DCL
vemcn : dialog {
label = "LËp Files Sè LiÖu vµ VÏ MCN §Þa H×nh";
fixed_width = center;
: boxed_row {
fixed_width = true;
fixed_height = true;
label = "Thong So Cac Diem:";
: list_box {
label = " TT";
fixed_width = true;
list = "1";
width = 5;
height = 26;
key="tt";
}
: list_box {
label = " Cao Do";
fixed_width = true;
list = "0.0";
width = 10;
height = 26;
key="cd";
}
: list_box {
label = " Kh.Cach";
fixed_width = center;
list = "0.0";
width = 10;
height = 26;
key="kc";
}
}
: row {
fixed_width = true;
children_alignment = centered;
:spacer { width=3.5; }
: button {
label = "Nhap Diem";
is_default = true ;
key = "nd";
width = 15;
}
: button {
label = "Ve MCN" ;
is_default = true ;
key = "start" ;
width = 8;
}
:spacer { height=0; }
: button {
label = "Cancel" ;
width = 8;
is_cancel= true ;
}
:spacer { height=3; }
}
}

  • 0

#3639 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 17 June 2011 - 06:38 PM

Em đã test thử lại lisp trên CAD2007-2008 vẫn chạy tốt mà, trình tự và ý muốn
em ghi lại trong file word nhờ các Bác đọc và chỉ giúp nhé. Em cảm ơn !
http://www.mediafire...qm99m8s817s77kl

Hề hề hề,
Quả thực minh chưa chạy được cái lisp của bạn. Song theo suy luận khi đọc cái lisp của bạn thì bạn hãy thử làm như sau xem sao. Có khi ăn tiền đấy. Hề hề hề....
1/ Bổ sung đoạn code
(UNLOAD_DIALOG DCL_AREA)
vào cái hàm con (defun SO_DWG (/ NUMS) như sau:
(defun SO_DWG (/ NUMS)
(setq NUMS (ATOF (GET_TILE "sodt")))
(setq NUMSO NUMS)
(setq TRUNGNHAU 0)
(alert (rtos NUMSO))

(UNLOAD_DIALOG DCL_AREA)
(setq DCL_AREA (LOAD_DIALOG (strcat "muare" (rtos NUMSO 2 0) ".dcl")))
(if (not (new_dialog (strcat "muare" (rtos NUMSO 2 0)) DCL_AREA))
(progn ;;;;;;;;;;;(Restore)
(exit))
)
(ACTION_TILE "cancel" "(unload_dialog dcl_area)")
(START_DIALOG)
(UNLOAD_DIALOG DCL_AREA)
)


Hề hề hề, nếu vậy mà chưa được như ý thì đừng oán mình nghen, chỉ là đoán mò vậy mà.
Hề hề hề,...
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3640 lenhatanh

lenhatanh

    biết vẽ polygon

  • Members
  • PipPip
  • 75 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 17 June 2011 - 08:12 PM

Hề hề hề,
Quả thực minh chưa chạy được cái lisp của bạn. Song theo suy luận khi đọc cái lisp của bạn thì bạn hãy thử làm như sau xem sao. Có khi ăn tiền đấy. Hề hề hề....
1/ Bổ sung đoạn code
(UNLOAD_DIALOG DCL_AREA)

Vẫn chưa được, dù sao cũng cám ơn mọi người, cám ơn bác Phamthanhbinh.
lúc khác em port file ảnh cho dễ hiểu hơn vậy...
Tiện đây, bác nào có Lisp (ví dụ cụ thể) trong đó có chuyển, bật tắt nhiều (2 trở lên) hộp thoại
thì port lên cho em tham khảo với nhé.

  • 0