Viết Lisp theo yêu cầu

[q288 166]

Chào q288!

Dùng cái này khi mình kích điểm thì nó lại báo lối thế này: Base point: ; error: no function definition: SETQTH

Giúp mình nhé!

Thank!

 

sorry, khi viết lại mình vô tình xóa space nên bị báo lỗi như trên. Bạn chép lại ct nhé.

 

;;;------------------------------------------------------------------------------------

(defun getTw ()

;;;Get current text width factor

(cdr (assoc 41 (tblsearch "style" (getvar "textstyle"))))

)

;;;------------------------------------------------------------------------------------

(defun getTh (/ Th)

;;;Get current textheight or textsize

(if (= (setq Th (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) 0)

(getvar "textsize")

Th

)

)

;;;------------------------------------------------------------------------------------

(defun emkT (S p)

;;;Write text S at point p by entmake function

;;;Text style, heigh and width factor get from current values

(entmake (list (cons 0 "TEXT")

(cons 10 p)

(cons 40 (getTh))

(cons 41 (getTw))

(cons 1 S)

(cons 7 (getvar "textstyle"))

)

)

)

;;;------------------------------------------------------------------------------------

(defun calcL (e)

;;;Calculate length of Line, Pline, 3dPoly, Spline, Circle, Arc, Polygon

(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))

)

;;;------------------------------------------------------------------------------------

(defun C:CHD (/ Opt S1 S2 e p L)

(vl-load-com)

(command "ucs" "w")

 

(if (not preT) (setq preT "L="))

(if (not sufT) (setq sufT ""))

(setq S1 preT

S2 sufT)

(prompt (strcat "\nMeasure and write length. Current prefix:[" preT "]\tSuffix:[" sufT "]"))

 

(initget "Y N")

(setq Opt (getkword "\nChange prefix and suffix? [Yes/No] :"))

(if (not Opt) (setq Opt "N"))

(if (= Opt "Y")

(setq S1 (getstring "\nPrefix :")

preT S1

S2 (getstring "\nSuffix :")

sufT S2))

 

(setq ss (ssget)

n 0

total 0)

 

(while ss

(repeat (sslength ss)

(setq e (ssname ss n)

L (calcL e)

total (+ total L)

n (1+ n))

)

(setq p (getpoint "\nBase point: "))

(emkT S1 p)

(emkT (strcat " " (rtos total) S2) p)

(setq ss (ssget)

n 0

total 0)

)

(princ)

)

[conghoan1003 0]

Chào cả nhà!

Cho mình hỏi ai có lisp cộng (trừ) tất cả các số được chọn thêm một giá trị nào đó không? Cho mình xin với. Hiện mình đang dung lisp này, nó cũng có thể cộng được nhưng không hiểu tại sao nó lại có sai số khi sử dụng.

Thank!

(defun doiphay_cham ()

(setq st_ch "")

(setq count_st 1)

(if ( = (substr st_chang 1 1) ".")

(setq st_chang (strcat "P" st_chang ))

nil

)

(princ st_chang)

(repeat (strlen st_chang)

(Progn

(setq char_single (substr st_chang count_st 1))

(if (= char_single ",") (setq char_single ".") nil )

(setq st_ch (strcat st_ch char_single))

(setq count_st (+ count_st 1))

)

)

(setq st_chang st_ch)

)

(defun doicham_phay ()

(setq int_ch (fix (abs h_numadd)))

(setq frac_ch (fix (* ( - (abs h_numadd) (abs int_ch)) 100) ))

(princ frac_ch)

(If (< frac_ch 10)

(setq nt (strcat (itoa int_ch) ",0" (itoa frac_ch)))

(setq nt (strcat (itoa int_ch) "," (itoa frac_ch)))

)

(if ( < h_numadd 0) (setq nt (strcat "-" nt)) nil )

)

(defun chtxt (/ sset opt ssl nsset temp unctr ct_ver cht_er cht_oe

sslen style hgt rot txt ent cht_oc cht_ot cht_oh

loc loc1 justp justq orthom )

 

(setq ct_ver "1.02") ; Reset this local if you make a change.

;;

;; Internal error handler defined locally

;;

(defun cht_er (s) ; If an error (such as CTRL-C) occurs

; while this command is active...

(if (/= s "Function cancelled")

(if (= s "quit / exit abort")

(princ)

(princ (strcat "\nError: " s))

)

)

(eval(read U:E))

(if cht_oe ; If an old error routine exists

(setq *error* cht_oe) ; then, reset it

)

(if temp (redraw temp 1))

(if cht_oc (setvar "cmdecho" cht_oc)) ; Reset command echoing

(if cht_ot (setvar "texteval" cht_ot))

(if cht_oh (setvar "highlight" cht_oh))

(princ)

)

;;

;; Body of function

;;

(if *error* ; Set our new error handler

(setq cht_oe *error* *error* cht_er)

(setq *error* cht_er)

)

 

;; Set undo groups and ends with (eval(read U:G)) or (eval(read U:E))

(setq U:G "(command \"undo\" \"group\")"

U:E "(command \"undo\" \"en\")"

)

 

(setq cht_oc (getvar "cmdecho"))

(setq cht_oh (getvar "highlight"))

(setvar "cmdecho" 0)

 

(eval(read U:G))

 

(princ (strcat "\nChange text, Version " ct_ver

", © 1990-1991 by Autodesk, Inc. "))

(prompt "\nSelect text to change. ")

(setq sset (ssget))

(if (null sset)

(progn

(princ "\nERROR: Nothing selected.")

(exit)

)

)

;; Verify the entity set.

(cht_ve)

;; This is the main option loop.

(cht_ol)

 

(if cht_oe (setq *error* cht_oe)) ; Reset old error function if error

(eval(read U:E))

(if cht_ot (setvar "texteval" cht_ot))

(if cht_oh (setvar "highlight" cht_oh))

(if cht_oc (setvar "cmdecho" cht_oc)) ; Reset command echoing

(princ)

)

;;;

;;; Verify and sort out non-text entities from the selection set.

;;;

(defun cht_ve ()

(setq ssl (sslength sset)

nsset (ssadd))

(if (> ssl 25)

(princ "\nVerifying the selected entities -- please wait. ")

)

(while (> ssl 0)

(setq temp (ssname sset (setq ssl (1- ssl))))

(if (= (cdr(assoc 0 (entget temp))) "TEXT")

(ssadd temp nsset)

)

)

(setq ssl (sslength nsset)

sset nsset

unctr 0

)

(print ssl)

(princ "text entities found. ")

)

;;;

;;; The option loop.

;;;

(defun cht_ol ()

(setq opt T)

(while (and opt (> ssl 0))

(setq unctr (1+ unctr))

(command "_.UNDO" "_GROUP")

; (initget "Location Justification Style Height Rotation Width Text Undo")

; (setq opt (getkword

; "\nHeight/Justification/Location/Rotation/Style/Text/Undo/Width: "))

(setq opt "Text")

(if opt

(cond

((= opt "Undo")

(cht_ue) ; Undo the previous command.

)

((= opt "Location")

(cht_le) ; Change the location.

)

((= opt "Justification")

(cht_je) ; Change the justification.

)

((= opt "Style") (cht_pe "Style" "style name" 7) )

((= opt "Height") (cht_pe "Height" "height" 40) )

((= opt "Rotation") (cht_pe "Rotation" "rotation angle" 50) )

((= opt "Width") (cht_pe "Width" "width factor" 41) )

((= opt "Text")

(cht_te) ; Change the text.

)

)

(setq opt nil)

)

(command "_.UNDO" "_END")

)

)

;;;

;;; Undo an entry.

;;;

(defun cht_ue ()

(if (> unctr 1)

(progn

(command "_.UNDO" "_END")

(command "_.UNDO" "2")

(setq unctr (- unctr 2))

)

(progn

(princ "\nNothing to undo. ")

(setq unctr (- unctr 1))

)

)

)

