如何剪切穿过文本的线段？

congcong · 发表于 2004-3-1 20:37:00

一个尺寸标注加上公差值后，且这个标注还是斜的，怎么用它来剪切穿过它的线段
具体要求如图所示
这个程序较麻烦，想看看各位有没有更简单的方法来实现这个功能

2stm2lboiyc.jpg

lee1892 · 发表于 2004-3-2 00:55:00

试试这个，写得简单了点:)

meflying · 发表于 2004-3-2 09:07:00

选择时要选择标注的文本。。。
(defun c:test( / ent ent_dim ents pt_lst ang_txt height pt pt1 pt2 ptCenter dist ang pt_w1 pt_w2 pt_w3 pt_w4 os)
   (setq os (getvar "osmode"))
   (setq ent (nentsel))
   (setq ent_dim (car (last ent)))
   (setq ent (car ent))
   (setq ents (entget ent))
   (setq pt_lst (textbox (list (cons 0 "TEXT")
   (assoc 1 ents)
   (assoc 40 ents)
)
   )
   )
   (setq ang_txt (cdr (assoc 50 ents)))
   (setq height (/ (cdr (assoc 40 ents)) 5.0))
   (setq pt (cdr (assoc 10 ents)))
   (setq pt1 (car pt_lst))
   (setq pt2 (cadr pt_lst))
   (setq ptCenter (list (/ (+ (car pt1) (car pt2)) 2.0) (/ (+ (cadr pt1) (cadr pt2)) 2.0)))
   (setq pt2 (list (+ (car pt2) height) (+ (cadr pt2) (* 2.0 height))))
   (setq dist (distance ptCenter pt2))
   (setq ang (angle pt2 ptCenter))
   (setq pt_w1 (polar pt (- (+ ang_txt pi) ang) dist))
   (setq pt_w2 (polar pt (+    ang_txt ang) dist))
   (setq pt_w3 (polar pt (- ang_txt ang) dist))
   (setq pt_w4 (polar pt (+ ang_txt pi ang) dist))
   (setvar "osmode" 0)
   (setvar "cmdecho" 0)
   (command "_.wipeout" "f" "off")
   (command "_.wipeout" pt_w1 pt_w2 pt_w3 pt_w4 "")
   (entdel ent_dim)
   (entdel ent_dim)
   (setvar "osmode" os)
   (princ)
)

congcong · 发表于 2004-3-2 10:08:00

谢谢各位，程序都不错，不过三楼的程序如果用在倾斜的文本上的时候出现的状况不如人意，能否改善？
我就是拿倾斜的且带有公差的文本没有办法，请大家帮忙。

meflying · 发表于 2004-3-2 10:31:00

你要如何才如人意？

4mw5uzqugin.JPG

bgnzkkhri3u.JPG

meflying · 发表于 2004-3-2 10:48:00

