[求助]动态生成SOLID(无痕大师,没捕捉呀)

userzhl

(DEFUN c:aa ( / boolean code ent motion pt1 pt2 pt4 ptbase)
  (COMMAND ".UCS" "W")
  (setvar "osmode" 767)
(defun get_point( / ptbase)
(setq ptbase (GETCORNER PT1 "\n另一角点 :"))
)
(SETQ PT1 (GETPOINT "\n建柱子左下角点 :"))
(setq boolean t)
(while boolean
(setq motion (grread t 15 0))
(setq code (car motion))
(setq ptbase (cadr motion))
(cond
((= code 5)
(SETQ
 T2 (LIST (CAR PT1) (CADR ptbase))
 T4 (LIST (CAR ptbase) (CADR PT1))
  )
(setq ent (list (cons 0 "SOLID")
(cons 10 pt1) (cons 11 pt2) (cons 12 pt4) (cons 13 ptbase) (cons 62 256)
))
(entmake ent)
(entupd (entlast))
)
((= code 3)
(setq boolean nil)
)
((= code 11)
(entdel (cdr (assoc -1 ent)))
(setq boolean nil)
)
)
)
  (COMMAND ".UCS" "P")
  (PRINC)
)
;动态生成SOLID，如何让这个程在点取后才生成物体？并且为何捕捉会没了？

userzhl

怎么没人来帮我看看的呢？

无痕

(DEFUN c:aa (/ boolean code ent motion pt1 pt2 pt4 ptbase)
  (COMMAND ".UCS" "W")
  (setvar "osmode" 767)
  (defun get_point (/ ptbase)
    (setq ptbase (GETCORNER PT1 "\n另一角点 :"))
  )
  (SETQ PT1 (GETPOINT "\n建柱子左下角点 :"))
  (setq boolean t)
  (while boolean
    (setq motion (grread t 15 0))
    (setq code (car motion))
    (setq ptbase (cadr motion)
   ptx ptbase)
    (cond
      ((= code 5)
        (if ee (entdel ee))
 (SETQ
   PT2 (LIST (CAR PT1) (CADR ptbase))
   PT4 (LIST (CAR ptbase) (CADR PT1))
 )
 (if (equal ptx pt2 1e-2)
   nil
   (progn (setq ent (list (cons 0 "SOLID")
     (cons 10 pt1)
     (cons 11 pt2)
     (cons 12 pt4)
     (cons 13 ptbase)
     (cons 62 256)
      )
   )
   (entmake ent)
   (entupd (setq ee (entlast)))
   )
 )
      )
      ((= code 3)
       (setq boolean nil)
      )
      ((= code 11)
       (if ee (entdel ee))
       (setq boolean nil)
      )
    )
  )
  (COMMAND ".UCS" "P")
  (PRINC)
)

userzhl

谢谢无痕!

userzhl

无痕大师,但是我试了一下,为何鼠标移动时没有,没捕捉呀

无痕

因为原程序用了ｇｒｒｅａｄ函数，这个函数会自动关闭捕捉．

有变通的办法（已经有源码发布－－不是我），可以在明经或ｘｄｃａｄ搜索一下．标题记不清了

userzhl

无痕兄,你说的是不是下面这个?但如何使用到我的那段LSP里去呢?

;;  Grread+osnap+GRVECS
;;  Rewritten by Fools @ TheSwamp.org
;;  
;;  Use (grread) to get original point
;;  Use (osnap) to calculate accurate point
;;  Use (GRVECS) to show AutoSnapMarker
;;  No return , just show the method