;;;

;;; Change the location of an entry.

;;;

(defun cht_le ()

(setq sslen (sslength sset)

style ""

hgt ""

rot ""

txt ""

)

(command "_.CHANGE" sset "" "")

(while (> sslen 0)

(setq ent (entget(ssname sset (setq sslen (1- sslen))))

opt (list (cadr (assoc 11 ent))

(caddr (assoc 11 ent))

(cadddr (assoc 11 ent)))

)

(prompt "\nNew text location: ")

(command pause)

(if (null loc)

(setq loc opt)

)

(command style hgt rot txt)

)

(command)

)

;;;

;;; Change the justification of an entry.

;;;

(defun cht_je ()

(if (getvar "DIMCLRD")

(initget (strcat "TLeft TCenter TRight "

"MLeft MCenter MRight "

"BLeft BCenter BRight "

"Aligned Center Fit Left Middle Right ?"))

(initget "Aligned Center Fit Left Middle Right ?")

)

(setq sslen (sslength sset))

(setq justp (getkword (strcat "\nJustification point(s) - "

"Aligned/Center/Fit/Left/Middle/Right/<?>: ")))

(cond

((= justp "Left") (setq justp 0 justq 0) )

((= justp "Center") (setq justp 1 justq 0) )

((= justp "Right") (setq justp 2 justq 0) )

((= justp "Aligned") (setq justp 3 justq 0) )

((= justp "Fit") (setq justp 5 justq 0) )

((= justp "TLeft") (setq justp 0 justq 3) )

((= justp "TCenter") (setq justp 1 justq 3) )

((= justp "TRight") (setq justp 2 justq 3) )

((= justp "MLeft") (setq justp 0 justq 2) )

((= justp "Middle") (setq justp 4 justq 0) )

((= justp "MCenter") (setq justp 1 justq 2) )

((= justp "MRight") (setq justp 2 justq 2) )

((= justp "BLeft") (setq justp 0 justq 1) )

((= justp "BCenter") (setq justp 1 justq 1) )

((= justp "BRight") (setq justp 2 justq 1) )

((= justp "?") (setq justp nil) )

(T (setq justp nil) )

)

(if justp

(justpt) ; Process them...

(justpn) ; List options...

)

(command)

)

;;;

;;; Get alignment points for "aligned" or "fit" text.

;;;

(defun justpt ()

(while (> sslen 0)

(setq ent (entget(ssname sset (setq sslen (1- sslen))))

ent (subst (cons 72 justp) (assoc 72 ent) ent)

opt (trans (list (cadr (assoc 11 ent))

(caddr (assoc 11 ent))

(cadddr (assoc 11 ent)))

(cdr(assoc -1 ent)) ; from ECS

1) ; to current UCS

)

(if (getvar "DIMCLRD")

(setq ent (subst (cons 73 justq) (assoc 73 ent) ent))

)

(cond

((or (= justp 3) (= justp 5))

(prompt "\nNew text alignment points: ")

(if (= (setq orthom (getvar "orthomode")) 1)

(setvar "orthomode" 0)

)

(redraw (cdr(assoc -1 ent)) 3)

(initget 1)

(setq loc (getpoint))

(initget 1)

(setq loc1 (getpoint loc))

(redraw (cdr(assoc -1 ent)) 1)

(setvar "orthomode" orthom)

(setq ent (subst (cons 10 loc) (assoc 10 ent) ent))

(setq ent (subst (cons 11 loc1) (assoc 11 ent) ent))

)

((or (/= justp 0) (/= justq 0))

(redraw (cdr(assoc -1 ent)) 3)

(prompt "\nNew text location: ")

(if (= (setq orthom (getvar "orthomode")) 1)

(setvar "orthomode" 0)

)

(setq loc (getpoint opt))

(setvar "orthomode" orthom)

(redraw (cdr(assoc -1 ent)) 1)

(if (null loc)

(setq loc opt)

(setq loc (trans loc 1 (cdr(assoc -1 ent))))

)

(setq ent (subst (cons 11 loc) (assoc 11 ent) ent))

)

)

(entmod ent)

)

)

;;;

;;; List the options.

;;;

(defun justpn ()

(if (getvar "DIMCLRD") (textpage))

(princ "\nAlignment options: ")

(princ "\n\t TLeft TCenter TRight ")

(princ "\n\t MLeft MCenter MRight ")

(princ "\n\t BLeft BCenter BRight ")

(princ "\n\t Left Center Right")

(princ "\n\tAligned Middle Fit")

(if (not (getvar "DIMCLRD")) (textscr))

(princ "\n\nPress any key to return to your drawing. ")

(grread)

(princ "\r ")

(graphscr)

)

;;;

;;; Change the text of an entity.

;;;

(defun cht_te ()

(setq sslen (sslength sset))

; (initget "Globally Individually Retype")

; (princ " thu 1 them hang so.")

; (setq ans (getkword

; "\nSearch and replace text. Individually/Retype/:"))

(setq ans "Retype")

(setq cht_ot (getvar "texteval"))

(setvar "texteval" 1)

(cond

((= ans "Individually")

(if (= (getvar "popups") 1)

(progn

(initget "Yes No")

(princ "CHUYEN DOI TEXT + them hang so.")

(setq ans (getkword "\nEdit text in dialogue? :"))

)

(setq ans "No")

)

 

(while (> sslen 0)

(redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 3)

(setq ss (ssadd))

(ssadd (ssname sset sslen) ss)

(if (= ans "No")

(chgtext ss)

(command "_.DDEDIT" sn "")

)

(redraw sn 1)

)

)

((= ans "Retype")

(setq h_add (getreal "So cong them : "))

(while (> sslen 0)

(setq ent (entget(ssname sset (setq sslen (1- sslen)))))

(redraw (cdr(assoc -1 ent)) 3)

(prompt (strcat "\nOld text: " (cdr(assoc 1 ent))))

; (setq nt (getstring T "\nNew text: ")) thay bang su ly cong them

(setq st_chang (strcat (cdr(assoc 1 ent))))

(setq st_save st_chang)

(doiphay_cham)

(setq h_num (atof st_chang))

(if (= h_num 0)

(setq nt st_save)

(progn

(setq h_numadd (+ h_num h_add))

(doicham_phay)

; (setq nt (rtos h_numadd 2 2))

)

)

(redraw (cdr(assoc -1 ent)) 1)

(if (> (strlen nt) 0)

(entmod (subst (cons 1 nt) (assoc 1 ent) ent))

)

)

)

(T

(chgtext sset) ; Change 'em all

)

)

(setq ans nil)

(setq opt nil)

(setvar "texteval" cht_ot)

)

;;;

;;; The old CHGTEXT command - rudimentary text editor

;;;

;;;

(defun C:CHGTEXT () (chgtext nil))

 

(defun chgtext (objs / last_o tot_o ent o_str n_str st s_temp

n_slen o_slen si chf chm cont ans)

(if (null objs)

(setq objs (ssget)) ; Select objects if running standalone

)

(setq chm 0)

(if objs

(progn ; If any objects selected

(if (= (type objs) 'ENAME)

(progn

(setq ent (entget objs))

(princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))

)

(if (= (sslength objs) 1)

(progn

(setq ent (entget (ssname objs 0)))

(princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))

)

)

)

(setq o_str (getstring "\nMatch string : " t))

(setq o_slen (strlen o_str))

(if (/= o_slen 0)

(progn

(setq n_str (getstring "\nNew string : " t))

(setq n_slen (strlen n_str))

(setq last_o 0

tot_o (if (= (type objs) 'ENAME)

1

(sslength objs)

)

)

(while (< last_o tot_o) ; For each selected object...

(if (= "TEXT" ; Look for TEXT entity type (group 0)

(cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))

(progn

(setq chf nil si 1)

(setq s_temp (cdr (assoc 1 ent)))

(while (= o_slen (strlen (setq st (substr s_temp si o_slen))))

(if (= st o_str)

(progn

(setq s_temp (strcat

(if (> si 1)

(substr s_temp 1 (1- si))

""

)

n_str

(substr s_temp (+ si o_slen))

)

)

(setq chf t) ; Found old string

(setq si (+ si n_slen))

)

(setq si (1+ si))

)

)

(if chf

(progn ; Substitute new string for old

; Modify the TEXT entity

(entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))

(setq chm (1+ chm))

)

)

)

)

(setq last_o (1+ last_o))

)

)

;; else go on to the next line...

)

)

)