(setq pt2 (list (+ (car pt2) height) (+ (cadr pt2) (* 2.0 height))))
此句中后面(* 2.0 ...中的2.0可以适当改大，以达到有公差时的要求（大概要到4—5左右比较合适）

龙龙仔 · 发表于 2004-3-2 12:30:00

;;-----------------------C:MaskDimText------------------------------------
;;Command to place a WIPEOUT behind selected DIMENSION text (one entity)
;;© 2001 Herman Mayfarth
;;Tested with AutoCAD Release 14.01
;;Not tested with R15
;;修改 By 龍龍仔(LUCAS)
;;Only tested with R16
;;Not tested with R14
;;Known limitations:
;; 1. This routine works by asking the user to select a nested MTEXT object,
;; and uses that object's entity data to define the WIPEOUT boundary.
;; If you have dimension text stacked over/under the dimension line,
;; i.e. using the \X code, this routine will _not_ mask all the text,
;; since the over/under text are separate MTEXT entities.
;; (A better & more sophisticated way would be to walk through the
;; DIMENSION block & determine the bounding box of all MTEXT objects in the
;; block, but this is a Q & D 1st attempt)
;; 2. In R14.01, on my system, if the DIMENSION has been moved or copied,
;; the WIPEOUT is incorrectly placed at the *original* location of
;; the MTEXT object.(???) Don't know why, at this point.
;;
;; Feel free to modify to suit your own needs &/or whims.
;;------------------------------------------------------------------------
;;global function
;;test function to see if wipeout.arx is available
(defun WIPEOUTP ()
   (if (> (atoi (getvar "AcadVer")) 15)
   (arxload "acwipeout" NIL)
   (arxload "wipeout" NIL)
   )
) ;wipeoutp
;;
(defun C:MASKDIMTEXT (/ CECHO OLDLYR ENT FLAG OUTER BOXMTEXT LWRECT)
   ;;local functions
;;;--------------------boxmtext-------------------------------------
;;; Purpose: draws a lwpolyline rectangle to enclose an MTEXT entity
;;; Parameter: entity name of MTEXT entity
;;; External function: lwrect to draw the rectangle
;;;-----------------------------------------------------------------
   (defun BOXMTEXT (ENAME    /    MTXTNT P10    H    ANG1    DELTA
   D1    BOXANG BOXDIA ATTACH VEC    P1    P3
   HOR    VERT
   )
   (setq MTXTNT (entget ENAME)
   P10    (cdr (assoc 10 MTXTNT))
   H    (cdr (assoc 40 MTXTNT))
   HOR    (cdr (assoc 42 MTXTNT))
   VERT    (cdr (assoc 43 MTXTNT))
   ANG1    (cdr (assoc 50 MTXTNT))
   ATTACH (cdr (assoc 71 MTXTNT))
   VEC    (getvar "UCSXDIR")
   ANG1    (+ (atan (cadr VEC) (car VEC)) ANG1)
   DELTA    (/ H 2) ;adjust as req'd
   D1    (+ HOR (* 2 DELTA))
   BOXANG (atan (+ VERT (* 2 DELTA)) D1)
   BOXDIA (* (/ 1 (cos BOXANG)) D1)
   ) ;setq
   (cond ((= ATTACH 1) ;top left
   (setq P1 (polar P10 (+ (/ (* 3 pi) 2) ANG1) (+ VERT DELTA)))
   )
   ((= ATTACH 2) ;top center
   (setq P1
   (polar (polar P10 (+ pi ANG1) (/ HOR 2))
   (+ (/ (* 3 pi) 2) ANG1)
   (+ VERT DELTA)
   )
   )
   )
   ((= ATTACH 3) ;top right
   (setq P1
   (polar (polar P10 (+ pi ANG1) HOR)
   (+ (/ (* 3 pi) 2) ANG1)
   (+ VERT DELTA)
   )
   )
   )
   ((= ATTACH 4) ;middle left
   (setq
   P1 (polar P10 (+ (/ (* 3 pi) 2) ANG1) (+ (/ VERT 2) DELTA))
   )
   )
   ((= ATTACH 5) ;middle center
   (setq P1
   (polar (polar P10 (+ pi ANG1) (/ HOR 2))
   (+ (/ (* 3 pi) 2) ANG1)
   (+ (/ VERT 2) DELTA)
   )
   )
   )
   ((= ATTACH 6) ;middle right
   (setq P1
   (polar (polar P10 (+ pi ANG1) HOR)
   (+ (/ (* 3 pi) 2) ANG1)
   (+ (/ VERT 2) DELTA)
   )
   )
   )
   ((= ATTACH 7) ;bottom left
   (setq P1 (polar P10 (+ (/ (* 3 pi) 2) ANG1) DELTA))
   )
   ((= ATTACH 8) ;bottom center
   (setq P1
   (polar (polar P10 (+ pi ANG1) (/ HOR 2))
   (+ (/ (* 3 pi) 2) ANG1)
   DELTA
   )
   )
   )
   ((= ATTACH 9) ;bottom right
   (setq P1
   (polar (polar P10 (+ pi ANG1) HOR)
   (+ (/ (* 3 pi) 2) ANG1)
   DELTA
   )
   )
   )
   ) ;cond
   (setq
   P1 (polar P1 (+ pi ANG1) DELTA)
   P3 (polar P1 (+ BOXANG ANG1) BOXDIA)
   ) ;setq
   (LWRECT P1 P3 ANG1 (getvar "CLAYER") 256 (getvar "CELTYPE"))
   ) ;boxmtext
;;;-------------------------lwrect------------------------------------
;;; Purpose: draws a lightweight polyline rectangle
;;; Params: p1,p3 - WCS points at opposite corners
;;; rotate - rotation angle of selected axis in radians
;;; layer, color, ltype what they say
;;; Returns: EAL of entity
   (defun LWRECT (P1 P3 ROTATE LAYER COLOR LTYPE / D13 ABOX P2 P4 ELIST)
   (setq D13    (distance P1 P3)
   ABOX (- (angle P1 P3) ROTATE)
   P2    (polar P1 ROTATE (* (cos ABOX) D13))
   P4    (polar P1 (+ ROTATE (/ pi 2)) (* (sin ABOX) D13))
   )
   (entmake (list '(0 . "LWPOLYLINE")
   '(100 . "AcDbEntity")
   '(100 . "AcDbPolyline")
   (cons 6 LTYPE)
   (cons 8 LAYER)
   '(43 . 0)
   (cons 62 COLOR)
   '(90 . 4)
   (cons 10 P1)
   (cons 10 P2)
   (cons 10 P3)
   (cons 10 P4)
   '(70 . 1) ;closed pline - must follow G.C. 10s
   )
   )
   ) ;lwrect
   ;;Main program
   ;;if wipeout.arx is available
   (if (WIPEOUTP)
   ;;proceed
   (progn
   ;;save sysvars
   (setq CECHO    (getvar "CMDECHO")
   OLDLYR (getvar "CLAYER")
   )
   ;;start UNDO group
   (command "_.UNDO" "BEGIN")
   ;;setup a layer for WIPEOUTs
   (command "_.LAYER" "M" "WIPEOUTS" "")
   ;;loop until an MTEXT entity in a DIMENSION is selected
   (setq FLAG t)
   (while FLAG
(setq ALIST (nentsel "\nSelect Dimension Text to Mask: ")
   ENT    (car ALIST)
   OUTER (car (last ALIST))
)
(if (= "MTEXT" (cdr (assoc 0 (entget ENT))))
   (setq FLAG NIL)
)
   ) ;while
   ;;draw a LWPOLYLINE rectangle enclosing the MTEXT
   (BOXMTEXT ENT)
   ;;call command to draw the WIPEOUT using the preceding LWPOLYLINE
   (command "_.wipeout" "f" "off" "_.wipeout" "p" (entlast) "y")
   ;;now call draworder to bring the DIMENSION to the front
   ;;it would be nice if there is a better way, that doesn't force a regen
   ;;the only sure way I can think of is to delete the DIMENSION and remake it
   (command "_.draworder" OUTER "" "front") ;causes a regen
   ;;restore sysvars & end UNDO group
   (setvar "CLAYER" OLDLYR)
   (command "_.UNDO" "END")
   (setvar "CMDECHO" CECHO)
   ) ;progn
   (alert "Wipeouts Not Available.")
   ) ;if
   (princ)
) ;C:MaskDimText

meflying · 发表于 2004-3-2 14:44:00

改进了一下，主要是我发现标注中的文本都是居中对齐的，不知道是不是都这样的。。。

copy


(defun c:test( / ent ent_dim ents pt_lst ang_txt height pt width dist ang pt_w1 pt_w2 pt_w3 pt_w4 os)
   (setq os (getvar "osmode"))
   (setq ent (nentsel))
   (setq ent_dim (car (last ent)))
   (setq ent (car ent))
   (setq ents (entget ent))
   (setq pt_lst (textbox (list (cons 0 "TEXT")
                 (assoc 1 ents)
                 (assoc 40 ents)
      )
               )
   )
   (setq ang_txt (cdr (assoc 50 ents)))
   (setq pt (cdr (assoc 10 ents)))
   (setq height (cdr (assoc 43 ents)))
   (setq width (cdr (assoc 42 ents)))
   (setq height (* height 1.2))
   (setq width (* width 1.2))
   (setq ang (atan (/ height width)))
   (setq dist (/ (sqrt (+ (expt height 2) (expt width 2))) 2.0))
   (setq pt_w1 (polar pt (- (+ ang_txt pi) ang) dist))
   (setq pt_w2 (polar pt (+   ang_txt ang) dist))
   (setq pt_w3 (polar pt (- ang_txt ang) dist))
   (setq pt_w4 (polar pt (+ ang_txt pi ang) dist))
   (setvar "osmode" 0)
   (setvar "cmdecho" 0)
   (command "_.wipeout" "f" "off")
   (command "_.wipeout" pt_w1 pt_w2 pt_w3 pt_w4 "")
   (entdel ent_dim)
   (entdel ent_dim)
   (setvar "osmode" os)
   (princ)
)

congcong · 发表于 2004-3-2 15:44:00

谢谢，改进后的程序没有问题了。

xjjy · 发表于 2004-9-28 11:16:00

其实并不是真正剪切，这个很好，
如果要恢复，要如何做？

如何剪切穿过文本的线段？

发表回复

精选推荐