dennylaw163 发表于 2021-4-21 08:42:37

关于输入或选取的问题

请大师帮忙看看下面程序中第63行可否改为选取一个块,而不是程序要求的输入块名。


[*](defun c:cme ( / *error* _StartUndo _EndUndo _SelectIf _IsCurveObject acdoc al bl d0 di en mx nm pt )
[*]
[*](defun *error* ( msg )
[*]    (if acdoc (_EndUndo acdoc))
[*]    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
[*]      (princ (strcat "\n** Error: " msg " **")))
[*]    (princ)
[*])
[*]
[*](defun _StartUndo ( doc ) (_EndUndo doc)
[*]    (vla-StartUndoMark doc)
[*])
[*]
[*](defun _EndUndo ( doc )
[*]    (if (= 8 (logand 8 (getvar 'UNDOCTL)))
[*]      (vla-EndUndoMark doc)
[*]    )
[*])
[*]
[*](defun _SelectIf ( msg pred func / sel ) (setq pred (eval pred))
[*]    (while
[*]      (progn (setvar 'ERRNO 0) (setq sel (car (func msg)))
[*]      (cond
[*]          ( (= 7 (getvar 'ERRNO))
[*]            (princ "\nMissed, Try again.")
[*]          )
[*]          ( (eq 'ENAME (type sel))
[*]            (if (and pred (not (pred sel)))
[*]            (princ "\nInvalid Object Selected.")
[*]            )
[*]          )
[*]      )
[*]      )
[*]    )
[*]    sel
[*])
[*]
[*](defun _IsCurveObject ( entity / param )
[*]    (and
[*]      (not
[*]      (vl-catch-all-error-p
[*]          (setq param
[*]            (vl-catch-all-apply 'vlax-curve-getendparam (list entity))
[*]          )
[*]      )
[*]      )
[*]      param
[*]    )
[*])
[*]
[*](setq acdoc (vla-get-activedocument (vlax-get-acad-object))
[*]      nm    (trans '(0. 0. 1.) 1 0 t)
[*])
[*](if (setq en (_SelectIf "\nSelect Object to Measure: " '_isCurveObject entsel))
[*]    (progn
[*]      (initget 7 "Block")
[*]      (setq di (getdist "\nSpecify length of segment or : "))
[*]
[*]      (if (eq "Block" di)
[*]      (progn
[*]          (while
[*]
[*]            (progn (setq bl (getstring t "\nEnter name of block to insert: "))
[*]
[*]            (cond
[*]                ( (not (snvalid bl))
[*]                  (princ "\nInvalid block name.")
[*]                )
[*]                ( (not (tblsearch "BLOCK" bl))
[*]                  (princ (strcat "\nCannot find block \"" bl "\"."))
[*]                )
[*]            )
[*]            )
[*]          )
[*]          (initget "Yes No")
[*]          (setq al (not (eq "No" (getkword "\nAlign block with object? <Y>: "))))
[*]          (initget 7)
[*]          (setq di (getdist "\nSpecify length of segment: "))
[*]      )
[*]      )
[*]      (setq mx (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
[*]            d0 (- (/ (- mx (* di (fix (/ mx di)))) 2.) di)
[*]      )
[*]      (_StartUndo acdoc)
[*]      (while (and (<= (setq d0 (+ d0 di)) mx) (setq pt (vlax-curve-getpointatdist en d0)))
[*]      (if bl
[*]          (entmakex
[*]            (list
[*]            (cons 0 "INSERT")
[*]            (cons 2 bl)
[*]            (cons 10 (trans pt 0 nm))
[*]            (cons 50
[*]                (if al
[*]                  (angle '(0. 0. 0.)
[*]                  (trans
[*]                      (vlax-curve-getfirstderiv en (vlax-curve-getparamatpoint en pt)) 0 nm
[*]                  )
[*]                  )
[*]                  0.
[*]                )
[*]            )
[*]            (cons 210 nm)
[*]            )
[*]          )
[*]
[*]          (entmakex (list (cons 0 "POINT") (cons 10 pt)))
[*]
[*]      )
[*]      )
[*]      (_EndUndo acdoc)
[*]    )
[*]
[*]    (princ "\n*Cancel*")
[*])
[*](princ)
[*])
[*](vl-load-com) (princ)

dennylaw163 发表于 2021-4-21 11:45:06

终于还是靠自己想出来了，居中画孔的命令，需要的拿去用。

;;-------------------=={ Centered Measure }==-----------------;;

(defun c:cme ( / *error* _StartUndo _EndUndo _SelectIf _IsCurveObject acdoc al holeD bl d0 di en mx nm pt )

(defun *error* ( msg )
    (if acdoc (_EndUndo acdoc))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
    (princ)
)

(defun _StartUndo ( doc ) (_EndUndo doc)
    (vla-StartUndoMark doc)
)

(defun _EndUndo ( doc )
    (if (= 8 (logand 8 (getvar 'UNDOCTL)))
      (vla-EndUndoMark doc)
    )
)

(defun _SelectIf ( msg pred func / sel ) (setq pred (eval pred))
    (while
      (progn (setvar 'ERRNO 0) (setq sel (car (func msg)))
      (cond
          ( (= 7 (getvar 'ERRNO))
            (princ "\nMissed, Try again.")
          )
          ( (eq 'ENAME (type sel))
            (if (and pred (not (pred sel)))
            (princ "\nInvalid Object Selected.")
            )
          )
      )
      )
    )
    sel
)

(defun _IsCurveObject ( entity / param )
    (and
      (not
      (vl-catch-all-error-p
          (setq param
            (vl-catch-all-apply 'vlax-curve-getendparam (list entity))
          )
      )
      )
      param
    )
)

(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
      nm    (trans '(0. 0. 1.) 1 0 t)
)
       
       
        (setq holeD (getdist (strcat "\nSpecify diameter of holes <" "5" ">")))
        (if (= holeD nil) (setq holeD 5))
               
               
(if (setq en (_SelectIf "\nSelect Object to Measure: " '_isCurveObject entsel))
    (progn
      (initget 7 "Block")
      (setq di (getdist "\nSpecify Center to Center distance or : "))
      
      (if (eq "Block" di)
      (progn
          (while
                                               
            (progn (setq bl (vla-get-effectivename (vlax-ename->vla-object (car(entsel "\nSelect block to segment:")))))
                                                       
                                                       
                                                       
            (cond
                ( (not (snvalid bl))
                  (princ "\nInvalid block name.")
                )
                ( (not (tblsearch "BLOCK" bl))
                  (princ (strcat "\nCannot find block \"" bl "\"."))
                )
            )
            )
          )
          (initget "Yes No")
          (setq al (not (eq "No" (getkword "\nAlign block with object? <Y>: "))))
          (initget 7)
          (setq di (getdist "\nSpecify Center to Center distance: "))
      )
      )
      (setq mx (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
            d0 (- (/ (- mx (* di (fix (/ mx di)))) 2.) di)
      )
      (_StartUndo acdoc)
      (while (and (<= (setq d0 (+ d0 di)) mx) (setq pt (vlax-curve-getpointatdist en d0)))
      (if bl
          (entmakex
            (list
            (cons 0 "INSERT")
            (cons 2 bl)
            (cons 10 (trans pt 0 nm))
            (cons 50
                (if al
                  (angle '(0. 0. 0.)
                  (trans
                      (vlax-curve-getfirstderiv en (vlax-curve-getparamatpoint en pt)) 0 nm
                  )
                  )
                  0.
                )
            )
            (cons 210 nm)
            )
          )
                                       
                                       
                                       
          (entmake (list '(0 . "CIRCLE") (cons 10 pt) (cons 40 (/ holeD 2))))
                                       
      )
      )
      (_EndUndo acdoc)
    )
       
    (princ "\n*Cancel*")
)
(princ)
)
(vl-load-com) (princ)

;;------------------------------------------------------------;;
;;                         End of File                        ;;
;;------------------------------------------------------------;;

845245015 发表于 2021-4-21 11:42:54


(defun c:cme ( / *error* _StartUndo _EndUndo _SelectIf _IsCurveObject acdoc al bl d0 di en mx nm ptlzr)
(defun *error* ( msg )
    (if acdoc (_EndUndo acdoc))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
    (princ)
)
(defun _StartUndo ( doc ) (_EndUndo doc)
    (vla-StartUndoMark doc)
)
(defun _EndUndo ( doc )
    (if (= 8 (logand 8 (getvar 'UNDOCTL)))
      (vla-EndUndoMark doc)
    )
)
(defun _SelectIf ( msg pred func / sel ) (setq pred (eval pred))
    (while
      (progn (setvar 'ERRNO 0) (setq sel (car (func msg)))
      (cond
          ( (= 7 (getvar 'ERRNO))
            (princ "\nMissed, Try again.")
          )
          ( (eq 'ENAME (type sel))
            (if (and pred (not (pred sel)))
            (princ "\nInvalid Object Selected.")
            )
          )
      )
      )
    )
    sel
)
(defun _IsCurveObject ( entity / param )
    (and
      (not
      (vl-catch-all-error-p
          (setq param
            (vl-catch-all-apply 'vlax-curve-getendparam (list entity))
          )
      )
      )
      param
    )
)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
      nm    (trans '(0. 0. 1.) 1 0 t)
)
(if (setq en (_SelectIf "\nSelect Object to Measure: " '_isCurveObject entsel))
    (progn
      (initget 7 "Block")
      (setq di (getdist "\nSpecify length of segment or : "))
      (if (eq "Block" di)
      (progn
          (while
            (progn
            ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
            ;没有测试图，不知道是否可行以下为修改部分
            ;(setq bl (getstring t "\nEnter name of block to insert: "))
            (print "请选择图块")
            (setq bl (vla-get-effectivename (vlax-ename->vla-object (car(entsel)))))
            ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
            (cond
                ( (not (snvalid bl))
                  (princ "\nInvalid block name.")
                )
                ( (not (tblsearch "BLOCK" bl))
                  (princ (strcat "\nCannot find block \"" bl "\"."))
                )
            )
            )
          )
          (initget "Yes No")
          (setq al (not (eq "No" (getkword "\nAlign block with object? <Y>: "))))
          (initget 7)
          (setq di (getdist "\nSpecify length of segment: "))
      )
      )
      (setq mx (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
            d0 (- (/ (- mx (* di (fix (/ mx di)))) 2.) di)
      )
      (_StartUndo acdoc)
            ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
            ;以下为修改部分
            (setq lzr (getreal "请输入半径:"))
            ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      (while (and (<= (setq d0 (+ d0 di)) mx) (setq pt (vlax-curve-getpointatdist en d0)))
      (if bl
          (entmakex
            (list
            (cons 0 "INSERT")
            (cons 2 bl)
            (cons 10 (trans pt 0 nm))
            (cons 50
                (if al
                  (angle '(0. 0. 0.)
                  (trans
                      (vlax-curve-getfirstderiv en (vlax-curve-getparamatpoint en pt)) 0 nm
                  )
                  )
                  0.
                )
            )
            (cons 210 nm)
            )
          )
          (entmake (list '(0 . "CIRCLE") (cons 10 pt) (cons 40 lzr)))
      )
      )
      (_EndUndo acdoc)
    )
    (princ "\n*Cancel*")
)
(princ)
)
(vl-load-com) (princ)

845245015 发表于 2021-4-21 09:03:02

(defun c:cme ( / *error* _StartUndo _EndUndo _SelectIf _IsCurveObject acdoc al bl d0 di en mx nm pt )
(defun *error* ( msg )
    (if acdoc (_EndUndo acdoc))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
    (princ)
)
(defun _StartUndo ( doc ) (_EndUndo doc)
    (vla-StartUndoMark doc)
)
(defun _EndUndo ( doc )
    (if (= 8 (logand 8 (getvar 'UNDOCTL)))
      (vla-EndUndoMark doc)
    )
)
(defun _SelectIf ( msg pred func / sel ) (setq pred (eval pred))
    (while
      (progn (setvar 'ERRNO 0) (setq sel (car (func msg)))
      (cond
          ( (= 7 (getvar 'ERRNO))
            (princ "\nMissed, Try again.")
          )
          ( (eq 'ENAME (type sel))
            (if (and pred (not (pred sel)))
            (princ "\nInvalid Object Selected.")
            )
          )
      )
      )
    )
    sel
)
(defun _IsCurveObject ( entity / param )
    (and
      (not
      (vl-catch-all-error-p
          (setq param
            (vl-catch-all-apply 'vlax-curve-getendparam (list entity))
          )
      )
      )
      param
    )
)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
      nm    (trans '(0. 0. 1.) 1 0 t)
)
(if (setq en (_SelectIf "\nSelect Object to Measure: " '_isCurveObject entsel))
    (progn
      (initget 7 "Block")
      (setq di (getdist "\nSpecify length of segment or : "))
      (if (eq "Block" di)
      (progn
          (while
            (progn
              ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
              ;没有测试图，不知道是否可行以下为修改部分
              ;(setq bl (getstring t "\nEnter name of block to insert: "))
              (print "请选择图块")
              (setq bl (vla-get-effectivename (vlax-ename->vla-object (car(entsel)))))
              ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
            (cond
                ( (not (snvalid bl))
                  (princ "\nInvalid block name.")
                )
                ( (not (tblsearch "BLOCK" bl))
                  (princ (strcat "\nCannot find block \"" bl "\"."))
                )
            )
            )
          )
          (initget "Yes No")
          (setq al (not (eq "No" (getkword "\nAlign block with object? <Y>: "))))
          (initget 7)
          (setq di (getdist "\nSpecify length of segment: "))
      )
      )
      (setq mx (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
            d0 (- (/ (- mx (* di (fix (/ mx di)))) 2.) di)
      )
      (_StartUndo acdoc)
      (while (and (<= (setq d0 (+ d0 di)) mx) (setq pt (vlax-curve-getpointatdist en d0)))
      (if bl
          (entmakex
            (list
            (cons 0 "INSERT")
            (cons 2 bl)
            (cons 10 (trans pt 0 nm))
            (cons 50
                (if al
                  (angle '(0. 0. 0.)
                  (trans
                      (vlax-curve-getfirstderiv en (vlax-curve-getparamatpoint en pt)) 0 nm
                  )
                  )
                  0.
                )
            )
            (cons 210 nm)
            )
          )
          (entmakex (list (cons 0 "POINT") (cons 10 pt)))
      )
      )
      (_EndUndo acdoc)
    )
    (princ "\n*Cancel*")
)
(princ)
)
(vl-load-com) (princ)

dennylaw163 发表于 2021-4-21 09:44:52

845245015 发表于 2021-4-21 09:03
(defun c:cme ( / *error* _StartUndo _EndUndo _SelectIf _IsCurveObject acdoc al bl d0 di en mx nm pt...

试了下，行了，谢谢！

第106行，现程序的用点分段，可否实现用指定直径或半径的圆来分，也就是点的位置改为圆。

烟盒迷唇 发表于 2021-4-21 10:10:18

换圆很简单的吧，这都不会

dennylaw163 发表于 2021-4-21 10:32:09

烟盒迷唇 发表于 2021-4-21 10:10
换圆很简单的吧，这都不会

(entmake (list '(0 . "CIRCLE") (cons 10 pt) (cons 40 r))

不是不会，是想把r的地方换成手输

dennylaw163 发表于 2021-4-21 11:15:43

(entmake (list '(0 . "CIRCLE") (cons 10 pt) (cons 40 (getreal "请输入半径:"))))

换成这句了可以手输半径了，但要输很多次，何解

dennylaw163 发表于 2021-4-21 17:20:42

845245015 发表于 2021-4-21 11:42
(defun c:cme ( / *error* _StartUndo _EndUndo _SelectIf _IsCurveObject acdoc al bl d0 di en mx nm p ...


我加在前面去了

dennylaw163 发表于 2021-4-21 18:05:03

845245015 发表于 2021-4-21 11:42
(defun c:cme ( / *error* _StartUndo _EndUndo _SelectIf _IsCurveObject acdoc al bl d0 di en mx nm p ...

选了插入块之后还是要求输入孔的半径，应该是选了块后就不用问了才对啊
页: [1] 2
查看完整版本: 关于输入或选取的问题