(if (/= (type objs) 'ENAME)

(if (/= (sslength objs) 1) ; Print total lines changed

(princ (strcat "Changed "

(rtos chm 2 0)

" text lines."

)

)

)

)

(terpri)

)

;;;

;;; Main procedure for manipulating text entities

;;; ARGUMENTS:

;;; typ -- Type of operation to perform

;;; prmpt -- Partial prompt string to insert in standard prompt line

;;; fld -- Assoc field to be changed

;;; GLOBALS:

;;; sset -- The selection set of text entities

;;;

(defun cht_pe (typ prmpt fld / temp ow nw ent tw sty w hw lw

sslen n sn ssl)

(if (= (sslength sset) 1) ; Special case if there is only

; one entity selected

;; Process one entity.

(cht_p1)

;; Else

(progn

;; Set prompt string.

(cht_sp)

(if (= nw "List")

;; Process List request.

(cht_pl)

(if (= nw "Individual")

;; Process Individual request.

(cht_pi)

(if (= nw "Select")

;; Process Select request.

(cht_ps)

;; Else

(progn

(if (= typ "Rotation")

(setq nw (* (/ nw 180.0) pi))

)

(if (= (type nw) 'STR)

(if (not (tblsearch "style" nw))

(progn

(princ (strcat "\nStyle " nw " not found. "))

)

(cht_pa)

)

(cht_pa)

)

)

)

)

)

)

)

)

;;;

;;; Change all of the entities in the selection set.

;;;

(defun cht_pa (/ cht_oh temp)

(setq sslen (sslength sset))

(setq cht_oh (getvar "highlight"))

(setvar "highlight" 0)

(while (> sslen 0)

(setq temp (ssname sset (setq sslen (1- sslen))))

(entmod (subst (cons fld nw)

(assoc fld (setq ent (entget temp)))

ent

)

)

 

)

(setvar "highlight" cht_oh)

)

;;;

;;; Change one text entity.

;;;

(defun cht_p1 ()

(setq temp (ssname sset 0))

(setq ow (cdr(assoc fld (entget temp))))

(if (= opt "Rotation")

(setq ow (/ (* ow 180.0) pi))

)

(redraw (cdr(assoc -1 (entget temp))) 3)

(initget 0)

(if (= opt "Style")

(setq nw (getstring (strcat "\nNew " prmpt ". <"

ow ">: ")))

(setq nw (getreal (strcat "\nNew " prmpt ". <"

(rtos ow 2) ">: ")))

)

(if (or (= nw "") (= nw nil))

(setq nw ow)

)

(redraw (cdr(assoc -1 (entget temp))) 1)

(if (= opt "Rotation")

(setq nw (* (/ nw 180.0) pi))

)

(if (= opt "Style")

(if (null (tblsearch "style" nw))

(princ (strcat "\nStyle " nw " not found. "))

 

(entmod (subst (cons fld nw)

(assoc fld (setq ent (entget temp)))

ent

)

)

)

(entmod (subst (cons fld nw)

(assoc fld (setq ent (entget temp)))

ent

)

)

)

)

;;;

;;; Set the prompt string.

;;;

(defun cht_sp ()

(if (= typ "Style")

(progn

(initget "Individual List New Select ")

(setq nw (getkword (strcat "\nIndividual/List/Select style/

prmpt

" for all text entities>: ")))

(if (or (= nw "") (= nw nil) (= nw "Enter"))

(setq nw (getstring (strcat "\nNew "

prmpt

" for all text entities: ")))

)

)

(progn

(initget "List Individual" 1)

(setq nw (getreal (strcat "\nIndividual/List/

prmpt

" for all text entities>: ")))

)

)

)

;;;

;;; Process List request.

;;;

(defun cht_pl ()

(setq unctr (1- unctr))

(setq sslen (sslength sset))

(setq tw 0)

(while (> sslen 0)

(setq temp (ssname sset (setq sslen (1- sslen))))

(if (= typ "Style")

(progn

(if (= tw 0)

(setq tw (list (cdr(assoc fld (entget temp)))))

(progn

(setq sty (cdr(assoc fld (entget temp))))

(if (not (member sty tw))

(setq tw (append tw (list sty)))

)

)

)

)

(progn

(setq tw (+ tw (setq w (cdr(assoc fld (entget temp))))))

(if (= (sslength sset) (1+ sslen)) (setq lw w hw w))

(if (< hw w) (setq hw w))

(if (> lw w) (setq lw w))

)

)

)

(if (= typ "Rotation")

(setq tw (* (/ tw pi) 180.0)

lw (* (/ lw pi) 180.0)

hw (* (/ hw pi) 180.0))

)

(if (= typ "Style")

(progn

(princ (strcat "\n"

typ

"(s) -- "))

(princ tw)

)

(princ (strcat "\n"

typ

" -- Min: "

(rtos lw 2)

"\t Max: "

(rtos hw 2)

"\t Avg: "

(rtos (/ tw (sslength sset)) 2) ))

)

)

;;;

;;; Process Individual request.

;;;

(defun cht_pi ()

(setq sslen (sslength sset))

(while (> sslen 0)

(setq temp (ssname sset (setq sslen (1- sslen))))

(setq ow (cdr(assoc fld (entget temp))))

(if (= typ "Rotation")

(setq ow (/ (* ow 180.0) pi))

)

(initget 0)

(redraw (cdr(assoc -1 (entget temp))) 3)

(if (= typ "Style")

(progn

(setq nw (getstring (strcat "\nNew "

prmpt

". <"

ow ">: ")))

)

(progn

(setq nw (getreal (strcat "\nNew "

prmpt

". <"

(rtos ow 2) ">: ")))

)

)

(if (or (= nw "") (= nw nil))

(setq nw ow)

)

(if (= typ "Rotation")

(setq nw (* (/ nw 180.0) pi))

)

(entmod (subst (cons fld nw)

(assoc fld (setq ent (entget temp)))

ent

)

)

(redraw (cdr(assoc -1 (entget temp))) 1)

)

)

;;;

;;; Process the Select option.

;;;

(defun cht_ps ()

(princ "\nSearch for which Style name? <*>: ")

(setq sn (strcase (getstring))

n -1

nsset (ssadd)

ssl (1- (sslength sset))

)

(if (or (= sn "*") (null sn) (= sn ""))

(setq nsset sset sn "*")

(while (and sn (< n ssl))

(setq temp (ssname sset (setq n (1+ n))))

(if (= (cdr(assoc 7 (entget temp))) sn)

(ssadd temp nsset)

)

)

)

(setq ssl (sslength nsset))

(princ "\nFound ")

(princ ssl)

(princ " text entities with STYLE of ")

(princ sn)

(princ ". ")

)

;;;

;;; The C: function definition.

;;;

(defun c:cta () (chtxt))

(princ "\ Chuong trinh cong caodo vao String , bat dau lenh voi CTA.")

(princ)

[conghoan1003 0]

sorry, khi viết lại mình vô tình xóa space nên bị báo lỗi như trên. Bạn chép lại ct nhé.

 

;;;------------------------------------------------------------------------------------

(defun getTw ()

;;;Get current text width factor

(cdr (assoc 41 (tblsearch "style" (getvar "textstyle"))))

)

;;;------------------------------------------------------------------------------------

(defun getTh (/ Th)

;;;Get current textheight or textsize

(if (= (setq Th (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) 0)

(getvar "textsize")

Th

)

)

;;;------------------------------------------------------------------------------------

(defun emkT (S p)

;;;Write text S at point p by entmake function

;;;Text style, heigh and width factor get from current values

(entmake (list (cons 0 "TEXT")

(cons 10 p)

(cons 40 (getTh))

(cons 41 (getTw))

(cons 1 S)

(cons 7 (getvar "textstyle"))

)

)

)

;;;------------------------------------------------------------------------------------

(defun calcL (e)

;;;Calculate length of Line, Pline, 3dPoly, Spline, Circle, Arc, Polygon

(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))

)

;;;------------------------------------------------------------------------------------

(defun C:CHD (/ Opt S1 S2 e p L)

(vl-load-com)

(command "ucs" "w")

 

(if (not preT) (setq preT "L="))

(if (not sufT) (setq sufT ""))

(setq S1 preT

S2 sufT)

(prompt (strcat "\nMeasure and write length. Current prefix:[" preT "]\tSuffix:[" sufT "]"))

 

(initget "Y N")

(setq Opt (getkword "\nChange prefix and suffix? [Yes/No] :"))

(if (not Opt) (setq Opt "N"))

(if (= Opt "Y")

(setq S1 (getstring "\nPrefix :")

preT S1

S2 (getstring "\nSuffix :")

sufT S2))

 

(setq ss (ssget)

n 0

total 0)

 

(while ss

(repeat (sslength ss)

(setq e (ssname ss n)

L (calcL e)

total (+ total L)

n (1+ n))

)

(setq p (getpoint "\nBase point: "))

(emkT S1 p)

(emkT (strcat " " (rtos total) S2) p)

(setq ss (ssget)

n 0

total 0)

)

(princ)

)

Chào q288!

Bây giờ thì quá tuyệt rồi. Cảm ơn bạn nhiều nha!

[Tue_NV 3.912]

Chào cả nhà!

Cho mình hỏi ai có lisp cộng (trừ) tất cả các số được chọn thêm một giá trị nào đó không? Cho mình xin với. Hiện mình đang dung lisp này, nó cũng có thể cộng được nhưng không hiểu tại sao nó lại có sai số khi sử dụng.

Thank!

Bạn đọc bài viết này. Không những Lisp cộng các text số mà còn loại bỏ các text chữ khi chọn đối tượng là text.

http://www.cadviet.com/forum/index.php?sho...amp;#entry32619

[thanhlichtran 0]

Mình tìm ra lỗi và sửa rồi. Chạy trong file_mau.dwg thì ok. Bạn thử chạy các file khác xem sao, chọn file lớn hơn và nhiều pline hơn để thử nhiều tình huống. CT sửa như sau:

 

Rất tuyệt ! Cảm ơn Diễn đàn Cảm ơn q288 nhiều lắm bạn rất nhiệt tình chương trình chạy ổn lắm . Thank you vẻy much !

[nguyenkhoadung98 2]

Chào bạn nguyenkhoadung98,

Rất vui vì thấy bạn dùng được cái lisp của mình. Về cái vụ vị trí text thì quả thực là mình cũng đang hơi rối, chưa tìm được giải pháp bạn ạ. Còn cái text T2/L1-1A thực ra chỉ khó nếu như bạn đã đặt nó vào đường chuẩn rồi thôi. Nếu như bạn chưa đặt nó vào thì như mình đã viết trong bài trước, chỉ chỉnh tí xíu là OK ngay. Tại mình cứ theo cái hình bạn post lên nên sợ có hai cột cùng số đó mà thôi. Nếu như bạn đặt cái text ấy và cái block d0 ra ngoài đường chuẩn thì mình đã sửa cái lisp rồi. Bạn sửa như sau nhé:

1/- Trong các dòng code (setq t4 (+ i (atoi t2) 1)) bạn xóa béng cái con số 1 đi. Nhớ là chỉ xóa số 1 chứ đừng xóa đi bất cứ dấu ngoặc nào nha.

2/- Trong các dòng code (if (= 0 (rem i 3)) bạn thay số 1 vào vị trí số 0

3/- Trong các dòng code (if (= 1 (rem i 3)) bạn thay số 2 vào vị trí số 1

Lúc này kết quả chạy ra sẽ có các text bắt đầu là T2/L1-1A và tăng dần đến cuối cùng như bạn muốn. Và như vậy bạn có thể chọn điểm bắt đấu từ bất cứ vị trí nào trên đường chuẩn của bạn, các block cột sẽ được bắt đầu chèn từ vị trí đó theo hướng từ trái qua phải bạn ạ.

 

Về cái việc đòi tiên thì ai chả muốn. Mình cũng muốn lắm chớ. Mỗi tội hơi khó kiếm thôi bạn ạ. Cái cô tiên bạn muốn hơi khó tính đấy. Này nhé:

1/- Vì các block đã được chèn sẵn rồi nên việc xác định thứ tự các block này không hề đơn giản bạn ạ. Nhất là khi bản vẽ lại do người khác cung cấp. Đấy cũng chính là lý do mà cái lisp của bạn lại yêu cầu người dùng phải nhập lại thứ tự các điểm chèn để mà đánh số cho đúng trật tự bạn ạ. Bởi vì rất có thể cái block cột thứ 6 lại được insert trước thằng block cột thứ nhất ấy chứ.

2/- Khoảng cách giữa các block có được biết chính xác hay không hay phải mò từng chú một.

3/- Về vị trí đặt text cũng gặp rắc rối y như trường hợp trên bạn ạ.

 

Vậy nên mình thiển nghĩ thế này: Chả có tiên thì ni cô cũng xài tạm vậy, cách xài như sau

Nếu như bạn đã biết chính xác cái khoảng cách giữa các block là như nhau và biết được chính xác cái điểm chèn của block đấu tiên thì bạn hoàn toàn có thể xài cái củ lisp mà mình đã biếu bạn với chút xíu công phu như sau:

1/- Bạn gõ giùm mình ba hay bốn cái dấu ; vào trước các dòng code (command "insert" bn "r" gd p1 "" "" "") để nó trở thành ;;;;(command "insert" bn "r" gd p1 "" "" "") .

2/- Bạn load lisp và chạy nó y sì như các thao tác cũ chỉ lưu ý rằng chọn đúng cái điểm chèn đầu tiên của cái block mà bạn muốn bắt đầu đánh số và nhập đúng cái khoảng cách giữa các block đã được chèn. Vậy là khi chạy lisp nó sẽ "quên béng cái việc insert block cột của bạn mà chỉ nhăm nhăm đánh số thôi bạn ạ. Và nó cũng sẽ đánh số i sì phóoc như bạn muốn

3/- Sau khi xài xong, bạn chịu khó xóa sạch mấy cái dấu ; đi là lisp lại trở về nguyên trạng bạn ạ. Vậy là khỏi phải lo tậu thêm lisp mới cho nặng máy bạn nhé.

 

Hì hì, vì mình chuyên đi mót nên bày bạn cái cách hơi củ chuối này. Bạn đừng giận nếu bạn không muốn xài thế nhé. Cái cách tuy củ chuối nhưng được việc ra phết bạn ạ. Ít ra nó cũng cứu đói được cho mình nhiều phen rồi bạn ạ.

 

Hy vọng bạn sẽ bật cười khi xài cái cách này. Mong bạn thành công

 

PS: bạn nguyenkhoadung ơi, lúc nào bạn ranh rảnh chỉ mình cách xài cái lệnh ME với nhé. Mình xài cad2004 mà chả biết mò cái đó ra sao. Thấy bạn xài tới tới mà ham quá à. Thanks bạn trước nha.

 

 

cảm ơn bạn Bình nhiều, có 1 vấn đề thế này bạn ạ.sau khi tớ dùng lisp IDO của bạn thì các chữ khác của tớ nó lại bị nhảy font hết cả như thế này này ( kể cả têxt gốc cũng bị nhảy font về kiểu text này ] text gốc tớ dùng font .vnarialH tớ hi vọng text sau khi dùng lisp nó cũng như thế

 

 

http://www.mediafire.com/file/2cxvkwdwmym/Drawing1.dwg

 

trang up của cadviet lỗi nên đành up vào đây :cheers:. cảm ơn bạn Bình

[phamthanhbinh 3.146]

cảm ơn bạn Bình nhiều, có 1 vấn đề thế này bạn ạ.sau khi tớ dùng lisp IDO của bạn thì các chữ khác của tớ nó lại bị nhảy font hết cả như thế này này ( kể cả têxt gốc cũng bị nhảy font về kiểu text này ] text gốc tớ dùng font .vnarialH tớ hi vọng text sau khi dùng lisp nó cũng như thế

http://www.mediafire.com/file/2cxvkwdwmym/Drawing1.dwg

 

trang up của cadviet lỗi nên đành up vào đây :cheers:. cảm ơn bạn Bình

Hì hì,

Bạn nguyenkhoadung98 ơi, cái nè là tại bạn đấy chứ hổng phải tại lisp đâu bạn ạ. Lần trước bạn bảo mình là muốn text mới có cùng đặc tính với text gốc. Báo hại mình phải mày mò cái bộ mã DXF của text gốc. Bạn có thấy trong lisp một lô xích xông các đặc tính của text được mình moi ra không? Trong đó có cái Style của text là 03CHU_NHO. Mình mò vào cái Style này thì lại thấy font gốc là txt.shx. Vậy nên mình mới tống cái font này vào trong dòng code (command "style" .......)

bạn ạ. Khi chạy thử mình thấy cái text gốc nó bị chuyển font là hiểu ngay rằng bạn đã modify cái style gốc rồi, nhưng chịu chết chả hiểu bạn dùng font gì mà sửa nữa, đành cứ để nó đó. Bây giờ bạn muốn sửa thì chỉ cần thay cái font .vnarialH của bạn vào chỗ cái chuỗi "txt.shx" trong đoạn code nói trên là xong mà. Nhưng bạn nhớ là phải đúng tên file font cả về tên và kiểu file bạn nhé. Mình chả biết cái font của bạn có kiểu file là gì cả, bạn kiểm tra lại nhé.

Trong trường hợp bạn không muốn sửa thì chỉ đơn giản là bạn xóa béng cái dòng code này đi là xong và như vậy text mới sẽ không cùng style với text gốc cũng như các text khác trên bản vẽ sẽ chả thay đổi gì.

Chúc bạn thành công.

[baodenhp 0]

Các bạn giúp mình lisp này với. Mình muốn ghi text lý trình của đường ( ví dụ: 1+200), điểm gốc của đường được chọn trước và nếu vuông text đó vuông góc với đường tại vị trí ghi text thi tốt quá. Cảm ơn nhiều nhiều!!!!

[conghoan1003 0]

Bạn nào co lisp này cho mình xin với. Mình cần ghi khoảng cách thực (nếu có tỷ lệ bản vẽ càng tốt) tại hai điểm. Đại loại là mình muốn ghi kích thước của hai điểm tại một vị trí nào đó. Ai biết giúp mình với nhé, Cảm ơn nhiều!

[ustoichivost 6]

Bạn nào co lisp này cho mình xin với. Mình cần ghi khoảng cách thực (nếu có tỷ lệ bản vẽ càng tốt) tại hai điểm. Đại loại là mình muốn ghi kích thước của hai điểm tại một vị trí nào đó. Ai biết giúp mình với nhé, Cảm ơn nhiều!

Dùng lệnh distance của Lisp, sau đó gọi lệnh mtext của cad để ghi ra vào một điểm nào đó !

[haanh 1.590]

Bạn nào co lisp này cho mình xin với. Mình cần ghi khoảng cách thực (nếu có tỷ lệ bản vẽ càng tốt) tại hai điểm. Đại loại là mình muốn ghi kích thước của hai điểm tại một vị trí nào đó. Ai biết giúp mình với nhé, Cảm ơn nhiều!

Ko hiểu ý câu hỏi của bác...bản vẽ đó là do bác vẽ hay của người khác??? Tỷ lệ bản vẽ khi bác thiết lập Mvsetup là bao nhiêu???

Hay nhất bác cư úp cái bản vẽ của bác lên sẽ tiện trả lời cho bác.

[phamthanhbinh 3.146]

Chào cả nhà!

Cho mình hỏi ai có lisp cộng (trừ) tất cả các số được chọn thêm một giá trị nào đó không? Cho mình xin với. Hiện mình đang dung lisp này, nó cũng có thể cộng được nhưng không hiểu tại sao nó lại có sai số khi sử dụng.

Thank!

Chào bạn conghoan1003,

Bạn hãy tham khảo cái hàm (mapcar...) và kết hợp với hàm (lambda...) xem bạn nhé. Các hàm này có trong Help Developer của Cad và theo thiển ý của mình nó làm được cái điều bạn muốn. Hy vọng bạn sẽ sử dụng tốt chúng cho công việc của bạn.

Chúc bạn vui.

[ndtnv 481]

cảm ơn bạn Bình nhiều, có 1 vấn đề thế này bạn ạ.sau khi tớ dùng lisp IDO của bạn thì các chữ khác của tớ nó lại bị nhảy font hết cả như thế này

 

này ( kể cả têxt gốc cũng bị nhảy font về kiểu text này ] text gốc tớ dùng font .vnarialH tớ hi vọng text sau khi dùng lisp nó cũng như thế

http://www.mediafire.com/file/2cxvkwdwmym/Drawing1.dwg

 

trang up của cadviet lỗi nên đành up vào đây :cheers:. cảm ơn bạn Bình

Vì không có thời gian nên tôi viết tạm lisp này cho bạn.

Hàm TachTen là hàm giả để lấy trị default, bạn có thể sửa lại theo lisp bạn có).

Nếu hoàn chỉnh thì:

-Kết quả thì các đối tượng chọn ban đầu sẽ nằm ở vị trí ban đầu chứ không phải cuối cùng, nhưng tôi nghĩ là không quan trọng.

-Cho phép chọn chiều (trong lisp này, chiều sẽ là từ điểm gốc đến đầu xa của pline

Cách dùng:

chọn đối tượng cột và text cùng lúc, chương trình sẽ nhận dạng text ( nếu có nhiều text có thể bị lỗi) và block (nếu có) để lấy điểm chèn tự động ( cột có thể nhiều đối tượng và không nhất thiết phải là block )

Điểm gốc có thể nằm ngoài đường chuẩn

Copy code vào word rồi paste

(defun GetDxf(n e) (cdr (assoc n e)))
(defun ModDxf(n v e)
(if (GetDxf n e)
	(entmod (subst (cons n  v) (assoc n e) e))
	(entmod (append e (list (cons n  v))))
)
)

(defun c:dsc ( / i k e ss plObj p0 p1 a0 a1 kc d d0 len om pre id inc pos asc las)
(defun TachTen(s)
	(setq pre "T2/l1-" id 1 pos "" asc 97 las 0)
)
(defun TenCotKe()
	(setq id (+ id inc))
	(if asc (setq las (rem (1+ las) 3)))
	(strcat pre (itoa id) pos (if asc (chr (+ asc las)) ""))
)
; Main program
(princ "\nChon doi tuong va text :")
(setq ss (ssget ) i -1)
(repeat (sslength ss)
	(setq i (1+ i)e (entget (ssname ss i)) )
	(if (= "INSERT" (GetDxf 0 e))
		(setq p1 (GetDxf 10 e))
	)
	(if (= "TEXT" (GetDxf 0 e))
		(progn	(TachTen (GetDxf 1 e))	(setq k i)	)
	)
)
(setq plObj (car (entsel "\nHay chon duong polyline ")))
(if (not (and k plObj)) (quit))
(setq p0 (getpoint "\nChon diem goc de copy :  "))
(if (not p0) (setq p0 p1))
(if (not (setq p0 (vlax-curve-getClosestPointTo  plObj p0))) (quit))
(setq inc (getint "\nHay nhap he so tang giam <1> : "))
(if (not inc )	(setq inc 1)	)
(setq d (getreal "\nChon khoang cach giua cac doi tuong: "))
(setq om (getvar "OSMODE"))  (setvar "OSMODE" 0)
(setq a0 (angle '(0 0) (vlax-curve-getFirstDeriv plObj (vlax-curve-getParamAtPoint plObj p0))))
(setq d0 (vlax-curve-getDistAtPoint plObj p0))
(setq len (vlax-curve-getDistAtPoint plObj (vlax-curve-getEndPoint plObj)))
(if (< d0 (/ len 2))
	(setq len (- len d0))
	(setq len d0 d (- d))
)
(setq d0 (+ d0 d))
(while (setq p1 (vlax-curve-getpointatdist plObj d0))
	(setq a1 (angle '(0 0) (vlax-curve-getFirstDeriv plObj (vlax-curve-getParamAtPoint plObj p1))))
	(command "COPY" ss "" p0 p0)
	(command "MOVE" "P" "" p0 p1)
	(command "ROTATE" "P" "" p1 (/ (* 180 (- a1 a0)) pi))
	(setq e (entget (ssname ss k)))
	(ModDxf 1 (TenCotKe) e)
	(setq d0 (+ d0 d) p0 p1 a0 a1)
)
(setvar "OSMODE" om)
)

[ndtnv 481]

Các bạn giúp mình lisp này với. Mình muốn ghi text lý trình của đường ( ví dụ: 1+200), điểm gốc của đường được chọn trước và nếu vuông text đó vuông góc với đường tại vị trí ghi text thi tốt quá. Cảm ơn nhiều nhiều!!!!

Bạn tham khảo bài đánh số cột ngay trên, nếu không được thì hãy gửi bản vẽ mẫu và ghi rõ yêu cầu (nhớ save cad từ 2004 về trước)

[phamthanhbinh 3.146]

Vì không có thời gian nên tôi viết tạm lisp này cho bạn.

Hàm TachTen là hàm giả để lấy trị default, bạn có thể sửa lại theo lisp bạn có).

Nếu hoàn chỉnh thì:

-Kết quả thì các đối tượng chọn ban đầu sẽ nằm ở vị trí ban đầu chứ không phải cuối cùng, nhưng tôi nghĩ là không quan trọng.

-Cho phép chọn chiều (trong lisp này, chiều sẽ là từ điểm gốc đến đầu xa của pline

Cách dùng:

chọn đối tượng cột và text cùng lúc, chương trình sẽ nhận dạng text ( nếu có nhiều text có thể bị lỗi) và block (nếu có) để lấy điểm chèn tự động ( cột có thể nhiều đối tượng và không nhất thiết phải là block )

Điểm gốc có thể nằm ngoài đường chuẩn

Copy code vào word rồi paste

(defun GetDxf(n e) (cdr (assoc n e)))
(defun ModDxf(n v e)
(if (GetDxf n e)
	(entmod (subst (cons n  v) (assoc n e) e))
	(entmod (append e (list (cons n  v))))
)
)

(defun c:dsc ( / i k e ss plObj p0 p1 a0 a1 kc d d0 len om pre id inc pos asc las)
(defun TachTen(s)
	(setq pre "T2/l1-" id 1 pos "" asc 97 las 0)
)
(defun TenCotKe()
	(setq id (+ id inc))
	(if asc (setq las (rem (1+ las) 3)))
	(strcat pre (itoa id) pos (if asc (chr (+ asc las)) ""))
)
; Main program
(princ "\nChon doi tuong va text :")
(setq ss (ssget ) i -1)
(repeat (sslength ss)
	(setq i (1+ i)e (entget (ssname ss i)) )
	(if (= "INSERT" (GetDxf 0 e))
		(setq p1 (GetDxf 10 e))
	)
	(if (= "TEXT" (GetDxf 0 e))
		(progn	(TachTen (GetDxf 1 e))	(setq k i)	)
	)
)
(setq plObj (car (entsel "\nHay chon duong polyline ")))
(if (not (and k plObj)) (quit))
(setq p0 (getpoint "\nChon diem goc de copy :  "))
(if (not p0) (setq p0 p1))
(if (not (setq p0 (vlax-curve-getClosestPointTo  plObj p0))) (quit))
(setq inc (getint "\nHay nhap he so tang giam  : "))
(if (not inc )	(setq inc 1)	)
(setq d (getreal "\nChon khoang cach giua cac doi tuong: "))
(setq om (getvar "OSMODE"))  (setvar "OSMODE" 0)
(setq a0 (angle '(0 0) (vlax-curve-getFirstDeriv plObj (vlax-curve-getParamAtPoint plObj p0))))
(setq d0 (vlax-curve-getDistAtPoint plObj p0))
(setq len (vlax-curve-getDistAtPoint plObj (vlax-curve-getEndPoint plObj)))
(if (		(setq len (- len d0))
	(setq len d0 d (- d))
)
(setq d0 (+ d0 d))
(while (setq p1 (vlax-curve-getpointatdist plObj d0))
	(setq a1 (angle '(0 0) (vlax-curve-getFirstDeriv plObj (vlax-curve-getParamAtPoint plObj p1))))
	(command "COPY" ss "" p0 p0)
	(command "MOVE" "P" "" p0 p1)
	(command "ROTATE" "P" "" p1 (/ (* 180 (- a1 a0)) pi))
	(setq e (entget (ssname ss k)))
	(ModDxf 1 (TenCotKe) e)
	(setq d0 (+ d0 d) p0 p1 a0 a1)
)
(setvar "OSMODE" om)
)

Chào bác ndtnv,

Trong đoạn lisp trên đây của bác, bác sử dụng lệnh rotate để quay toàn bộ các đối tượng được chọn quanh điểm gốc p1 sau khi bác đã move nó về đó. Như vậy hoàn toàn có thể đảm bảo được vị trí tương đối giữa các đối tượng text và block. Tuy nhiên sẽ có trường hợp text bị lộn ngược bác ạ vì khi quay text không thể sắp lại theo ý người dùng được. Điều này cũng là điều mà mình cảm thấy bí khi phải giải quyết nó, làm sao cho text vừa không lộn ngược lại vừa đảm bảo vị trí tương đối với block. Bác có cách giải quyết nào trong trường hợp này không bác nhỉ? Hoặc giả bác gợi ý cho mình để mình thử mày mò xem sao. Cám ơn bác trước nhé.

Cái hàm lấy góc a0 và a1 của bác rất hay. Cám ơn bác đã chỉ dẫn.

[tdvn 53]

Bạn tham khảo bài ðánh số cột ngay trên, nếu không ðýợc thì hãy gửi bản vẽ mẫu và ghi rõ yêu cầu (nhớ save cad từ 2004 về trýớc)

Quả là rối quá, mình không biết bài nào là của chủ ðề nào. Có lẽ mỗi chủ ðề các bạn nên ðặt riêng thì hay hõn.

[maihoathao 0]

Bác ơi viết hộ em lisp kiểm tra bắt snap giữa 2 đường với nhau, mỗi khi gặp lỗi thì đánh dẫu tại chỗ có lỗi đó.

cảm ơn bác nhiều nhé!

[ndtnv 481]

Chào bác ndtnv,

Trong đoạn lisp trên đây của bác, bác sử dụng lệnh rotate để quay toàn bộ các đối tượng được chọn quanh điểm gốc p1 sau khi bác đã move nó về đó. Như vậy hoàn toàn có thể đảm bảo được vị trí tương đối giữa các đối tượng text và block. Tuy nhiên sẽ có trường hợp text bị lộn ngược bác ạ vì khi quay text không thể sắp lại theo ý người dùng được. Điều này cũng là điều mà mình cảm thấy bí khi phải giải quyết nó, làm sao cho text vừa không lộn ngược lại vừa đảm bảo vị trí tương đối với block. Bác có cách giải quyết nào trong trường hợp này không bác nhỉ? Hoặc giả bác gợi ý cho mình để mình thử mày mò xem sao. Cám ơn bác trước nhé.

Cái hàm lấy góc a0 và a1 của bác rất hay. Cám ơn bác đã chỉ dẫn.

Đây là VD đoạn lisp lấy tâm của 1 text

(setq e (entget (car (entsel "\nHay chon 1 text"))))
(setq tbx (textbox e))
(setq p0 (car tbx) p1 (cadr tbx))
(setq p (cdr (assoc 10 e)) a (cdr (assoc 50 e) ))
(setq cen (polar p (+ a (angle p0 p1)) (/ (distance p0 p1) 2) ))

Nếu dùng ROTATE text 180 độ, điểm chuẩn là cen. (chú ý OSMODE)

Nếu dùng endmod thì điểm chèn mới (dxf 10 hoặc 11 => phải xét align của text ) lấy đối xứng tâm qua cen, góc của text - pi

Mình nghĩ là chương trình này thì cứ để như vậy vì nếu trong trường hợp đường chuẩn gần như thẳng đứng thì các text gần nhau có thể có chiều ngược nhau rất khó xem. Còn việc tự động xoay text thì làm 1 hàm riêng để user có thể dùng theo ý muốn

 

Quả là rối quá, mình không biết bài nào là của chủ ðề nào. Có lẽ mỗi chủ ðề các bạn nên ðặt riêng thì hay hõn.

Bài đang xem là: Gửi vào: #1840

Thì bài ngay trên là: Gửi vào: #1839

Tham khảo bài trên là tham khảo bài Gửi vào: #1839 và các bài có liên quan trước đó của nguyenkhoadung98

[nguyenkhoadung98 2]

Đây là VD đoạn lisp lấy tâm của 1 text

(setq e (entget (car (entsel "\nHay chon 1 text"))))
(setq tbx (textbox e))
(setq p0 (car tbx) p1 (cadr tbx))
(setq p (cdr (assoc 10 e)) a (cdr (assoc 50 e) ))
(setq cen (polar p (+ a (angle p0 p1)) (/ (distance p0 p1) 2) ))

Nếu dùng ROTATE text 180 độ, điểm chuẩn là cen. (chú ý OSMODE)

Nếu dùng endmod thì điểm chèn mới (dxf 10 hoặc 11 => phải xét align của text ) lấy đối xứng tâm qua cen, góc của text - pi

Mình nghĩ là chương trình này thì cứ để như vậy vì nếu trong trường hợp đường chuẩn gần như thẳng đứng thì các text gần nhau có thể có chiều ngược nhau rất khó xem. Còn việc tự động xoay text thì làm 1 hàm riêng để user có thể dùng theo ý muốn

Bài đang xem là: Gửi vào: #1840

Thì bài ngay trên là: Gửi vào: #1839

Tham khảo bài trên là tham khảo bài Gửi vào: #1839 và các bài có liên quan trước đó của nguyenkhoadung98

 

 

cảm ơn bạn Bình và bạn NDTVN nhiều lắm, lisp dsc của bạn NDTVN dùng rất ổn cho cả đường plolyline và spline. nhưng có 1 vấn đề là với đường spline thì lisp bắn đèn và đánh số xong thì lại chạy về điểm ban đầu và tiếp tục đánh số tại duy nhất điểm ấy và kô chịu dừng lại :cheers:.

 

- thứ 2 là lisp đánh số kô đúng với ý mình mình cần đánh là : text mẫu mình chọn là T1/L1-1A các số kế tiếp cần đánh là T1/L1-2B, T1/L1-3C, T1/L1-4A,T1/L1-5B.....tức là chỉ thay đổi 2 ký tự cuối cùng thôi còn lisp lại đánh là T2/L1-2B, T2/L1-3C,T2/L1-4A, T2/L1-5B....

 

- thứ 3 là sau khi dùng lisp thì mình bị mấy hết các object snap đã chọn.

 

cảm ơn 2 bạn đã quan tâm, mong sớm nhận đc phản hồi từ các bạn.thanks u so

 

 

file kèm theo (cadviet kô up đc nên đành up vào đây ) :) (đã chuyển về cad 2004 )

 

http://www.mediafire.com/?hdjdumntojl

[ndtnv 481]

cảm ơn bạn Bình và bạn NDTVN nhiều lắm, lisp dsc của bạn NDTVN dùng rất ổn cho cả đường plolyline và spline. nhưng có 1 vấn đề là với đường spline thì lisp bắn đèn và đánh số xong thì lại chạy về điểm ban đầu và tiếp tục đánh số tại duy nhất điểm ấy và kô chịu dừng lại :cheers:.

 

- thứ 2 là lisp đánh số kô đúng với ý mình mình cần đánh là : text mẫu mình chọn là T1/L1-1A các số kế tiếp cần đánh là T1/L1-2B, T1/L1-3C, T1/L1-4A,T1/L1-5B.....tức là chỉ thay đổi 2 ký tự cuối cùng thôi còn lisp lại đánh là T2/L1-2B, T2/L1-3C,T2/L1-4A, T2/L1-5B....

 

- thứ 3 là sau khi dùng lisp thì mình bị mấy hết các object snap đã chọn.

 

cảm ơn 2 bạn đã quan tâm, mong sớm nhận đc phản hồi từ các bạn.thanks u so

file kèm theo (cadviet kô up đc nên đành up vào đây ) :) (đã chuyển về cad 2004 )

 

http://www.mediafire.com/?hdjdumntojl

Do không có thời gian nên mình chỉ test trên các đường trong bản vẽ mẫu, vì vậy có lỗi khi đường chuẩn là spline.

-Đánh số không đúng là vì mình đã nói hàm TachTen là hàm giả, trị default mình lấy theo bản vẽ mẫu.

Bạn nên sửa lại theo lisp của bạn để cho đúng với các trường hợp khác. Nếu không thì mỗi khi chạy với trị default khác, bạn sửa trực tiếp trong lisp này theo:

pre: tiền tố, id: số bắt đầu, pos: hậu tố đã bớt ký tự cuối nếu là ABCabc

asc=97 nếu là abc, =65 nếu là ABC. nếu không thì là nil

las= 0: A,a, =1: B,b, =2: C,c

-Lý do mất hết các object snap đã chọn là vì có lỗi nên dòng lệnh khôi phục lại object snap không thực hiện được

Đây là lisp đã fix lỗi spline

(defun c:dsc ( / i k e ss plObj p0 p1 a0 a1 kc d d0 len om pre id inc pos asc las)
(defun TachTen(s)
	(setq pre "T1/l1-" id 1 pos "" asc 97 las 0)
)
(defun TenCotKe()
	(setq id (+ id inc))
	(if asc (setq las (rem (1+ las) 3)))
	(strcat pre (itoa id) pos (if asc (chr (+ asc las)) ""))
)
; Main program
(princ "\nChon doi tuong va text :")
(setq ss (ssget ) i -1)
(repeat (sslength ss)
	(setq i (1+ i)e (entget (ssname ss i)) )
	(if (= "INSERT" (GetDxf 0 e))
		(setq p1 (GetDxf 10 e))
	)
	(if (= "TEXT" (GetDxf 0 e))
		(progn	(TachTen (GetDxf 1 e))	(setq k i)	)
	)
)
(setq plObj (car (entsel "\nHay chon duong polyline ")))
(if (not (and k plObj)) (quit))
(setq p0 (getpoint "\nChon diem goc de copy :  "))
(if (not p0) (setq p0 p1))
(if (not (setq p0 (vlax-curve-getClosestPointTo  plObj p0))) (quit))
(setq inc (getint "\nHay nhap he so tang giam <1> : "))
(if (not inc )	(setq inc 1)	)
(setq d (getreal "\nChon khoang cach giua cac doi tuong: "))
(setq om (getvar "OSMODE"))  (setvar "OSMODE" 0)
(setq a0 (angle '(0 0) (vlax-curve-getFirstDeriv plObj (vlax-curve-getParamAtPoint plObj p0))))
(setq d0 (vlax-curve-getDistAtPoint plObj p0))
(setq len (vlax-curve-getDistAtPoint plObj (vlax-curve-getEndPoint plObj)))
(if (< d0 (/ len 2))
	(setq len (- len d0))
	(setq len d0 d (- d))
)
(setq d0 (+ d0 d) i (fix (abs (/ len d))))
(while (and (> i 0) (setq p1 (vlax-curve-getpointatdist plObj d0)))
	(setq a1 (angle '(0 0) (vlax-curve-getFirstDeriv plObj (vlax-curve-getParamAtPoint plObj p1))))
	(command "COPY" ss "" p0 p0)
	(command "MOVE" ss "" p0 p1)
	(command "ROTATE" ss "" p1 (/ (* 180 (- a1 a0)) pi))
	(setq e (entget (ssname ss k)))
	(ModDxf 1 (TenCotKe) e)
	(setq d0 (+ d0 d) p0 p1 a0 a1 i (1- i))
)
(setvar "OSMODE" om)
)

[q288 166]

Bác ơi viết hộ em lisp kiểm tra bắt snap giữa 2 đường với nhau, mỗi khi gặp lỗi thì đánh dẫu tại chỗ có lỗi đó.

cảm ơn bác nhiều nhé!

 

không hiểu ý bạn, bắt snap là sao? thế nào gọi là lỗi?

[maihoathao 0]

sorry mình đã nói không rõ. Cụ thể nó là như sau : có 2 layer

 

+ layer 11 là load center line

+ layer 19 là line trich dan mã số đường

 

tớ muốn lisp kiểm tra và tạo ra point style hoặc cricle khi phát hiện ra lỗi undershoot (chưa tới) và overshoot (vượt quá) cụ thể là :

 

line layer 19 khi bắt snap vào load center line (layer 11) nếu phát hiện chưa tới hoặc vượt quá thì nó sẽ báo lỗi bằng point style or cricle .

đường dẫn file cụ thể đây ạ :

 

http://www.cadviet.com/upfiles/check_loi.dwg

 

 

cảm ơn nhiều nhes

[nguyenkhoadung98 2]

Do không có thời gian nên mình chỉ test trên các đường trong bản vẽ mẫu, vì vậy có lỗi khi đường chuẩn là spline.

-Đánh số không đúng là vì mình đã nói hàm TachTen là hàm giả, trị default mình lấy theo bản vẽ mẫu.

Bạn nên sửa lại theo lisp của bạn để cho đúng với các trường hợp khác. Nếu không thì mỗi khi chạy với trị default khác, bạn sửa trực tiếp trong lisp này theo:

pre: tiền tố, id: số bắt đầu, pos: hậu tố đã bớt ký tự cuối nếu là ABCabc

asc=97 nếu là abc, =65 nếu là ABC. nếu không thì là nil

las= 0: A,a, =1: B,b, =2: C,c

-Lý do mất hết các object snap đã chọn là vì có lỗi nên dòng lệnh khôi phục lại object snap không thực hiện được

Đây là lisp đã fix lỗi spline

(defun c:dsc ( / i k e ss plObj p0 p1 a0 a1 kc d d0 len om pre id inc pos asc las)
(defun TachTen(s)
	(setq pre "T1/l1-" id 1 pos "" asc 97 las 0)
)
(defun TenCotKe()
	(setq id (+ id inc))
	(if asc (setq las (rem (1+ las) 3)))
	(strcat pre (itoa id) pos (if asc (chr (+ asc las)) ""))
)
; Main program
(princ "\nChon doi tuong va text :")
(setq ss (ssget ) i -1)
(repeat (sslength ss)
	(setq i (1+ i)e (entget (ssname ss i)) )
	(if (= "INSERT" (GetDxf 0 e))
		(setq p1 (GetDxf 10 e))
	)
	(if (= "TEXT" (GetDxf 0 e))
		(progn	(TachTen (GetDxf 1 e))	(setq k i)	)
	)
)
(setq plObj (car (entsel "\nHay chon duong polyline ")))
(if (not (and k plObj)) (quit))
(setq p0 (getpoint "\nChon diem goc de copy :  "))
(if (not p0) (setq p0 p1))
(if (not (setq p0 (vlax-curve-getClosestPointTo  plObj p0))) (quit))
(setq inc (getint "\nHay nhap he so tang giam <1> : "))
(if (not inc )	(setq inc 1)	)
(setq d (getreal "\nChon khoang cach giua cac doi tuong: "))
(setq om (getvar "OSMODE"))  (setvar "OSMODE" 0)
(setq a0 (angle '(0 0) (vlax-curve-getFirstDeriv plObj (vlax-curve-getParamAtPoint plObj p0))))
(setq d0 (vlax-curve-getDistAtPoint plObj p0))
(setq len (vlax-curve-getDistAtPoint plObj (vlax-curve-getEndPoint plObj)))
(if (< d0 (/ len 2))
	(setq len (- len d0))
	(setq len d0 d (- d))
)
(setq d0 (+ d0 d) i (fix (abs (/ len d))))
(while (and (> i 0) (setq p1 (vlax-curve-getpointatdist plObj d0)))
	(setq a1 (angle '(0 0) (vlax-curve-getFirstDeriv plObj (vlax-curve-getParamAtPoint plObj p1))))
	(command "COPY" ss "" p0 p0)
	(command "MOVE" ss "" p0 p1)
	(command "ROTATE" ss "" p1 (/ (* 180 (- a1 a0)) pi))
	(setq e (entget (ssname ss k)))
	(ModDxf 1 (TenCotKe) e)
	(setq d0 (+ d0 d) p0 p1 a0 a1 i (1- i))
)
(setvar "OSMODE" om)
)

 

 

Cảm ơn NDTNV mình đã dùng thử lisp của bạn nhưng mà đến lúc nó hỏi chọn đối tượng và têxt xong mình chọn rồi enter thì lisp dừng lại không chạy nữa, kô bit lỗi này là thế nào vậy bạn, mong sớm nhận được phản hồi của bạn. chân thành cảm ơn bạn.

[ndtnv 481]

Cảm ơn NDTNV mình đã dùng thử lisp của bạn nhưng mà đến lúc nó hỏi chọn đối tượng và têxt xong mình chọn rồi enter thì lisp dừng lại không chạy nữa, kô bit lỗi này là thế nào vậy bạn, mong sớm nhận được phản hồi của bạn. chân thành cảm ơn bạn.

Đó là do bạn chưa chọn đường chuẩn. Có lẽ bạn nên thêm 1 số thông báo lỗi cho dễ sử dụng hơn vì trong lisp trên, nếu không có text, điểm gốc hoặc đường chuẩn thì chương trình tự động thoát.

[quyennv01 12]

Bạn có thể post yêu cầu về autolisp ở topic này.

Mọi người giúp mình cái lisp này nhé.mình muốn các dòng text giãn đều nhau (tức là khi sắp xếp chúng vào một chỗ) thì mình muốn các dòng nó giãn cách đều nhau.mọi người giúp mình nhé.