用文字修剪线
本帖最后由 chenjieq1990 于 2017-9-15 09:23 编辑cad中有个功能，使用文字可以修剪线，但是当文字与线之间的间距过大就失效，本程序想实现用文字能修剪任意线，但是在操作中遇到一个问题，就是如何使用pause实现多次选择修剪的位置，希望有大神能指点一二，本人新手，在论坛学习了一段时间，希望能多多指教。
本帖最后由 chenjieq1990 于 2017-10-18 17:19 编辑
xinxirong 发表于 2017-9-15 20:50
建议合并修剪和延伸。。。
已经加了。(defun C:w1(/ cm os wt_text0 wt_text wt_textdata wt_box wt_txpz1 wt_txpz3 wt_1 wt_2)
(vl-load-com)
; (defun r2d (r) (/ (* r 180.0) pi));弧度转角度
(setq cm (getvar "cmdecho"))
(setq os (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(defun *error* (msg) ;错误处理
(vl-cmdf "" "")
(vl-cmdf "ucs" "")
(vl-cmdf "erase" wt_1 wt_2)
(redraw wt_text 4)
(setvar "cmdecho" cm)
(setvar "osmode" os)
(princ msg)
)
(setq wt_text0(entsel"\n选择文本:"))
;(setq h(cdr (assoc 0 (entget(car wt_text0)))))
(while(or (= wt_text0 nil) (/= (cdr (assoc 0 (entget(car wt_text0)))) "TEXT") )
(setq wt_text0(entsel"\n选择文本:"))
)
(setq wt_text(car wt_text0))
(setq wt_textdata(entget wt_text))
;or (wt_text0 null)
(redraw wt_text 3)
(vl-cmdf "ucs" "e" wt_text)
(setq wt_box(textbox wt_textdata))
(setq wt_txpz1(car wt_box)
wt_txpz3(cadr wt_box)
)
; (setq wt_attext(vlax-ename->vla-object wt_text))
; (setq wt_ro(r2d (vla-get-rotationwt_attext)))
(vl-cmdf "xline" "v" wt_txpz1 "")
(setq wt_1(entlast))
;(redraw wt_1 2)
(vl-cmdf "xline" "v" wt_txpz3 "")
(setq wt_2(entlast))
;(redraw wt_2 2)
(redraw wt_text 4)
(vl-cmdf "trim" wt_1 wt_2 "" )
(vl-cmdf pause "")
;(prompt "\n请选择择修剪位置:")
;(setq wt_line0(entsel"\n修剪对象:"))
;(setq wt_line(car wt_line0))
;(setq wt_linedata(entget wt_line))
;(setq wt_n 0)
;(repeat (sslength wt_lines) () (setq wt_n(1+ wt_n)))
;(setq ent(ssname ss n))
(vl-cmdf "trim" wt_1 wt_2 "" )
(vl-cmdf pause "")
(vl-cmdf "erase" wt_1 wt_2)
(vl-cmdf "erase" "" "")
(vl-cmdf "ucs" "")
(setvar "cmdecho" cm)
(setvar "osmode" os)
(prin1)
)
(defun C:w2(/ cm os wt_text0 wt_text wt_textdata wt_box wt_txpz1 wt_txpz3 wt_1 wt_2)
(vl-load-com)
(setq cm (getvar "cmdecho"))
(setq os (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(defun *error* (msg) ;错误处理
(vl-cmdf "" "")
(vl-cmdf "ucs" "")
(redraw wt_text 4)
(vl-cmdf "erase" wt_1 wt_2)
(setvar "cmdecho" cm)
(setvar "osmode" os)
(princ msg)
);
(setq wt_text0(entsel"\n选择文本:"))
(while(or (= wt_text0 nil) (/= (cdr (assoc 0 (entget(car wt_text0)))) "TEXT") )
(setq wt_text0(entsel"\n选择文本:"))
)
(setq wt_text(car wt_text0))
(setq wt_textdata(entget wt_text))
(redraw wt_text 3)
(vl-cmdf "ucs" "e" wt_text)
(setq wt_box(textbox wt_textdata))
(setq wt_txpz1(car wt_box)
wt_txpz3(cadr wt_box)
)
(vl-cmdf "xline" "v" wt_txpz1 "")
(setq wt_1(entlast))
;(redraw wt_1 2)
(vl-cmdf "xline" "v" wt_txpz3 "")
(setq wt_2(entlast))
(vl-cmdf "extend" wt_1 wt_2 "" )
(vl-cmdf pause "")
;(vl-cmdf pause "")
(vl-cmdf "extend" wt_1 wt_2 "" )
(vl-cmdf pause "")
(vl-cmdf "erase" wt_1 wt_2)
(vl-cmdf "erase" "" "")
(vl-cmdf "ucs" "")
(redraw wt_text 4)
(setvar "cmdecho" cm)
(setvar "osmode" os)
(prin1)
)
其中w1是修剪，w2是延伸
本帖最后由 chenjieq1990 于 2017-9-15 09:33 编辑
(defun C:wt(/ cm wt_text0 wt_text wt_textdata wt_box wt_txpz1 wt_txpz3 wt_1 wt_2)
(vl-load-com)
; (defun r2d (r) (/ (* r 180.0) pi));弧度转角度
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(defun *error* (msg) ;错误处理
(vl-cmdf "" "")
(vl-cmdf "ucs" "")
(redraw wt_text 4)
(setvar "cmdecho" cm)
(princ msg)
)
(setq wt_text0(entsel"\n选择文本:"))
;(setq h(cdr (assoc 0 (entget(car wt_text0)))))
(while(or (= wt_text0 nil) (/= (cdr (assoc 0 (entget(car wt_text0)))) "TEXT") )
(setq wt_text0(entsel"\n选择文本:"))
)
(setq wt_text(car wt_text0))
(setq wt_textdata(entget wt_text))
;or (wt_text0 null)
(redraw wt_text 3)
(vl-cmdf "ucs" "e" wt_text)
(setq wt_box(textbox wt_textdata))
(setq wt_txpz1(car wt_box)
wt_txpz3(cadr wt_box)
)
; (setq wt_attext(vlax-ename->vla-object wt_text))
; (setq wt_ro(r2d (vla-get-rotationwt_attext)))
(vl-cmdf "xline" "v" wt_txpz1 "")
(setq wt_1(entlast))
(redraw wt_1 2)
(vl-cmdf "xline" "v" wt_txpz3 "")
(setq wt_2(entlast))
(redraw wt_2 2)
(redraw wt_text 4)
(vl-cmdf "trim" wt_1 wt_2 "" )
(vl-cmdf pause "")
;(prompt "\n请选择择修剪位置:")
;(setq wt_line0(entsel"\n修剪对象:"))
;(setq wt_line(car wt_line0))
;(setq wt_linedata(entget wt_line))
;(setq wt_n 0)
;(repeat (sslength wt_lines) () (setq wt_n(1+ wt_n)))
;(setq ent(ssname ss n))
(vl-cmdf "erase" wt_1 wt_2) cad中有个功能，使用文字可以修剪线，但是当文字与线之间的间距过大就失效，本程序想实现用文字能修剪任意线，但是在操作中遇到一个问题，就是如何使用pause实现多次选择修剪的位置，希望有大神能指点一二，本人新手，在论坛学习了一段时间，希望能多多指教。 本帖最后由 chenjieq1990 于 2017-9-15 09:32 编辑
(defun C:wt(/ cm wt_text0 wt_text wt_textdata wt_box wt_txpz1 wt_txpz3 wt_1 wt_2)
(vl-load-com)
; (defun r2d (r) (/ (* r 180.0) pi));弧度转角度
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(defun *error* (msg) ;错误处理
(vl-cmdf "" "")
(vl-cmdf "ucs" "")
(redraw wt_text 4)
(setvar "cmdecho" cm)
(princ msg)
)
(setq wt_text0(entsel"\n选择文本:"))
;(setq h(cdr (assoc 0 (entget(car wt_text0)))))
(while(or (= wt_text0 nil) (/= (cdr (assoc 0 (entget(car wt_text0)))) "TEXT") )
(setq wt_text0(entsel"\n选择文本:"))
)
(setq wt_text(car wt_text0))
(setq wt_textdata(entget wt_text))
;or (wt_text0 null)
(redraw wt_text 3)
(vl-cmdf "ucs" "e" wt_text)
(setq wt_box(textbox wt_textdata))
(setq wt_txpz1(car wt_box)
wt_txpz3(cadr wt_box)
)
; (setq wt_attext(vlax-ename->vla-object wt_text))
; (setq wt_ro(r2d (vla-get-rotationwt_attext)))
(vl-cmdf "xline" "v" wt_txpz1 "")
(setq wt_1(entlast))
;(redraw wt_1 2)
(vl-cmdf "xline" "v" wt_txpz3 "")
(setq wt_2(entlast))
;(redraw wt_2 2)
(redraw wt_text 4)
(vl-cmdf "trim" wt_1 wt_2 "" )
(vl-cmdf pause "")
;(prompt "\n请选择择修剪位置:")
;(setq wt_line0(entsel"\n修剪对象:"))
;(setq wt_line(car wt_line0))
;(setq wt_linedata(entget wt_line))
;(setq wt_n 0)
;(repeat (sslength wt_lines) () (setq wt_n(1+ wt_n)))
;(setq ent(ssname ss n))
(vl-cmdf "erase" wt_1 wt_2)(vl-cmdf "erase" "" "")
(vl-cmdf "ucs" "")
(setvar "cmdecho" cm)
(prin1)
)
建议合并修剪和延伸。。。 没理解我的意思，我是说如果一般先画线，再写文字（修改），有时候文字长了就延长下画线，文字短了就修剪下划线。只用一个命令来实现，而不是两个 这个是剪2条竖向的，能剪2条横向的吗 哦，不错，不错
页:
[1]