[原创]：SOME USEFUL VLISP PROGRAMS

KERRYWM

;;;SOME SAMPLES
;;;TO DRAW A CIRCLE IN MODEL SPACE
(DEFUN C:CHO()
  (SETVAR "CMDECHO" 0)
  (VL-LOAD-COM)
  (SETQ ADD(VLAX-GET-ACAD-OBJECT))
  (SETQ ADT(VLA-GET-ACTIVEDOCUMENT ADD))
  (SETQ MSPACE(VLA-GET-MODELSPACE ADT))
  (SETQ P1(LIST 0 0 0 ))
  (SETQ CPT(VLAX-3D-POINT P1))
  (SETQ RA 50)
  (VLA-ADDCIRCLE MSPACE CPT RA)
  (PROMPT "HELLO WORLD!")
  (PRINC)
  )
;;;TO DRAW A LIGHTWEIGHTPOLYLINE IN MODEL SPACE
(DEFUN C:TB()
  (VL-LOAD-COM)
  (SETQ ADD(VLAX-GET-ACAD-OBJECT))
  (SETQ ADT(VLA-GET-ACTIVEDOCUMENT ADD))
  (SETQ MSPACE(VLA-GET-MODELSPACE ADT))
  (SETQ PT(VLAX-MAKE-SAFEARRAY VLAX-VBDOUBLE '(0 . 7)))
  (VLAX-SAFEARRAY-FILL PT '(10 10  10 40  40 40  40 10 ))
  (SETQ PL(VLA-ADDLIGHTWEIGHTPOLYLINE MSPACE PT))
  (IF (= (VLA-GET-CLOSED PL) :VLAX-FALSE)
    (VLA-PUT-CLOSED PL :VLAX-TRUE)
    )
  (VLA-REGEN ADT :VLAX-TRUE)
  (VLA-ZOOMEXTENTS ADD)
  (PRINC)
  )
;;;TO MAKE A BLOCK IN MODEL SPACE
(DEFUN WBLOCK()
  (VL-LOAD-COM)
  (SETQ ADD(VLAX-GET-ACAD-OBJECT))
  (SETQ ADT(VLA-GET-ACTIVEDOCUMENT ADD))
  (SETQ MSPACE(VLA-GET-MODELSPACE ADT))
  ;;;;RAY
  (SETQ BASEPNT(VLAX-3D-POINT (LIST 30 30 0)))
  (SETQ SECONPNT(VLAX-3D-POINT (LIST 10 30 0)))
  (SETQ RAYOBJ(VLA-ADDRAY MSPACE BASEPNT SECONPNT))
  ;;;POLYLINE
  (SETQ PNTS(VLAX-MAKE-SAFEARRAY VLAX-VBDOUBLE '(0 . 5)))
  (VLAX-SAFEARRAY-FILL PNTS '(30 70 90 20 30 50))
  (SETQ PLINEOBJ(VLA-ADDLIGHTWEIGHTPOLYLINE MSPACE PNTS))
  (VLA-PUT-CLOSED PLINEOBJ :VLAX-TRUE)
  ;;;LINE
  (SETQ STARTPNT(VLAX-3D-POINT(LIST 0 0 0)))
  (SETQ ENDPNT(VLAX-3D-POINT(LIST 20 20 0)))
  (SETQ LINEOBJ(VLA-ADDLINE MSPACE STARTPNT ENDPNT))
  ;;;CIRCLE
  (SETQ CENTERPNT(VLAX-MAKE-SAFEARRAY VLAX-VBDOUBLE '(0 . 2)))
  (VLAX-SAFEARRAY-FILL CENTERPNT '(20 30 0))
  (SETQ RADIUS 30)
  (SETQ CIRCLEOBJ(VLA-ADDCIRCLE MSPACE CENTERPNT RADIUS))
  ;;;ELLIPSE
  (SETQ CENTER(VLAX-MAKE-SAFEARRAY VLAX-VBDOUBLE '(0 . 2)))
  (VLAX-SAFEARRAY-FILL CENTER '(50 50 0))
  (SETQ MAJAXIS(VLAX-MAKE-SAFEARRAY VLAX-VBDOUBLE '(0 . 2)))
  (VLAX-SAFEARRAY-FILL MAJAXIS '(100 200 0))
  (SETQ RADRATIO 0.3)
  (SETQ ELLOBJ(VLA-ADDELLIPSE MSPACE CENTER MAJAXIS RADRATIO))
  (VLA-ZOOMEXTENTS ADD)
  (SETQ SSETOBJ(VLA-ADD (VLA-GET-SELECTIONSETS ADT) "WBLOCKSET"))
  (SETQ OBJINMODELSPACE(VLAX-MAKE-SAFEARRAY VLAX-VBOBJECT (CONS 0 (- (VLA-GET-COUNT MSPACE) 1))))
  (SETQ I 0)
  (REPEAT (VLA-GET-COUNT MSPACE)
    (VLAX-SAFEARRAY-PUT-ELEMENT OBJINMODELSPACE I (VLA-ITEM MSPACE I))
    (SETQ I (1+ I))
    )
  (VLA-ADDITEMS SSETOBJ OBJINMODELSPACE)
  (VLA-WBLOCK ADT "C:\\AUTOCAD\\WBLOCK_EXAMPLE.DWG" SSETOBJ)
  (PRINC)
  )
;;;PLEASE GIVE ME SOME ADVICE.THANKS A LOT!

舟自横

CAN YOU TELL ME WHAT'S YOUR MOTHERLAND?
CAN YOU SPEAK CHINESE?

啵浪鼓

呵呵,不要再问他来自哪了,论坛上写着:
来自shenzhen guang dong (广东深圳)