求帮助修改一个框选剪切程序
有时候线段两边不齐，一般都是做辅助线剪切点，我的想法是直接画矩形修剪掉，好不容易“拼”好了程序，从左往右剪切没有问题，但从右往左不行，容易留下一个尾巴，求完善！谢谢高手;========== angle stuff ==============;Convert angle in degrees to radians
(defun dtr (a) (* pi (/ a 180.0)))
; Convert value in radians to degrees
(defun RTD (r) (* 180.0 (/ r pi)))
;============================
;MAIN ROUTINE
;============================
(defun C:CLIP ( / sblip scmde
@pt1 @pt2 @pt3 @pt4 xpt1 xpt2 fp1 fp2 fp3 fp4
en ans anshelp ang sblip scmde en en1
ansclip screen ang os cclip inspoint grpcnt)
;setup
(setq sblip (getvar "blipmode"))
(setq scmde (getvar "cmdecho"))
(setvar "blipmode" 0)(princ)
(setvar "cmdecho" 0)(princ)
(command "_.osnap" "off")
(if (= grpcnt nil)(setq grpcnt 0) )
;get points
(prompt "Enter ")
(setq @pt1 (getpoint "1st Point :"))
(setq @pt2 (getcorner @pt1 "\n2nd Point :"))
;Break List of points in x y parts
(setq xpt1 (car @pt1) ypt1 (cadr @pt1))
(setq xpt2 (car @pt2) ypt2 (cadr @pt2))
;Set Trim/Fence Points inside Pline Boundary
(if (= xpt1 xpt2)(quit))
;=============================================================
;;Set PTS if lower left picked first
(cond ((and (< xpt1 xpt2)(< ypt1 ypt2))
(progn
(setq fp1 (list (+ xpt1 0.03125)(+ ypt1 0.03125)))
(setq fp2 (list (- xpt2 0.03125)(+ ypt1 0.03125)))
(setq fp3 (list (- xpt2 0.03125)(- ypt2 0.03125)))
(setq fp4 (list (+ xpt1 0.03125)(- ypt2 0.03125)))
;;;;;Set Points to draw PLINE or RECTANGLE Boundary
(setq @pt2 (list xpt2 ypt1))
(setq @pt3 (list xpt2 ypt2))
(setq @pt4 (list xpt1 ypt2))
;;;;;Set OFFSET ANGLE
(setq ang (dtr (angle @pt1 @pt3) ) )
);end progn
));end cond1
;=============================================================
;;Set PTS if Upper left picked first
(cond ((and (< xpt1 xpt2)(> ypt1 ypt2))
(progn
(setq fp1 (list (+ xpt1 0.03125)(- ypt1 0.03125)))
(setq fp2 (list (+ xpt1 0.03125)(+ ypt2 0.03125)))
(setq fp3 (list (- xpt2 0.03125)(+ ypt2 0.03125)))
(setq fp4 (list (- xpt2 0.03125)(- ypt1 0.03125)))
;;;;;Set Points to draw PLINE or RECTANGLE Boundary
(setq @pt2 (list xpt2 ypt1))
(setq @pt3 (list xpt2 ypt2))
(setq @pt4 (list xpt1 ypt2))
;;;;;Set OFFSET ANGLE
(setq ang (dtr (* -1 (angle @pt1 @pt3) ) ) )
);end progn
));end cond2
;=============================================================
;;Set PTS if Lower Right picked first
(cond ((and (> xpt1 xpt2)(< ypt1 ypt2))
(progn
(setq fp1 (list (- xpt1 0.03125)(+ ypt1 0.03125)))
(setq fp2 (list (- xpt1 0.03125)(- ypt2 0.03125)))
(setq fp3 (list (+ xpt2 0.03125)(- ypt2 0.03125)))
(setq fp4 (list (+ xpt2 0.03125)(+ ypt1 0.03125)))
;;;;;Set Points to draw PLINE or RECTANGLE Boundary
(setq @pt2 (list xpt2 ypt1))
(setq @pt3 (list xpt2 ypt2))
(setq @pt4 (list xpt1 ypt2))
;;;;;Set OFFSET ANGLE
(setq ang (dtr (angle @pt1 @pt3) ) )
);end progn
));end cond3
;=============================================================
;;Set PTS if Upper Right picked first
(cond ((and (> xpt1 xpt2)(> ypt1 ypt2))
(progn
(setq fp1 (list (- xpt1 0.03125)(- ypt1 0.03125)))
(setq fp2 (list (- xpt2 0.03125)(- ypt1 0.03125)))
(setq fp3 (list (- xpt2 0.03125)(+ ypt2 0.03125)))
(setq fp4 (list (- xpt1 0.03125)(+ ypt2 0.03125)))
;;;;;Set Points to draw PLINE or RECTANGLE Boundary
(setq @pt2 (list xpt2 ypt1))
(setq @pt3 (list xpt2 ypt2))
(setq @pt4 (list xpt1 ypt2))
;;;;;Set OFFSET ANGLE
(setq ang (dtr (angle @pt1 @pt3) ) )
);end progn
));end cond4
;=============================================================
;Draw Trim to Boundary
(command "_.rectang" @pt1 @pt3)
;Get PLINE/REC OUTSIDE Boundary to delete later
(setq en (entlast))
(command "offset" 1 en (polar '(0.0 0.0) ANG 0.001)"")
;Get PLINE/REC INSIDE Boundary to delete later
(setq en1 (entlast))
;Use TRIM with FENCE to BREAK geometry - repeat 4 times
(repeat 4
(command "_.trim" "" "F" fp3 fp4 ""
"F" fp2 fp3 ""
"F" fp1 fp2 ""
"F" fp1 fp4 "" "")
);end repeat
(command "_.erase" en1 "")
(command "_.erase" en "")
;==============================================================
;==============================================================
;Set UCS to WORLD
(command "_.ucs" "W")
(setvar "blipmode" sblip)(princ)
(setvar "cmdecho" scmde)(princ)
(terpri)
(terpri)
(terpri)
(PRINC "\nCLIP")(princ)
页:
[1]