删除Dcl
;Tip1662c: POFFSET.LSP Piping Utilities (c)2000, Mitch Thaxter
(defun C:POFFSET ()
(setq OLD_BLIPMODE (getvar "blipmode"))
(setvar "blipmode" 0)
(setq FILE_FOUND_DCL (findfile "poffset.dcl"))
(if (= FILE_FOUND_DCL NIL)
(ANGLE_FILE_NOT_FOUND)
) ;_ end of if
(setq DCL_ID (load_dialog FILE_FOUND_DCL))
(if (not (new_dialog "poffset" DCL_ID))
(exit)
) ;_ end of if
(action_tile "cancel" "(exit)")
(action_tile "pipe_size" "(setq pipe_size $value)")
(if (= 1 (start_dialog))
(start_dialog)
(exit)
) ;_ end of if
;;;Nominal
(if (= PIPE_SIZE "0")
(setq PIPE_SIZE 0.405)
) ;_ end of if
;;;1/8"
(if (= PIPE_SIZE "1")
(setq PIPE_SIZE 0.540)
) ;_ end of if
;;;1/4"
(if (= PIPE_SIZE "2")
(setq PIPE_SIZE 0.675)
) ;_ end of if
;;;3/8"
(if (= PIPE_SIZE "3")
(setq PIPE_SIZE 0.840)
) ;_ end of if
;;;1/2"
(if (= PIPE_SIZE "4")
(setq PIPE_SIZE 1.050)
) ;_ end of if
;;;3/4"
(if (= PIPE_SIZE "5")
(setq PIPE_SIZE 1.315)
) ;_ end of if
;;; 1"
(if (= PIPE_SIZE "6")
(setq PIPE_SIZE 1.660)
) ;_ end of if
;;; 1 1/4"
(if (= PIPE_SIZE "7")
(setq PIPE_SIZE 1.900)
) ;_ end of if
;;; 1 1/2"
(if (= PIPE_SIZE "8")
(setq PIPE_SIZE 2.375)
) ;_ end of if
;;; 2"
(if (= PIPE_SIZE "9")
(setq PIPE_SIZE 2.875)
) ;_ end of if
;;; 2 1/2"
(if (= PIPE_SIZE "10")
(setq PIPE_SIZE 3.500)
) ;_ end of if
;;; 3"
(if (= PIPE_SIZE "11")
(setq PIPE_SIZE 4.000)
) ;_ end of if
;;; 3 1/2"
(if (= PIPE_SIZE "12")
(setq PIPE_SIZE 4.500)
) ;_ end of if
;;; 4"
(if (= PIPE_SIZE "13")
(setq PIPE_SIZE 5.563)
) ;_ end of if
;;; 5"
(if (= PIPE_SIZE "14")
(setq PIPE_SIZE 6.625)
) ;_ end of if
;;; 6"
(if (= PIPE_SIZE "15")
(setq PIPE_SIZE 8.625)
) ;_ end of if
;;; 8"
(if (= PIPE_SIZE "16")
(setq PIPE_SIZE 10.75)
) ;_ end of if
;;;10"
(if (= PIPE_SIZE "17")
(setq PIPE_SIZE 12.75)
) ;_ end of if
;;;12"
(setq DIST (/ PIPE_SIZE 2)
PICBOX ""
) ;_ end of setq
(princ "\nCurrent offset < ")
(princ DIST)
(setq ENT (entsel "\nSelect line: "))
(setq POINT (cadr ENT))
(setq SIDE (getpoint "\nSelect side: "))
(setq DIS1 (distance SIDE POINT))
(setq ANG (angle SIDE POINT))
(if (or (or (< ANG 0.78) (> ANG 5.5))
(and (> ANG 2.35) (< ANG 3.92))
) ;_ end of or
(setq ANG (- 0 ANG))
(setq ANG (- pi ANG))
) ;end if
(setq OTHER (polar POINT ANG DIST))
(command "offset" DIST ENT SIDE ENT OTHER "")
(prin1)
) ;_ end of defun
有人能告诉我如何取消对DCL的呼叫吗 这套粗俗的套路到底要做什么？
;Tip1662c: POFFSET.LSP Piping Utilities (c)2000, Mitch Thaxter
; Modified 11/17/08
(defun C:POFFSET (/ ANG DAT DIS1 DIST ENT OTHER PIPE_SIZE POINT SIDE)
(and
(setq PIPE_SIZE (getint "\nEnter Pipe Size: "))
(setq dat (assoc Pipe_size
'((00.405)
(10.540) ;1/4"
(20.675) ;3/8"
(30.840) ;1/2"
(41.050) ;3/4"
(51.315) ; 1"
(61.660) ; 1 1/4"
(71.900) ; 1 1/2"
(82.375) ; 2"
(92.875) ; 2 1/2"
(10 3.500) ; 3"
(11 4.000) ; 3 1/2"
(12 4.500) ; 4"
(13 5.563) ; 5"
(14 6.625) ; 6"
(15 8.625) ; 8"
(16 10.75) ;10"
(17 12.75) ;12"
)
)
)
(setq DIST (/ (cadr dat) 2.))
(princ "\nCurrent offset < ")
(princ DIST)
(setq ENT (entsel "\nSelect line: "))
(setq POINT (cadr ENT))
(setq SIDE (getpoint "\nSelect side: "))
(setq DIS1 (distance SIDE POINT))
(setq ANG (angle SIDE POINT))
(if (or (or (< ANG 0.78) (> ANG 5.5))
(and (> ANG 2.35) (< ANG 3.92))
) ;_ end of or
(setq ANG (- 0 ANG))
(setq ANG (- pi ANG))
) ;end if
(setq OTHER (polar POINT ANG DIST))
(command "offset" DIST ENT "non" SIDE ENT "non" OTHER "")
)
(prin1)
) ;_ end of defun 谢谢你的回复，我似乎无意中发现了很多模糊的例程，我使用了这个程序POFFSET，并且大小没有指定，我想我只是被这里的一些程序员和他们的帮助宠坏了。
;Tip1714:ATTUPDATE.LSP Attribute update (c)2001, Brian Iwaskewycz
(defun C:ATTUPDATE(/ NEXTENTTYPE ENTTYPE BLOCKNAME SSET ENTNAME
SELECTION FILENAME INDEX1 NEWBLOCKNAME MAINENTNAME
SUBENTNAME ATTLIST INSPOINT XSCALE YSCALE ZSCALE
ROTATION ENTDATA INDEX2 VALUE LOSSFLAG LAYERNAME)
(while (or (/= "ATTRIB" NEXTENTTYPE) (/= "INSERT" ENTTYPE))
(setq BLOCKNAME "")
(setq BLOCKNAME
(getstring
"\nEnter name of block to update or <ENTER> to select: "))
(if (/= "" BLOCKNAME)
(progn
(setq SSET
(ssget "x"
(list (cons 0 "INSERT") (cons 2 BLOCKNAME))))
(if SSET
(progn
(setq ENTNAME (ssname SSET 0))
(setq ENTTYPE (cdr (assoc 0 (entget ENTNAME))))
(if (entnext ENTNAME)
(setq NEXTENTTYPE
(cdr
(assoc 0
(entget (entnext ENTNAME)))))
(princ "\nThe selected block has no attributes.")
)
)
(progn
(princ (strcat "\nBlock name "
(strcase BLOCKNAME)
" not found."))
(setq NEXTENTYPE NIL
ENTTYPE NIL)
)
)
)
(progn
(setq SELECTION NIL)
(while (not SELECTION)
(setq SELECTION (entsel "\nSelect block to update:"))
)
(setq ENTNAME (car SELECTION))
(setq ENTTYPE (cdr (assoc 0 (entget ENTNAME))))
(if (entnext ENTNAME)
(setq NEXTENTTYPE
(cdr (assoc 0 (entget (entnext ENTNAME))))))
(if (/= "INSERT" ENTTYPE)
(princ "\nThe selected entity is not a block.")
(if (/= "ATTRIB" NEXTENTTYPE)
(princ "\nThe selected block has no attributes."))
)
)
)
)
(if (= "" BLOCKNAME)
(setq BLOCKNAME (cdr (assoc 2 (entget ENTNAME)))))
(setq SSET (ssget "x" (list (cons 0 "INSERT") (cons 2 BLOCKNAME))))
(princ (strcat "\n"
(itoa (sslength SSET))
" occurrence(s) of block "
(strcase BLOCKNAME)
" found.\n"))
(setq FILENAME (getfiled "Select New Block Name" "" "dwg" 0))
(setq INDEX1 (strlen FILENAME))
(while (/= "\\" (substr FILENAME INDEX1 1))
(setq INDEX1 (1- INDEX1))
)
(setq BLOCKNAME (strcase BLOCKNAME))
(setq NEWBLOCKNAME
(strcase (substr FILENAME
(1+ INDEX1)
(- (- (strlen FILENAME) INDEX1) 4))))
(setvar "attdia" 0)
(setvar "attreq" 0)
(setvar "cmdecho" 0)
(if (and (tblsearch "block" NEWBLOCKNAME)
(/= NEWBLOCKNAME BLOCKNAME))
(progn
(princ
(strcat "A block named "
NEWBLOCKNAME
" already exists.Using local copy instead."))
(command "insert" NEWBLOCKNAME "0,0,0" "" "" "")
)
(progn
(if (/= BLOCKNAME NEWBLOCKNAME)
(command "rename" "b" BLOCKNAME NEWBLOCKNAME))
(command "insert"
(strcat NEWBLOCKNAME "=" FILENAME)
"0,0,0"
""
""
"")
)
)
(setq MAINENTNAME (entlast))
(setq SUBENTNAME (entnext MAINENTNAME))
(while (= "ATTRIB" (cdr (assoc 0 (entget SUBENTNAME))))
(setq
ATTLIST (append ATTLIST
(list (cdr (assoc 2 (entget SUBENTNAME))))))
(setq SUBENTNAME (entnext SUBENTNAME))
)
(entdel MAINENTNAME)
(setvar "attreq" 1)
(setq INDEX1 0)
(command "ucs" "w")
(princ "\n")
(while (setq MAINENTNAME (ssname SSET INDEX1))
(setq SUBENTNAME (entnext MAINENTNAME))
(setq INSPOINT (cdr (assoc 10 (entget MAINENTNAME))))
(setq XSCALE (cdr (assoc 41 (entget MAINENTNAME))))
(setq YSCALE (cdr (assoc 42 (entget MAINENTNAME))))
(setq ZSCALE (cdr (assoc 43 (entget MAINENTNAME))))
(setq ROTATION
(* (/ 180.0 pi) (cdr (assoc 50 (entget MAINENTNAME)))))
(setq LAYERNAME (cdr (assoc 8 (entget MAINENTNAME))))
(while (= "ATTRIB"
(cdr (assoc 0 (setq ENTDATA (entget SUBENTNAME)))))
(set (read (cdr (assoc 2 ENTDATA))) (cdr (assoc 1 ENTDATA)))
(setq SUBENTNAME (entnext SUBENTNAME))
)
(setq INDEX2 0)
(command "insert" NEWBLOCKNAME INSPOINT "xyz" XSCALE YSCALE ZSCALE
ROTATION)
(while (< INDEX2 (length ATTLIST))
(setq VALUE (eval (read (nth INDEX2 ATTLIST))))
(if VALUE
(command VALUE)
(progn
(command "")
(setq LOSSFLAG t)
)
)
(set (read (nth INDEX2 ATTLIST)) NIL)
(setq INDEX2 (1+ INDEX2))
)
(entmod (subst (cons 8 LAYERNAME)
(assoc 8 (entget (entlast)))
(entget (entlast))))
(entdel MAINENTNAME)
(setq INDEX1 (1+ INDEX1))
(princ (strcat "\r"
(itoa INDEX1)
"/"
(itoa (sslength SSET))
" blocks updated."))
)
(command "ucs" "p")
(setvar "cmdecho" 1)
(setvar "attdia" 1)
(if LOSSFLAG
(princ
"\nWARNING! Due to non-identical tag names, some data may have been lost."))
(princ (strcat "\n"
(itoa (sslength SSET))
" occurrences of block "
BLOCKNAME
" updated successfully."))
(if (/= BLOCKNAME NEWBLOCKNAME)
(princ (strcat "\nBlock was renamed to " NEWBLOCKNAME ".")))
(princ)
)
(princ "ATTUPDATE ver 1.0 loaded.")
(princ)
此代码用于区域，想知道它是否过期？你能帮我做这个吗？
页:
[1]