Chuyển đến nội dung
Diễn đàn CADViet

LoveLisp

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    191

  • Đã tham gia

  • Lần ghé thăm cuối

Bài đăng được đăng bởi LoveLisp

  2. Đã đăng · Trả lời báo cáo

    Theo mình, yêu cầu này gần với lệnh SSX của AutoCAD (hình như có từ Cad2004). Tuy nhiên lệnh SSX tìm trong toàn bản vẽ và chỉ trả về tập chọn cuối cùng (mà không làm gì cả).

    Mình đã cải tiến nó lại, cho phép khoanh vùng chọn trên màn hình và grip kết quả chọn được.

     

;;
;;;
;;;	SSX.LSP
;;;	Copyright © 1999 by Autodesk, Inc.
;;;
;;;	Your use of this software is governed by the terms and conditions of the
;;;	License Agreement you accepted prior to installation of this software.
;;;	Please note that pursuant to the License Agreement for this software,
;;;	"[c]opying of this computer program or its documentation except as
;;;	permitted by this License is copyright infringement under the laws of
;;;	your country.  If you copy this computer program without permission of
;;;	Autodesk, you are violating the law."
;;;
;;;	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.
;;;
;;;  ----------------------------------------------------------------

;;; DESCRIPTION
;;;                          	SSX.LSP
;;;
;;;   "(SSX)" -  Easy SSGET filter routine.
;;;
;;;   Creates a selection set.  Either type "SSX" at the "Command:" prompt
;;;   to create a "previous" selection set or type "(SSX)" in response to
;;;   any "Select objects:" prompt.  You may use the functions "(A)" to add
;;;   entities and "(R)" to remove entities from a selection set during
;;;   object selection.  More than one filter criteria can be used at a
;;;   time.
;;;
;;;   SSX returns a selection set either exactly like a selected
;;;   entity or, by adjusting the filter list, similar to it.
;;;
;;;   The initial prompt is this:
;;;
;;; 	Command: ssx
;;; 	Select object/<None>: (RETURN)
;;; 	>>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;;   Pressing RETURN at the initial prompt gives you a null selection
;;;   mechanism just as (ssx) did in Release 10, but you may select an
;;;   entity if you desire.  If you do so, then the list of valid types
;;;   allowed by (ssget "x") are presented on the command line.
;;;
;;; 	Select object/<None>:  (a LINE selected)
;;; 	Filter: ((0 . "LINE") (8 . "0") (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
;;; 	>>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;;   At this point any of these filters may be removed by selecting the
;;;   option keyword, then pressing RETURN.
;;;
;;; 	>>Layer name to add/<RETURN to remove>: (RETURN)
;;;
;;; 	Filter: ((0 . "LINE") (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
;;; 	>>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;;   If an item exists in the filter list and you elect to add a new item,
;;;   the old value is overwritten by the new value, as you can have only
;;;   one of each type in a single (ssget "x") call.
;;;
;;;--------------------------------------------------------------------------;
;;;
;;; Find the dotted pairs that are valid filters for ssget
;;; in entity named "ent".
;;;
;;; ssx_fe == SSX_Find_Entity
;;;

(defun ssx_fe (/ data fltr ent)
 (setq ent (car (entsel "\nSelect object <None>: ")))
 (if ent
(progn
 	(setq data (entget ent))
 	(foreach x '(0 2 6 7 8 39 62 66 210) ; do not include 38
   	(if (assoc x data)
     	(setq fltr
       	(cons (assoc x data) fltr)
     	)
   	)
 	)
 	(reverse fltr)
)
 )
)
;;;
;;; Remove "element" from "alist".
;;;
;;; ssx_re == SSX_Remove_Element
;;;
(defun ssx_re (element alist)
 (append
(reverse (cdr (member element (reverse alist))))
(cdr (member element alist))
 )
)
;;;
;;; INTERNAL ERROR HANDLER
;;;
(defun ssx_er (s)                 	; If an error (such as CTRL-C) occurs
                                 	; while this command is active...
 (if (/= s "Function cancelled")
(princ (acet-str-format "\nError: %1" s))
 )
 (if olderr (setq *error* olderr))   ; Restore old *error* handler
 (princ)
)
;;;
;;; Get the filtered sel-set.
;;;
;;;
(defun ssx (/ olderr fltr)
 (gc)                            	; close any sel-sets
 (setq olderr *error*
   	*error* ssx_er
 )
 (setq fltr (ssx_fe))
 (ssx_gf fltr)
)
;;;
;;; Build the filter list up by picking, selecting an item to add,
;;; or remove an item from the list by selecting it and pressing RETURN.
;;;
;;; ssx_gf == SSX_Get_Filters
;;;
(defun ssx_gf (f1 / t1 t2 t3 f2)
 (while
(progn
 	(cond (f1 (prompt "\nCurrent filter: ") (prin1 f1)))     
 	(initget
   	"Block Color Entity Flag LAyer LType Pick Style Thickness Vector")
 	(setq t1 (getkword
   	"\nEnter filter option [block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector]: "))
)
(setq t2
 	(cond
   	((eq t1 "Block")  	2)   ((eq t1 "Color") 	62)
   	((eq t1 "Entity") 	0)   ((eq t1 "LAyer")  	8)
   	((eq t1 "LType")  	6)   ((eq t1 "Style")  	7)
   	((eq t1 "Thickness") 39)   ((eq t1 "Flag" ) 	66)
   	((eq t1 "Vector")   210)
   	(T t1)
 	)
)
(setq t3
 	(cond
   	((= t2  2)  (getstring "\n>>Enter block name to add <RETURN to remove>: "))
   	((= t2 62)  (initget 4 "?")
     	(cond
       	((or (eq (setq t3 (getint
         	"\n>>Enter color number to add [?] <RETURN to remove>: ")) "?")
         	(> t3 256))
         	(ssx_pc)            	; Print color values.
         	nil
       	)
       	(T
         	t3                  	; Return t3.
       	)
     	)
   	)
   	((= t2  0) (getstring "\n>>Enter entity type to add <RETURN to remove>: "))
   	((= t2  8) (getstring "\n>>Enter layer name to add <RETURN to remove>: "))
   	((= t2  6) (getstring "\n>>Enter linetype name to add <RETURN to remove>: "))
   	((= t2  7)
     	(getstring "\n>>Enter text style name to add <RETURN to remove>: ")
   	)
   	((= t2 39)  (getreal   "\n>>Enter thickness to add <RETURN to remove>: "))
   	((= t2 66)  (if (assoc 66 f1) nil 1))
   	((= t2 210)
     	(getpoint  "\n>>Specify extrusion Vector to add <RETURN to remove>: ")
   	)
   	(T      	nil)
 	)
)
(cond
 	((= t2 "Pick") (setq f1 (ssx_fe) t2 nil)) ; get entity
 	((and f1 (assoc t2 f1))     	; already in the list
   	(if (and t3 (/= t3 ""))
     	;; Replace with a new value...
     	(setq f1 (subst (cons t2 t3) (assoc t2 f1) f1))
     	;; Remove it from filter list...
     	(setq f1 (ssx_re (assoc t2 f1) f1))
   	)
 	)
 	((and t3 (/= t3 ""))
   	(setq f1 (cons (cons t2 t3) f1))
 	)
 	(T nil)
)
 )
 (princ "\nKhoanh vung chon <enter=all>: ")
 (setq chon (ssget))
 (if chon (if f1 (setq f2 (ssget "_p" f1)))
(if f1 (setq f2 (ssget "_x" f1))))
 (setq *error* olderr)
 (if (and f1 f2)
(progn
 	(princ (acet-str-format "\n%1 found. "  (itoa (sslength f2))))
 	f2
)
(progn (princ "\n0 found.") (prin1))
 )
)
;;;
;;; Print the standard color assignments.
;;;
;;;
(defun ssx_pc ()
 (if textpage (textpage) (textscr))
 (princ "\n                                                 	")
 (princ "\n             	Color number   |   Standard meaning ")
 (princ "\n            	________________|____________________")
 (princ "\n                            	|                	")
 (princ "\n                   	0    	|  	<BYBLOCK> 	")
 (princ "\n                   	1    	|  	Red       	")
 (princ "\n                   	2    	|  	Yellow    	")
 (princ "\n                   	3    	|  	Green     	")
 (princ "\n                   	4    	|  	Cyan      	")
 (princ "\n                   	5    	|  	Blue      	")
 (princ "\n                   	6    	|  	Magenta   	")
 (princ "\n                   	7    	|  	White     	")
 (princ "\n                	8...255 	|  	-Varies-  	")
 (princ "\n                  	256   	|  	<BYLAYER> 	")
 (princ "\n                                           	\n\n\n")
)
;;;
;;; C: function definition.
;;;
(defun c:ssx ()
(ssx)
(princ)
)
;(princ "\n\tType \"ssx\" at a Command: prompt or ")
;(princ "\n\t(ssx) at any object selection prompt. ")

(princ)


;chän ®èi t­îng b»ng lÖnh (ssx) cña Express
(defun c:ssx(/ chon)
 (if (/= (ssx)(princ))
(progn
 	(setq chon (ssget "p"))
 	(if (> (sslength chon) 0)
(progn
  (sssetfirst chon chon)
  (princ "\nChon duoc ")(princ (sslength chon))(princ " doi tuong.")
  (setq chon (gc))))))
 (princ))

    • Vote tăng 1

  4. Đã đăng · Trả lời báo cáo

    Mình làm rồi nhưng sao text tạo ra không link với tên layer, nghĩa là khi đổi tên layer xong, regen thì nó không đổi theo!

    Nhờ bác xem giúp mình với!

    (defun c:fla()

    (if (setq ent (entsel "\nChon doi tuong de xac dinh layer: "))

    (progn

    (setq txt (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid (vlax-ename->vla-object (car ent)))) ">%).Layer>%")

    txt (strcat "%<$(substr, " txt ", 5) >%"))

    (vla-addmtext (vla-get-block (vla-get-activelayout(vla-get-activedocument (vlax-get-acad-object))))

    (vlax-3d-point (getpoint "\nDiem chen Field"))

    1

    txt)

    )

    )

    (princ)

    )

    p/s: Mình không thể đặt trong cặp dấu CODE được, nó không hiển thị như mình mong muốn!

  5. Đã đăng · Trả lời báo cáo

    Get và Put thì như vầy, còn Cut bằng Diesel thì cũng có thể làm được, nhưng đưa từ Diesel vào Field thì mình cũng chưa hiểu lắm.

    Get và Put:

    (setq txt (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid (vlax-ename->vla-object ent))) ">%).Layer>%"))

    (vla-put-textstring (vlax-ename->vla-object ent_text) txt)))))

    Vì field chấp nhận diesel mà bác!

  6. Đã đăng · Trả lời báo cáo

    Bạn tự sử dụng Field Layer để phát hiện ra công thức, sau đó tìm hàm GetObjectID64 trên diễn đàn, strcat cái công thức + ObjectID ghi đè lên text, thế là có cái bạn cần, bạn thử làm xem sao :) Mình đoán mất mấy phút thôi ^^

    Tìm mãi mà chẳng thấy hàm "GetObjectID64" ở đâu trên diễn đàn bạn ạ!!

  8. Đã đăng · Trả lời báo cáo

    <p style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; margin: 0px; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;">Mô tả hiện tượng như sau:</p>

    <p style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; margin: 0px; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;">Khi mở bản vẽ thì xác nhận load macro:</p>

    <p style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; margin: 0px; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;">- Nếu không đồng ý: Mở bản vẽ lên không thấy gì, dù vẫn có 2367 đối tượng (gồm nhiều loại) trong Model.</p>

    <p style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; margin: 0px; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;">- Nếu đồng ý:</p>

    <p style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; margin: 0px; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;"><span style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; float: none; display: inline !important; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; background-color: rgb(255, 255, 255); -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;"> + Vô hiệu tất cả các lệnh Draw và Modify (zoom, pan và plot vẫn dùng bthường).</span></p>

    <p style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; margin: 0px; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;"><span style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; float: none; display: inline !important; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; background-color: rgb(255, 255, 255); -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;"><span style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; float: none; display: inline !important; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; background-color: rgb(255, 255, 255); -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;"> + </span></span>Tự động hủy khi người dùng chọn bất kỳ đối tượng nào.</p>

    <p style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; margin: 0px; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;"><span style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; float: none; display: inline !important; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; background-color: rgb(255, 255, 255); -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;"><span style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; float: none; display: inline !important; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; background-color: rgb(255, 255, 255); -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;"> + </span></span>Không cho phép thực thi lệnh "Flatten"</p>

    <p style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; margin: 0px; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;"> + Nếu lưu thành file DXF thì chỉ được nội dung thế này:<span style="display: none;"> <span></span></span></p>

    <p style="font: 14px/normal "Helvetica Neue", Arial, Verdana, sans-serif; margin: 0px; color: rgb(34, 34, 34); text-transform: none; text-indent: 0px; letter-spacing: normal; word-spacing: 0px; white-space: normal; orphans: 2; widows: 2; font-size-adjust: none; font-stretch: normal; -webkit-text-size-adjust: auto; -webkit-text-stroke-width: 0px;"> 0<br />

    SECTION<br />

    2<br />

    HEADER<br />

    .. nghiên cứu tiếp..., vụ này hay thật!!!</p>

     

    • Vote tăng 1

  9. Đã đăng · Trả lời báo cáo

    CAD 3D đòi hỏi bạn phải có các kiến thức nhất định về CAD và hình học không gian. Hướng dẫn ở trên đã khá đầy đủ từng bước, nếu bạn vẫn chưa hiểu được thì đừng nên vội vàng học CAD 3D bạn ạ, chỗ nào chưa hiểu, bạn xem như đó là một chương mới và bạn bắt tay tìm hiểu nó. Theo thứ tự từ trên xuống dưới, chắc chắn bạn sẽ nắm thêm được nhiều điều mới. Chúc bạn thành công!

  10. Đã đăng · Trả lời báo cáo

    Bạn tự sử dụng Field Layer để phát hiện ra công thức, sau đó tìm hàm GetObjectID64 trên diễn đàn, strcat cái công thức + ObjectID ghi đè lên text, thế là có cái bạn cần, bạn thử làm xem sao :) Mình đoán mất mấy phút thôi ^^

    Lấy được rồi nhưng không biết làm sao cắt bớt đi vài ký tự bạn ạ!

  11. Đã đăng · Trả lời báo cáo

    Mình cũng đang làm theo cách này, nhưng chỉ biết lấy "y nguyên" thôi, còn xử lý nó (như cắt bớt vài ký tự) thì mình chịu thua!!

    P/S: Cái này không phải là VBA hả bạn? Mình thấy nó nằm trong mục "ActiveX and VBA Reference" của help, vậy chắc nó là ActiveX nhỉ?? :) Cái này mình cũng chịu, chưa nghiên cứu!

  12. Đã đăng · Trả lời báo cáo 

    (defun C:HA( / num ent1 ent2 lay)
(initget 7) (setq num (getint "\nSo ky tu can cat bot: "))
(while
 (and
  (setq ent1 (car (entsel "\nChon 1 doi tuong de lay Layer: ")))
  (setq ent2 (car (entsel "\nChon 1 Text de ghi len no: "))))
 (if (> (strlen (setq lay (cdr (assoc 8 (entget ent1))))) num)
  (vla-put-textstring (vlax-ename->vla-object ent2) (substr lay (1+ num))))))

     

    Cám ơn bác Hạ! Mình muốn text này liên kết động với tên layer được không bác? Nghĩa là lúc mình đổi tên layer thì nó cũng thay đổi theo ấy!

  16. Đã đăng · Trả lời báo cáo

    Những thắc mắc của bạn là các yêu cầu sơ đẳng mà một kỹ sư thiết kế đường phải nắm bắt được. Không biết bạn đang là sinh viên hay đã tốt nghiệp rồi, tuy nhiên, bạn có thể tìm thấy câu trả lời ở các giáo trình thiết kế đường đô thị.

    Mình xin nêu vài bước cơ bản như sau:

    - Xác định cấp hạng của đường: Cấp đường, tốc độ thiết kế.

    - Xác định vị trí các công trình thoát nước, các vị trí giao cắt, các điểm khống chế, các điểm tối thiểu.

    - Xác định tần suất thiết kế, từ đó tính toán các cao độ tối thiểu và thiết kế các khẩu độ cầu cống.

    - Xác định các yếu tố hình học chủ yếu: Mặt cắt ngang (bề rộng nền mặt đường, vỉa hè, dải phân cách, tĩnh không), mặt cắt dọc (độ dốc dọc lớn nhất, bán kính đường cong đứng lồi, lõm), bình đồ (bán kính đường cong nằm, đoạn nối siêu cao, tầm nhìn..)

    - Xác định các xử lý đặc biệt: nền đất yếu, đào đá, ....

    - Còn nhiều nữa....

     

    Trên đây là vài định hướng, bạn phải bám sát quy trình thiết kế để vận dụng cho phù hợp. Hiện nay đối với đường đô thị đang sử dụng TCXDVN 104-2007. Tuy nhiên bạn cần tham chiếu thêm các quy trình: 4054-2004; 211-2006 (và các tiêu chuẩn khác nữa)

    • Vote tăng 1

  20. Đã đăng · Trả lời báo cáo

    DXF của block, trong trường hợp thông thường, tên block nằm ở code 2.

    Tuy nhiên, đối với Dynamid Block, code 2 chỉ là bắt đầu bằng ký tự * và nó không phải là tên thật của block đó.

    Nếu gọi lệnh List, ta sẽ thấy 2 dòng:

    Block Name: "CrossStructure-CulvertBoxPlan"

    Anonymous Name: "*U431"

    Vậy đối với Dynamid Block, làm sau để truy xuất Block Name bằng AutoLisp?

    Và liệu có thể chọn được tất cả các Dynamid Block xuất phát từ cùng một Block gốc hay không?

  22. Đã đăng · Trả lời báo cáo

    Lệnh SplineEdit, tùy chọn convert to Polyline yêu cầu nhập precision (nghĩa là độ chính xác) mà không phải là khoảng chia. Mọi người có ai hiểu 'độ chính xác' này là gì không? Mình đã kiểm tra, sau khi convert xong thì Polyline có độ dài các phân đoạn không bằng nhau, góc giữa các phân đoạn cũng khác nhau.

     

    Các bác xem hình ở bên dưới nhé!

×