Info | File | ||
Tác giả: phamngoctukts Bài viết gốc: 150518 Tên lệnh: invis vis invert |
Viết lisp theo yêu cầu [phần 2]
| ||
Tác giả: thanhduan2407 Bài viết gốc: 445477 Tên lệnh: vc vcc |
Hướng dẫn lập trình Lisp
Đây là chương trình vẽ cầu
(defun C:VC (/ HUONGCAU KC LINE1 LINE2 MIDP12 MP1 MP2 OBJPL1 OBJPL2 P1 P2 P3 P4 P5)
;;;;VE CAU
(MakeLayer_ "4_Giaothong_CAU" 7)
(or *WidthPline* (setq *WidthPline*... Đây là chương trình vẽ cầu
(defun C:VC (/ HUONGCAU KC LINE1 LINE2 MIDP12 MP1 MP2 OBJPL1 OBJPL2 P1 P2 P3 P4 P5)
;;;;VE CAU
(MakeLayer_ "4_Giaothong_CAU" 7)
(or *WidthPline* (setq *WidthPline* 0.50))
(setq
WidthPline
(getreal
(strcat "\nNh\U+1EADp \U+0111\U+1ED9 d\U+00E0y Width c\U+1EA7u <"
(rtos *WidthPline* 2 2)
">: "
)
)
)
(if (not WidthPline)
(setq WidthPline *WidthPline*)
(setq *WidthPline* WidthPline)
)
(or *Rau* (setq *Rau* 2.0))
(setq
Rau (getdist
(strcat "\nNh\U+1EADp chi\U+1EC1u d\U+00E0i r\U+00E2u <"
(rtos *Rau* 2 2)
">: "
)
)
)
(if (not Rau)
(setq Rau *Rau*)
(setq *Rau* Rau)
)
(setq P1 (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 nh\U+1EA5t: "))
(setq P2 (getpoint P1 "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 hai: "))
(setq P3 (getpoint
"\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 3 t\U+00EDnh \U+0111\U+1ED9 r\U+1ED9ng c\U+1EA7u: "
)
)
(setq HuongCau (CCW P1 P2 P3))
(setq MidP12 (mid P1 P2))
(MakeLine P1 P2 nil nil "4_Giaothong_CAU" nil nil)
(setq Line1 (entlast))
(setq KC (distance P3
(vlax-curve-getClosestPointTo (vlax-ename->vla-object Line1) (trans P3 1 0))
)
)
(cond ((= HuongCau 1)
(Progn
(setq P4 (Polar P1 (+ (angle P1 P2) (/ (* 3 Pi) 4)) Rau))
(setq P5 (Polar P2 (+ (angle P1 P2) (/ Pi 4)) Rau))
(MakeLWPolyline (list P4 P1 P2 P5) nil nil nil "4_Giaothong_CAU" nil nil)
(setq ObjPl1 (entlast))
(setq Mp1 (Polar P1 (+ (angle P1 P2) (/ (* 3 Pi) 2)) (/ KC 2)))
(setq Mp2 (Polar P2 (+ (angle P1 P2) (/ (* 3 Pi) 2)) (/ KC 2)))
(MakeLine Mp1 Mp2 nil nil "4_Giaothong_CAU" nil nil)
(setq Line2 (entlast))
)
)
((= HuongCau -1)
(Progn
(setq P4 (Polar P1 (+ (angle P2 P1) (/ Pi 4)) Rau))
(setq P5 (Polar P2 (+ (angle P2 P1) (/ (* 3 Pi) 4)) Rau))
(MakeLWPolyline (list P4 P1 P2 P5) nil nil nil "4_Giaothong_CAU" nil nil)
(setq ObjPl1 (entlast))
(setq Mp1 (Polar P1 (+ (angle P2 P1) (/ (* 3 Pi) 2)) (/ KC 2)))
(setq Mp2 (Polar P2 (+ (angle P2 P1) (/ (* 3 Pi) 2)) (/ KC 2)))
)
)
)
(vla-mirror
(vlax-ename->vla-object ObjPl1)
(vlax-3D-point Mp1)
(vlax-3D-point Mp2)
)
(setq ObjPl2 (entlast))
(vla-put-constantwidth (vlax-ename->vla-object ObjPl1) WidthPline)
(vla-put-constantwidth (vlax-ename->vla-object ObjPl2) WidthPline)
(entdel Line1)
(entdel Line2)
(Princ)
)
(defun C:VCC (/ HUONGCAU KC LINE1 LINE2 MIDP12 MP1 MP2 OBJPL1 OBJPL2 P1 P2 P3 P4 P5)
;;;;VE CONG
(MakeLayer_ "4_Giaothong_CAU" 7)
(or *WidthPline* (setq *WidthPline* 0.50))
(setq
WidthPline
(getreal
(strcat "\nNh\U+1EADp \U+0111\U+1ED9 d\U+00E0y Width c\U+1EA7u <"
(rtos *WidthPline* 2 2)
">: "
)
)
)
(if (not WidthPline)
(setq WidthPline *WidthPline*)
(setq *WidthPline* WidthPline)
)
(or *Rau* (setq *Rau* 0.5))
(setq
Rau (getdist
(strcat "\nNh\U+1EADp chi\U+1EC1u d\U+00E0i r\U+00E2u <"
(rtos *Rau* 2 2)
">: "
)
)
)
(if (not Rau)
(setq Rau *Rau*)
(setq *Rau* Rau)
)
(if (> Rau 0.5)
(setq Rau 0.5)
)
(setq P1 (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 nh\U+1EA5t: "))
(setq P2 (getpoint P1 "\nCh\U+1ECDn \U+0111i\U+1EC3m th\U+1EE9 hai: "))
(setq HuongCau (CCW P1 P2 P2))
(setq MidP12 (mid P1 P2))
(MakeLine P1 P2 nil nil "4_Giaothong_CAU" nil nil)
(setq Line1 (entlast))
(setq KC (distance P2
(vlax-curve-getClosestPointTo (vlax-ename->vla-object Line1) (trans P2 1 0))
)
)
(cond ((= HuongCau 1)
(Progn
(setq P4 (Polar P1 (+ (angle P1 P2) (/ (* 3 Pi) 4)) Rau))
(setq P5 (Polar P2 (+ (angle P1 P2) (/ Pi 4)) Rau))
(MakeLWPolyline (list P4 P1 P2 P5) nil nil nil "4_Giaothong_CAU" nil nil)
(setq ObjPl1 (entlast))
(setq Mp1 (Polar P1 (+ (angle P1 P2) (/ (* 3 Pi) 2)) (/ KC 2)))
(setq Mp2 (Polar P2 (+ (angle P1 P2) (/ (* 3 Pi) 2)) (/ KC 2)))
(MakeLine Mp1 Mp2 nil nil "4_Giaothong_CAU" nil nil)
(setq Line2 (entlast))
)
)
((= HuongCau -1)
(Progn
(setq P4 (Polar P1 (+ (angle P2 P1) (/ Pi 4)) Rau))
(setq P5 (Polar P2 (+ (angle P2 P1) (/ (* 3 Pi) 4)) Rau))
(MakeLWPolyline (list P4 P1 P2 P5) nil nil nil "4_Giaothong_CAU" nil nil)
(setq ObjPl1 (entlast))
(setq Mp1 (Polar P1 (+ (angle P2 P1) (/ (* 3 Pi) 2)) (/ KC 2)))
(setq Mp2 (Polar P2 (+ (angle P2 P1) (/ (* 3 Pi) 2)) (/ KC 2)))
)
)
)
(vla-mirror
(vlax-ename->vla-object ObjPl1)
(vlax-3D-point Mp1)
(vlax-3D-point Mp2)
)
(setq ObjPl2 (entlast))
(vla-put-constantwidth (vlax-ename->vla-object ObjPl1) WidthPline)
(vla-put-constantwidth (vlax-ename->vla-object ObjPl2) WidthPline)
(entdel Line1)
(entdel Line2)
(Princ)
)
(defun mid (p1 p2)
(mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
)
(defun LM:ss->ent (ss / i l)
(if ss
(repeat (setq i (sslength ss))
(setq l (cons (ssname ss (setq i (1- i))) l))
)
)
)
(defun CV:List-to-ss (lst / ss)
(setq ss (ssadd))
(foreach item lst
(or (= (type item) 'Ename)
(setq item (vlax-vla-object->ename item))
)
(setq ss (ssadd item ss))
)
ss
)
;;;(LM:UniqueFuzz (list 1 2 3 4 4 4 5 5 5 3 6 7 7 7 7 9) 0.0001)
(defun LM:UniqueFuzz (l f)
(if l
(cons (car l)
(LM:UniqueFuzz
(vl-remove-if
(function (lambda (x) (equal x (car l) f)))
(cdr l)
)
f
)
)
)
)
(defun MakeLayer_ (name colour /)
(if (null (tblsearch "LAYER" name))
(entmake
(list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
(cons 2 name)
(cons 62 colour)
)
)
)
)
(defun MakeLWPolyline
(listpoint closed Linetype LTScale Layer Color xdata / Lst)
(setq Lst (list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 8
(if Layer
Layer
(getvar "Clayer")
)
)
(cons 6
(if Linetype
Linetype
"bylayer"
)
)
(cons 48
(if LTScale
LTScale
1
)
)
(cons 62
(if Color
Color
256
)
)
(cons 100 "AcDbPolyline")
(cons 90 (length listpoint))
(cons 70
(if closed
1
0
)
)
)
)
(foreach PP listpoint
(setq Lst (append Lst (list (cons 10 PP))))
)
(if xdata
(setq Lst (append lst (list (cons -3 (list xdata)))))
)
(entmakex Lst)
)
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color xdata)
(entmakex (list '(0 . "LINE")
(cons 8
(if Layer
Layer
(getvar "Clayer")
)
)
(cons 6
(if Linetype
Linetype
"bylayer"
)
)
(cons 48
(if LTScale
LTScale
1
)
)
(cons 62
(if Color
Color
256
)
)
(cons 10 PT1)
(cons 11 PT2)
(cons -3
(if xdata
(list xdata)
nil
)
)
)
)
)
;;;;;; XET DIEM BEN TRAI HAY PHAI DOAN THANG;;;;;;;;;;;;;;;;;;;
(defun CCW (P1 P2 P / CCW1 D DX DX0 DY DY0)
(setq dX (- (car P) (car P1))
dY (- (cadr P) (cadr P1))
dX0 (- (car P2) (car P1))
dY0 (- (cadr P2) (cadr P1))
d (- (* dX dY0) (* dY dX0))
)
(if (>= d 0)
(setq CCW1 1)
(setq CCW1 -1)
)
CCW1
)
<<
| ||
Tác giả: Tue_NV Bài viết gốc: 69792 Tên lệnh: ssb |
Hỏi lisp về Region
| ||
Tác giả: anhduccec Bài viết gốc: 319835 Tên lệnh: dd |
Giao diện hộp thoại trong AutoLisp
| ||
Tác giả: ancontau Bài viết gốc: 402883 Tên lệnh: ll lgt lc ln lh l%2F lmh |
Lisp các phép tính đại số tự động cập nhật khi giá trị nguồn thay đổi
| ||
Tác giả: quan_elec Bài viết gốc: 95776 Tên lệnh: draw name |
viết lisp thống kê bản vẽ
| ||
Tác giả: Tue_NV Bài viết gốc: 111976 Tên lệnh: tdd |
Viết lisp theo yêu cầu [phần 2]
| ||
Tác giả: vcdichoi Bài viết gốc: 448530 Tên lệnh: lh |
Xin được nhờ sửa giúp lỗi Lisp Cad để hợp hình lại
Em có sưu tầm được một Lisp cad dùng để hợp các hình lại với nhau: Sử dụng như Video:
Nhưng khi em load lisp vào và sử dụng thì thấy báo lỗi, Em có tham khảo thì thấy bảo là do trùng biến gì đó trong... >> Em có sưu tầm được một Lisp cad dùng để hợp các hình lại với nhau: Sử dụng như Video: Nhưng khi em load lisp vào và sử dụng thì thấy báo lỗi, Em có tham khảo thì thấy bảo là do trùng biến gì đó trong quá trình lập trình, và biến đó được ghi vào bộ nhớ Ram (em cũng không hiểu cho lắm, hỳ). Báo lỗi như hình dưới
Nhờ các anh/chị giúp em chỉnh sửa để Lisp có thể sử dụng được ;;-----------------------=={ Outline Objects }==-----------------------;; ;; ;; ;; This program enables the user to generate one or more closed ;; ;; polylines or regions outlining all objects in a selection. ;; ;; ;; ;; Following a valid selection, the program calculates the overall ;; ;; rectangular extents of all selected objects and constructs a ;; ;; temporary rectangular polyline offset outside of such extents. ;; ;; ;; ;; Using a point located within the offset margin between the extents ;; ;; of the selection and temporary rectangular frame, the program then ;; ;; leverages the standard AutoCAD BOUNDARY command to construct ;; ;; polylines and/or regions surrounding all 'islands' within the ;; ;; temporary bounding frame. ;; ;; ;; ;;----------------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2014 - www.lee-mac.com ;; ;;----------------------------------------------------------------------;; ;; Version 1.0 - 2014-11-30 ;; ;; ;; ;; - First release. ;; ;;----------------------------------------------------------------------;; ;; Version 1.1 - 2016-01-23 ;; ;; ;; ;; - Added option to erase original objects. ;; ;;----------------------------------------------------------------------;; (defun c:LH ( / *error* idx sel ) (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg)) ) (princ) ) (if (setq sel (ssget)) (progn (LM:startundo (LM:acdoc)) (LM:outline sel) (initget "Yes No") (if (/= "No" (getkword "\nErase original objects? <Yes>: ")) (repeat (setq idx (sslength sel)) (entdel (ssname sel (setq idx (1- idx)))) ) ) (LM:endundo (LM:acdoc)) ) ) (princ) ) ;; Outline Objects - Lee Mac ;; Attempts to generate a polyline outlining the selected objects. ;; sel - Selection Set to outline ;; Returns: A selection set of all objects created (defun LM:outline ( sel / app are box cmd dis enl ent lst obj rtn tmp ) (if (setq box (LM:ssboundingbox sel)) (progn (setq app (vlax-get-acad-object) dis (/ (apply 'distance box) 20.0) lst (mapcar '(lambda ( a o ) (mapcar o a (list dis dis))) box '(- +)) are (apply '* (apply 'mapcar (cons '- (reverse lst)))) dis (* dis 1.5) ent (entmakex (append '( (000 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (090 . 4) (070 . 1) ) (mapcar '(lambda ( x ) (cons 10 (mapcar '(lambda ( y ) ((eval y) lst)) x))) '( (caar cadar) (caadr cadar) (caadr cadadr) (caar cadadr) ) ) ) ) ) (apply 'vlax-invoke (vl-list* app 'zoomwindow (mapcar '(lambda ( a o ) (mapcar o a (list dis dis 0.0))) box '(- +)) ) ) (setq cmd (getvar 'cmdecho) enl (entlast) rtn (ssadd) ) (while (setq tmp (entnext enl)) (setq enl tmp)) (setvar 'cmdecho 0) (command "_.-boundary" "_a" "_b" "_n" sel ent "" "_i" "_y" "_o" "_p" "" "_non" (trans (mapcar '- (car box) (list (/ dis 3.0) (/ dis 3.0))) 0 1) "" ) (while (< 0 (getvar 'cmdactive)) (command "")) (entdel ent) (while (setq enl (entnext enl)) (if (and (vlax-property-available-p (setq obj (vlax-ename->vla-object enl)) 'area) (equal (vla-get-area obj) are 1e-4) ) (entdel enl) (ssadd enl rtn) ) ) (vla-zoomprevious app) (setvar 'cmdecho cmd) rtn ) ) ) ;; Selection Set Bounding Box - Lee Mac ;; Returns a list of the lower-left and upper-right WCS coordinates of a ;; rectangular frame bounding all objects in a supplied selection set. ;; s - Selection set for which to return bounding box (defun LM:ssboundingbox ( s / a b i m n o ) (repeat (setq i (sslength s)) (if (and (setq o (vlax-ename->vla-object (ssname s (setq i (1- i))))) (vlax-method-applicable-p o 'getboundingbox) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b)))) ) (setq m (cons (vlax-safearray->list a) m) n (cons (vlax-safearray->list b) n) ) ) ) (if (and m n) (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n)) ) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) (vl-load-com) (princ) ;;----------------------------------------------------------------------;; ;; End of File ;; ;;----------------------------------------------------------------------;;
<<
| ||
Tác giả: minhphuong_humg Bài viết gốc: 185959 Tên lệnh: vec |
Làm sao để thay thế (đối tượng bằng wipeout) ?
| ||
Tác giả: tinhyeu_forever2 Bài viết gốc: 432479 Tên lệnh: block scale uniformly toggle |
Copy xong paste block ra được đối tượng có thuộc tính Scale uniformly
Mình vừa tìm được trang web nói về vấn đề này rồi này :) http://forums.augi.com/showthread.php?134247-2012-Scale-Uniformly Có lisp để "bật - tắt" chế độ Scale Uniformly nữa. Các cao thủ xem thử xem có gì hot không :D >> Mình vừa tìm được trang web nói về vấn đề này rồi này :) http://forums.augi.com/showthread.php?134247-2012-Scale-Uniformly Có lisp để "bật - tắt" chế độ Scale Uniformly nữa. Các cao thủ xem thử xem có gì hot không :D
(Defun C:Block_Scale_Uniformly_Toggle (/ MS)
(vl-load-com)
(setq MS (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(if (= (vla-get-blockscaling ms) acuniform)
(vla-put-blockscaling ms acAny)
(vla-put-blockscaling ms acUniform)
);if
(princ (strcat "\nWhen this drawing is inserted as a block it will Scale: " (if (= (vla-get-blockscaling ms) acuniform) "UNIFORMLY" "UN-UNIFORMLY")))
(princ)
);defun
<<
| ||
Tác giả: thanhduan2407 Bài viết gốc: 121501 Tên lệnh: invis vis |
Lisp hide & show object
| ||
Tác giả: hoavien248 Bài viết gốc: 186703 Tên lệnh: test |
Lisp dim các block không thẳng hàng!
| ||
Tác giả: hoavien248 Bài viết gốc: 186702 Tên lệnh: ha |
Lisp dim các block không thẳng hàng!
| ||
Tác giả: hugo007 Bài viết gốc: 162331 Tên lệnh: moc |
Lisp vẽ đai móc
| ||
Tác giả: ngokiet Bài viết gốc: 448302 Tên lệnh: test |
Nhờ viết lisp
(defun c:test ( / point et)
(setq point (getpoint "\nPick diem trong vung kin"))
(while point
(if (setq et (bpoly point))
(progn
(entmake
(append
'((000 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (090 . 4) (070 . 1))
(mapcar '(lambda ( p ) (cons 10 p)) (LM:boundingbox (vlax-ename->vla-object et)))))
(entdel et)))
(setq point...
(defun c:test ( / point et)
(setq point (getpoint "\nPick diem trong vung kin"))
(while point
(if (setq et (bpoly point))
(progn
(entmake
(append
'((000 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (090 . 4) (070 . 1))
(mapcar '(lambda ( p ) (cons 10 p)) (LM:boundingbox (vlax-ename->vla-object et)))))
(entdel et)))
(setq point (getpoint "\n Chon diem tiep theo: ")))
(princ))
(vl-load-com)
;; Bounding Box - Lee Mac
; Returns the point list describing the rectangular frame bounding the supplied object.
; obj - VLA-Object
(defun LM:boundingbox ( obj / a b lst )
(if
(and
(vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
(setq lst (mapcar 'vlax-safearray->list (list a b)))
)
(mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
'(
(caar cadar)
(caadr cadar)
(caadr cadadr)
(caar cadadr)
)
)
)
)
(princ)
Mình nghĩ nên làm thế này dễ hơn là sài Entlast và command vì lisp có lệnh bpoly. Còn lệnh command boundary thì đôi khi nó có nhiều hơn 1 vùng kín phía trong nên có thể tạo ra nhiều hơn 1 pl. Và lệnh bpoly nó trả về được pl nó tạo ra luôn. Đồng thời thông báo nếu ko kín luôn.
<<
| ||
Tác giả: ngokiet Bài viết gốc: 448638 Tên lệnh: dl |
Sửa lại lệnh DIM cho tiện dụng hơn
Nếu bạn sài cad đời cao thì bạn gán biến dimlayer là dim thì dim nó sẽ tạo ở layer dim. còn bạn muốn viết lisp thì phải kết thúc lệnh command thì mới setvar clayer lại được. ví dụ:
(defun c:dl(/ ll)
(setq ll (getvar 'clayer))
(setvar 'clayer "dim")
(command "_dimlinear")
(while (/= (getvar 'cmdactive) 0) (command pause))
... Nếu bạn sài cad đời cao thì bạn gán biến dimlayer là dim thì dim nó sẽ tạo ở layer dim. còn bạn muốn viết lisp thì phải kết thúc lệnh command thì mới setvar clayer lại được. ví dụ:
(defun c:dl(/ ll)
(setq ll (getvar 'clayer))
(setvar 'clayer "dim")
(command "_dimlinear")
(while (/= (getvar 'cmdactive) 0) (command pause))
(setvar 'clayer ll))
<<
| ||
Tác giả: newness Bài viết gốc: 55108 Tên lệnh: w1 w2 |
Ứng dụng LISP để vẽ bản vẽ kiến trúc (phần cơ bản)
| ||
Tác giả: a12k39duchao Bài viết gốc: 415056 Tên lệnh: qb |
Sửa Lisp
Hiện nay em đang sử dụng Autocad 2018. ;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=1160 (defun c:QB (/ blk_id blk_len blk_name blks cur_var ent h header_lsp height i ins j len0 lst_blk msp pt row ss str tblobj width width1 width2 x y) ;; By : Gia Bach, gia_bach @ www.CadViet.com ;; (defun TxtWidth (val h... Hiện nay em đang sử dụng Autocad 2018. ;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=1160 (defun c:QB (/ blk_id blk_len blk_name blks cur_var ent h header_lsp height i ins j len0 lst_blk msp pt row ss str tblobj width width1 width2 x y) ;; By : Gia Bach, gia_bach @ www.CadViet.com ;; (defun TxtWidth (val h msp / txt minp maxp) (setq txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h)) (vla-getBoundingBox txt 'minp 'maxp ) (vla-Erase txt) (-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp))) ) (defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty) (setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE") ) (foreach itm (vlax-for itm objTblStyDic (setq tabLst (append tabLst (list itm)))) (if (not (vl-catch-all-error-p (setq name (vl-catch-all-apply 'vla-get-Name (list itm))))) (setq nameLst (append nameLst (list name))) ) ) (if (not (vl-position tbl_name nameLst)) (vla-addobject objTblStyDic tbl_name "AcDbTableStyle")) (setq objTblSty (vla-item objTblStyDic tbl_name) TxtSty (variant-value (vla-getvariable *adoc "TextStyle"))) (mapcar '(lambda (x)(vla-settextstyle objTblSty x TxtSty)) (list acTitleRow acHeaderRow acDataRow) ) (vla-setvariable *adoc "CTableStyle" tbl_name) ) (defun GetObjectID (obj) (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE")) (vlax-invoke-method (setq Utility (cond (Utility) ((vla-get-Utility *adoc)))) 'GetObjectIdString obj :vlax-false ) (vla-get-Objectid obj))) ;main (if (setq ss (ssget (list (cons 0 "INSERT")))) (progn (vl-load-com) (setq i -1 len0 8) (while (setq ent (ssname ss (setq i (1+ i)))) (setq blk_name (vla-get-name (vlax-Ename->Vla-Object ent))) (if (> (setq blk_len (strlen blk_name)) len0) (setq str blk_name len0 blk_len) ) (if (not (assoc blk_name lst_blk)) (setq lst_blk (cons (cons blk_name 1) lst_blk)) (setq lst_blk (subst (cons blk_name (1+ (cdr (assoc blk_name lst_blk)))) (assoc blk_name lst_blk) lst_blk))) ) (setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (car x) (car y)) ) )) (setq cur_var (mapcar 'getvar '("DYNMODE" "DYNPROMPT"))) (mapcar 'setvar '("DYNMODE" "DYNPROMPT") '(1 1)) (initget "Yes No") (setq ins (getkword "\nChen ki hieu Block <yes> : ") ) (or ins (setq ins "Yes")) (mapcar 'setvar '("DYNMODE" "DYNPROMPT") cur_var) (or *h* (setq *h* (* (getvar "dimtxt")(getvar "dimscale")))) (initget 6) (setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :"))) (if h (setq *h* h) (setq h *h*) ) (setq *adoc (vla-get-ActiveDocument (vlax-get-acad-object)) msp (vla-get-modelspace *adoc) blks (vla-get-blocks *adoc)) (setq width1 (* 2 (TxtWidth "STT" h msp)) width (* 2 (TxtWidth "So luong" h msp)) height (* 2 h)) (if str (setq width2 (* 1.5 (TxtWidth (strcase str) h msp))) (setq width2 width)) (if (> h 3) (setq width (* (fix (/ width 10))10) width1 (* (fix (/ width1 10))10) width2 (* (fix (/ width2 10))10) height (* (fix (/ height 5))5))) (GetOrCreateTableStyle "CadViet") (setq pt (getpoint "\nDiem dat Bang :") TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width)) (vla-put-regeneratetablesuppressed TblObj :vlax-true) (vla-SetColumnWidth TblObj 0 width1) (vla-SetColumnWidth TblObj 1 width2) (vla-put-vertcellmargin TblObj (* 0.75 h)) (vla-put-horzcellmargin TblObj (* 0.75 h)) (mapcar '(lambda (x)(vla-setTextHeight TblObj x h)) (list acTitleRow acHeaderRow acDataRow) ) (mapcar '(lambda (x)(vla-setAlignment TblObj x 2)) (list acTitleRow acHeaderRow acDataRow)) (vl-catch-all-error-p (vl-catch-all-apply (function(lambda () (vla-MergeCells TblObj 0 0 0 3)) ))) (vla-setText TblObj 0 0 "Bang thong ke") (setq j -1 header_lsp (list "STT" "Ten" "Don vi" "So luong" "Ky hieu")) (repeat (length header_lsp) (vla-setText TblObj 1 (setq j (1+ j)) (nth j header_lsp))) (setq row 2 i 1) (foreach pt lst_blk (setq blk_name (car pt) j -1) (mapcar '(lambda (x)(vla-setText TblObj row (setq j (1+ j)) x)) (list i blk_name "cai" (cdr pt))) (if (= ins "Yes") (vla-SetBlockTableRecordId TblObj row 4 (GetObjectID (vla-item blks blk_name)) :vlax-true)) (vla-SetCellAlignment TblObj row 1 7) (vla-SetCellAlignment TblObj row 3 9) (setq row (1+ row) i (1+ i)) ) (vla-put-regeneratetablesuppressed TblObj :vlax-false) (vlax-release-object TblObj) ) ) (princ)) </yes> thì báo lỗi Select objects: ; error: no function definition: VLAX-ENAME->VLA-OBJECT một số lisp em được nhờ viết dùm thì báo lỗi error: no function definition: vlax-curve-getEndParam Nhờ mọi người sửa chữa dùm. <<
| ||
Tác giả: phamthanhbinh Bài viết gốc: 235054 Tên lệnh: sn%2B sn- |
How to use Visual LISP Editor
| ||
Tác giả: nguyencanh160890 Bài viết gốc: 224082 Tên lệnh: ha1 |
XIN HỎI VỀ LỆNH FILLET
|
Trang 313/330