AutoLisp 源代码 实用程序1

(defun c:1 ( / 1a 1b 1c 1d chklay do va vx)

(setvar "OSMODE" 1024)

(setq chklay (tblsearch "layer" "FL"))

(if (null chklay)

(command "layer" "n" "FL" "c" "161" "FL" "")

)

(setq va (getvar "lunits"))

(if (= va 2)

(progn

(setq do 20000)

(SETQ VX 1))

)

(if (= va 4)

(progn

(setq do 800)

(SETQ VX 0.03937))

)

(setq 1a '(0 0 0))

(setq 1b (polar 1a 0 do))

(setq 1c (polar 1b (* pi 0.5) do))

(setq 1d (polar 1a (* pi 0.5) do))

(command "pline" 1a 1b 1c 1d 1a "")

(command "chprop" (entlast) "" "la" "FL" "")

(command "insert" "STR BLOCK" '(0 0 0) VX VX 0)

(setvar "OSMODE" 1279)

(prin1)

)

(defun c:dxff (/ ent)

(setq a1 (car (entsel)))

(setq b1 (entget a1 (list "*")))

)

;;;(defun c:e(/ cmd_ent cmd_sel cmd_no)

;;; (setq cmd_ent (cadr (ssgetfirst)))

;;; (cond ((= nil cmd_ent)

;;; (setq cmd_sel (ssget))

;;; (setq cmd_no (sslength cmd_sel))

;;; (command "_.erase" cmd_sel "")

;;; (alert (strcat "Total **** "

;;; (rtos cmd_no 2 0)

;;; " **** Deleted"

;;; "\nTotal **** "

;;; (rtos cmd_no 2 0)

;;; " **** Deleted"

;;; "\nTotal **** "

;;; (rtos cmd_no 2 0)

;;; " **** Deleted"

;;; )

;;; )

;;; )

;;; ((/= nil cmd_ent)

;;; (setq cmd_no (sslength cmd_ent))

;;; (command "_.erase")

;;; (alert (strcat "Total **** "

;;; (rtos cmd_no 2 0)

;;; " **** Deleted"

;;; "\nTotal **** "

;;; (rtos cmd_no 2 0)

;;; " **** Deleted"

;;; "\nTotal **** "

;;; (rtos cmd_no 2 0)

;;; " **** Deleted"

;;; )

;;; )

;;; )

;;; )

;;; (princ)

;;; )

;***************************************************************************************************************************************************

;;;(defun c:m (/ cmd_ent cmd_sel cmd_no cmd_dist cmd_pt cmd_pt1)

;;; (setq cmd_ent (cadr (ssgetfirst)))

;;; (if (= nil cmd_ent)

;;; (setq cmd_sel (ssget))

;;; (setq cmd_sel cmd_ent)

;;; )

;;; (setq cmd_no (sslength cmd_sel))

;;; (princ (strcat (rtos cmd_no 2 0) " Found By Elvis"))

;;; (command "move"

;;; cmd_sel

;;; ""

;;; (setq

;;; cmd_pt (getpoint

;;; "\nSpecify base point or [Displacement] <Displacement>: " ;;; )

;;; )

;;; pause

;;; )

;;; (setq cmd_pt1 (getvar "lastpoint"))

;;; (setq cmd_dist (distance cmd_pt cmd_pt1))

;;; (alert (strcat "Total **** "

;;; (rtos cmd_no 2 0)

;;; " **** Moved"

;;; "\n"

;;; "\nStartPoint **** ("

;;; (rtos (car cmd_pt) 2 4)

;;; ", "

;;; (rtos (cadr cmd_pt) 2 4)

;;; ", "

;;; (rtos (caddr cmd_pt) 2 4)

;;; " )****"

;;; "\n"

;;; "\nEndPoint **** ("

;;; (rtos (car cmd_pt1) 2 4)

;;; ", "

;;; (rtos (cadr cmd_pt1) 2 4)

;;; ", "

;;; (rtos (caddr cmd_pt1) 2 4)

;;; " )****"

;;; "\n"

;;; "\nDistance **** "

;;; (rtos cmd_dist 2 4)

;;; " **** "

;;; )

;;; )

;;;

;;; (Propak_Str_Elvis cmd_sel a "MOVE")

;;; (princ)

;;;)

;;;(defun c:co ( / cmd_copyent cmd_dist cmd_ent cmd_entlast cmd_no cmd_pt cmd_pt1 cmd_sel)

;;; (SETQ A (GETVAR "OSMODE"))

;;; (setq cmd_ent (cadr (ssgetfirst)))

;;; (if (= nil cmd_ent)

;;; (setq cmd_sel (ssget))

;;; (setq cmd_sel cmd_ent)

;;; )

;;; (setq cmd_no (sslength cmd_sel))

;;; (princ (strcat (rtos cmd_no 2 0) " Found By Elvis"))

;;; (setq cmd_pt

;;; (getpoint

;;; "\nSpecify second point or [Array] <use first point as displacement>:" ;;; )

;;; )

;;; (while t

;;; (setq cmd_copyent (ssadd))

;;; (setq cmd_entlast (entlast))

;;; (command "copy" cmd_sel "" cmd_pt pause)

;;; (setq cmd_pt1 (getvar "lastpoint"))

;;; (setq cmd_dist (distance cmd_pt cmd_pt1))

;;;

;;; (while (if (= cmd_entlast nil) nil (setq cmd_entlast (entnext cmd_entlast))) ;;; (if (member (cdr (assoc 0 (entget cmd_entlast)))

;;; '("LINE" "CIRCLE" "LWPOLYLINE"

;;; "TEXT" "3DSOLID" "ELLIPSE"

;;; "ARC" "DIMENSION" "LEADER"

;;; "POLYLINE" "MTEXT" "INSERT"

;;; )

;;; )

;;; (setq cmd_copyent (ssadd cmd_entlast cmd_copyent))

;;; ))

;;;

;;; (alert (strcat "Total **** "

;;; (rtos cmd_no 2 0)

;;; " **** Copy"

;;; "\n"

;;; "\nStartPoint **** ("

;;; (rtos (car cmd_pt) 2 4)

;;; ", "

;;; (rtos (cadr cmd_pt) 2 4)

;;; ", "

;;; (rtos (caddr cmd_pt) 2 4)

;;; " )****"

;;; "\n"

;;; "\nEn …… 此处隐藏：8236字，全部文档内容请下载后查看。喜欢就下载吧 ……