(DEFUN c:tmp (/              AUTOSNAPMARKERCOLOR          AUTOSNAPMARKERSIZE
          DRAG          GHOSTPT          LST_OSMODE      STR_OSMODE      TIME
          DistPerPixel    Bold          Draftobj          get_osmode      YPY_StrParse
          YPY_GetGrvecs   YPY_DrawVecs
         )
  ;;  CAB  10/5/2006
  ;;  Fools change a little about ","  (3/3/2007)
  ;;
  ;;  Function to return the current osmode setting in the form of a string
  ;;  If (getvar "osmode") = 175
  ;;  (get_osmode)  returns   "_end,_mid,_cen,_nod,_int,_per"  
  (DEFUN get_osmode (/ cur_mode mode$)
    (SETQ mode$ "")
    (IF    (< 0 (SETQ cur_mode (GETVAR "osmode")) 16383)
      (MAPCAR (FUNCTION    (LAMBDA    (x)
              (IF (NOT (ZEROP (LOGAND cur_mode (CAR x))))
                (IF    (ZEROP (STRLEN mode$))
                  (SETQ mode$ (CADR x))
                  (SETQ mode$ (STRCAT mode$ "," (CADR x)))
                )
              )
            )
          )
          '((1 "_end")
        (2 "_mid")
        (4 "_cen")
        (8 "_nod")
        (16 "_qua")
        (32 "_int")
        (64 "_ins")
        (128 "_per")
        (256 "_tan")
        (512 "_nea")
        (1024 "_qui")
        (2048 "_app")
        (4096 "_ext")
        (8192 "_par")
           )
      )
    )
    mode$
  )
  ;;My functions
  (DEFUN YPY_StrParse (str delim / ptr lst)
    (WHILE (SETQ ptr (VL-STRING-SEARCH delim str))
      (SETQ lst (CONS (SUBSTR str 1 ptr) lst))
      (SETQ str (SUBSTR str (+ ptr 2)))
   )
  (REVERSE (CONS str lst))
)
  (DEFUN YPY_GetGrvecs (pt dragpt lst / KEY)
    (SETQ key T)
    (WHILE (AND key lst)
      (IF (EQUAL (OSNAP dragpt (CAR lst)) pt 1E-6)
    (SETQ key nil)
    (SETQ lst (CDR lst))
      )
    )
    (CDR (ASSOC    (CAR lst)
        '(("_end"
           ((-1 1) (-1 -1))
           ((-1 -1) (1 -1))
           ((1 -1) (1 1))
           ((1 1) (-1 1))
          )            ;square
          ("_mid"
           ((0 1.414) (-1.225 -0.707))
           ((-1.225 -0.707) (1.225 -0.707))
           ((1.225 -0.707) (0 1.414))
          )            ;triangle
          ("_cen"
           ((0 1) (-0.707 0.707))
           ((-0.707 0.707) (-1 0))
           ((-1 0) (-0.707 -0.707))
           ((-0.707 -0.707) (0 -1))
           ((0 -1) (0.707 -0.707))
           ((0.707 -0.707) (1 0))
           ((1 0) (0.707 0.707))
           ((0.707 0.707) (0 1))
          )            ;circle
          ("_nod"
           ((0 1) (-0.707 0.707))
           ((-0.707 0.707) (-1 0))
           ((-1 0) (-0.707 -0.707))
           ((-0.707 -0.707) (0 -1))
           ((0 -1) (0.707 -0.707))
           ((0.707 -0.707) (1 0))
           ((1 0) (0.707 0.707))
           ((0.707 0.707) (0 1))
           ((-1 1) (1 -1))
           ((-1 -1) (1 1))
          )            ;circle+cross
          ("_qua"
           ((0 1.414) (-1.414 0))
           ((-1.414 0) (0 -1.414))
           ((0 -1.414) (1.414 0))
           ((1.414 0) (0 1.414))
          )            ;square rotate 45
          ("_int"
           ((-1 1) (1 -1))
           ((-1 -1) (1 1))
           ((1 0.859) (-0.859 -1))
           ((-1 0.859) (0.859 -1))
           ((0.859 1) (-1 -0.859))
           ((-0.859 1) (1 -0.859))
          )            ;cross
          ("_ins"
           ((-1 1) (-1 -0.1))
           ((-1 -0.1) (0 -0.1))
           ((0 -0.1) (0 -1.0))
           ((0 -1.0) (1 -1))
           ((1 -1) (1 0.1))
           ((1 0.1) (0 0.1))
           ((0 0.1) (0 1.0))
           ((0 1.0) (-1 1))
          )            ;two squares
          ("_per"
           ((-1 1) (-1 -1))
           ((-1 -1) (1 -1))
           ((0 -1) (0 0))
           ((0 0) (-1 0))
          )            ;half square
          ("_tan"
           ((0 1) (-0.707 0.707))
           ((-0.707 0.707) (-1 0))
           ((-1 0) (-0.707 -0.707))
           ((-0.707 -0.707) (0 -1))
           ((0 -1) (0.707 -0.707))
           ((0.707 -0.707) (1 0))
           ((1 0) (0.707 0.707))
           ((0.707 0.707) (0 1))
           ((1 1) (-1 1))
          )            ;circle+line
          ("_nea"
           ((-1 1) (1 -1))
           ((1 -1) (-1 -1))
           ((-1 -1) (1 1))
           ((1 1) (-1 1))
          )            ;two triangle
          ("_qui")        ; ???
          ("_app"
           ((-1 1) (-1 -1))
           ((-1 -1) (1 -1))
           ((1 -1) (1 1))
           ((1 1) (-1 1))
           ((-1 1) (1 -1))
           ((-1 -1) (1 1))
          )            ;square+cross
          ("_ext"
           ((0.1 0) (0.13 0))
           ((0.2 0) (0.23 0))
           ((0.3 0) (0.33 0))
          )            ;three points
          ("_par" ((0 1) (-1 -1)) ((1 1) (0 -1))) ;two lines
         )
     )
    )
  )
  ;;Use GRVECS
  (DEFUN YPY_DrawVecs (Pt Vecs Size Color / lst matrix)
    ;;no Z axis
    (SETQ matrix (LIST (LIST Size 0.0 0.0 (CAR pt))
               (LIST 0.0 Size 0.0 (CADR pt))
               (LIST 0.0 0.0 1.0 0.0)
               (LIST 0.0 0.0 0.0 1.0)
         )
    )
    (SETQ lst (MAPCAR 'CONS
              (MAPCAR (FUNCTION (LAMBDA (x) Color)) Vecs)
              Vecs
          )
    )
    (GRVECS (APPLY 'APPEND lst) matrix)
  )
  ;;****************************
  ;;  Main Routine starts here  
  ;;****************************
  (VL-LOAD-COM)
  (SETQ time T)
  (SETQ str_osmode (get_osmode))
  (SETQ lst_osmode (YPY_StrParse str_osmode ","))
  (SETQ    Draftobj (VLA-GET-DRAFTING
           (VLA-GET-PREFERENCES (VLAX-GET-ACAD-OBJECT))
         )
  )
  (SETQ AutoSnapMarkerSize (VLA-GET-AUTOSNAPMARKERSIZE Draftobj))
  (SETQ AutoSnapMarkerColor (VLA-GET-AUTOSNAPMARKERCOLOR Draftobj))
  (WHILE time
    (grread (SETQ drag (GRREAD T 1 1))) ;;Can change like (grread T 15 2)
    (COND ((= (CAR drag) 5)
       (REDRAW)
       (SETQ drag (CADR drag))
       (IF (or (zerop (strlen str_osmode)) (NULL (SETQ ghostpt (OSNAP drag str_osmode))))
         (SETQ ghostpt drag)
         ;;Beacuse of mouse middle button scroll , calculate "DistPerPixel" every time
         (PROGN (SETQ DistPerPixel (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE"))))
            ;;Bold
            (SETQ Bold (MAPCAR '*
                       (LIST DistPerPixel DistPerPixel DistPerPixel)
                       (LIST (+ AutoSnapMarkerSize 0.5)
                         AutoSnapMarkerSize
                         (- AutoSnapMarkerSize 0.5)
                       )
                   )
            )
            (FOREACH item Bold
              (YPY_DrawVecs
            ghostpt
            (YPY_GetGrvecs ghostpt drag lst_osmode)
            item
            AutoSnapMarkerColor
              )
            )
         )
       )
      )
      ((= (CAR drag) 3)
       (IF (NULL (SETQ ghostpt (OSNAP (CADR drag) (get_osmode))))
         (SETQ ghostpt (CADR drag))
       )
       (REDRAW)
       (SETQ time nil)
      )
    )
  )
  (PRINC) ;can return ghostpt if want
)