NCOPY命令怎么在Lisp中调用

13816600495 · 发表于 2023-8-8 13:54:32

想调用NCOPY命令如下：
(setq ent (entsel))
(command-s "NCOPY" (car ent) "" pause pause "")
无效！

请问ent是什么类型数据才可被识别？

start4444 · 发表于 2023-8-8 14:10:29

不是命令
(c:ncopy)

kozmosovia · 发表于 2023-8-8 14:22:47

直接C:Ncopy估计很难控制执行。最好还是SendCommand模拟command

li_fang_2008 · 发表于 2023-8-8 15:01:27

本帖最后由 li_fang_2008 于 2023-8-8 15:02 编辑

这段代码的目的是选择一个实体对象，并使用NCOPY命令对其进行复制操作。

然而，command-s函数使用的是字符串参数，而不是LISP表达式。在此代码中，你可能意图将(car ent)作为实体对象的ID传递给NCOPY命令，但是它被视为一个字符串而不是一个LISP表达式。

(setq ent (entsel))
(command-s (strcat "NCOPY " (itoa (car ent))) "" "pause" "pause" "")

masterlong · 发表于 2023-8-8 18:51:36

(itoa (car ent))) ？

lee50310 · 发表于 2023-8-9 08:51:37

本帖最后由 lee50310 于 2023-8-11 06:31 编辑

by lee-mac
選擇物體==> 原地複製
執行指令: nc

(defun c:nc nil
(command "_.ncopy" "\\" "" "_non" '(0 0) "_non" '(0 0))
(princ)
)

dcl1214 · 发表于 2023-8-10 11:14:33

(defun $ncopy-block$ (ent    lst /    blk    en
      lx    ly lz    make-anonymous-block
      mark    mat mat:mxm    mat:mxv  mat:trp
      mxm    mxv new    news    obj
      ownrobj  parent ref    refgeom  sclmat
      sx    sy sz    trp    trsmat
      vararray->list vv    vx    vy
      vz    km-bmd
      )
;块内图元复制到块外
  ;; RefGeom (gile)
  ;; Returns a list whose first item is a 3x3 transformation matrix and
  ;; second item the object insertion point in its parent (xref, block or space)
  (defun refgeom (ent / ang enx mat ocs)
(and ent
   (setq enx (entget ent))
   (setq ang (cdr (assoc 050 enx)))
   (setq ocs (cdr (assoc 210 enx)))
)
(list
   (setq mat
      (mxm
         (mapcar '(lambda (v) (trans v 0 ocs t))
         '((1.0 0.0 0.0)
   (0.0 1.0 0.0)
   (0.0 0.0 1.0)
)
         )
         (mxm
   (list
   (list (cos ang) (- (sin ang)) 0.0)
   (list (sin ang) (cos ang) 0.0)
   '(0.0 0.0 1.0)
   )
   (list
   (list (cdr (assoc 41 enx)) 0.0 0.0)
   (list 0.0 (cdr (assoc 42 enx)) 0.0)
   (list 0.0 0.0 (cdr (assoc 43 enx)))
   )
         )
      )
   )
   (mapcar
'-
(trans (cdr (assoc 10 enx)) ocs 0)
(mxv mat
      (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx)))))
)
   )
)
  )
  (defun VarArray->List (vaobj)
(vlax-SafeArray->List
   (vlax-Variant-Value vaobj)
)
  )
  ;; Matrix Transpose  -  Doug Wilson
  ;; Args: m - nxn matrix
  (defun trp (m)
(apply 'mapcar (cons 'list m))
  )
  ;; Matrix x Matrix  -  Vladimir Nesterovsky
  ;; Args: m,n - nxn matrices
  (defun mxm (m n)
((lambda (a) (mapcar '(lambda (r) (mxv a r)) m)) (trp n))
  )
  ;; Matrix x Vector  -  Vladimir Nesterovsky
  ;; Args: m - nxn matrix, v - vector in R^n
  (defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
  )
;;;-----------------------------------------------------------;;
;;; 矩阵转置                                                 ;;
;;; MAT:trp Transpose a matrix -Doug Wilson-                ;;
;;;-----------------------------------------------------------;;
  (defun MAT:trp (m)
(apply 'mapcar (cons 'list m))
  )
;;;-----------------------------------------------------------;;
;;; 向量的矩阵变换(向量乘矩阵)                               ;;
;;; Matrix x Vector - Vladimir Nesterovsky                   ;;
;;; Args: m - nxn matrix, v - vector in R^n                ;;
;;;-----------------------------------------------------------;;
  (defun MAT:mxv (m v)
(mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
      m
)
  )
;;;-----------------------------------------------------------;;
;;; 矩阵相乘                                                 ;;
;;; MAT:mxm Multiply two matrices -Vladimir Nesterovsky-    ;;
;;;-----------------------------------------------------------;;
  (defun MAT:mxm (m q)
(mapcar (function (lambda (r) (MAT:mxv (MAT:trp q) r))) m)
  )
;;;-----------------------------------------------------------;;
;;; 匿名块程序                                              ;;
;;;-----------------------------------------------------------;;
  (defun make-anonymous-block (obj / BLKOBJ origin bkName *space)
(if obj
   (progn
(setq origin (vlax-3d-point '(0.0 0.0 0.0)))
(setq blkobj
         (vla-add (vla-get-blocks
   (vla-get-activedocument (vlax-get-acad-object))
)
origin
"*U"
         )
)
(setq bkName (vla-get-name blkobj))
(vlax-invoke
   (vla-get-activedocument (vlax-get-acad-object))
   'copyobjects
   (list obj)
   blkobj
)
(if (zerop (vla-get-ActiveSpace
      (vla-get-activedocument (vlax-get-acad-object))
   )
      )
   (setq
      *space (vla-get-PaperSpace
      (vla-get-activedocument (vlax-get-acad-object))
   )
   )
   (setq
      *space (vla-get-modelspace
      (vla-get-activedocument (vlax-get-acad-object))
   )
   )
)
(vla-insertblock *space origin bkName 1 1 1 0)
   )
)
blkobj
  )
  (if (and ent
   (= (type ent) 'ename)
   (= (CDR (ASSOC 0 (ENTGET ENT))) "INSERT")
   )
(PROGN
   (setq
mark (VLAX-VLA-OBJECT->ENAME
         (VLA-ADDPOINT
   (vla-get-ModelSpace
   (vla-get-ActiveDocument
      (vlax-get-acad-object)
   )
   )
   (VLAX-3D-POINT (LIST 0 0 0))
         )
      )
   ) ;获取最后一个图元作为标记位
   (progn
(setvar 'errno 0)
(IF (= 'ename (type ent))
   (PROGN
      (setq obj (vlax-ename->vla-object ent))
      (progn
      (setq mat
      (vlax-tmatrix
         (apply
   (function
   (lambda (mat vec)
      (append (mapcar 'append mat (mapcar 'list vec))
      '((0.0 0.0 0.0 1.0))
      )
   )
   )
   (refgeom ent)
         )
      )
      )
      (setq vv (reverse (cdr (reverse (varArray->List mat)))))
;去掉第四行(0 0 0 1)
      (setq vX (mapcar 'car vv)) ;X 向量
      (setq vY (mapcar 'cadr vv)) ;Y 向量
      (setq vZ (mapcar 'caddr vv)) ;Z 向量
      (setq lX (distance vX '(0 0 0))) ;X 比例因子
      (setq lY (distance vY '(0 0 0))) ;Y 比例因子
      (setq lZ (distance vZ '(0 0 0))) ;Z 比例因子
      (vlax-for obj (vla-item (vla-get-blocks
(vla-get-activedocument
   (vlax-get-acad-object)
)
      )
      (vla-get-name obj)
      )
(setq ssss (cons obj ssss))
      )
      (if (setq km-bmd (cdr (assoc "块名" lst))) ;块名白名单
(setq
   ssss (vl-remove-if-not
   (function
   (lambda (a / km)
      (and (setq km ($获取块名$ a))
   (vl-some (function (lambda (c)
         (wcmatch km c)
      )
   )
   km-bmd
   )
      )
   )
   )
   ssss
         )
)
      )
      (if ssss
(foreach obj ssss
   (if (and (equal lX lY 1e-17) (equal lY lZ 1e-17))
;如果是均匀缩放
      (progn
      (setq
OwnrObj (vla-get-Modelspace
   (vla-get-activedocument
      (vlax-get-acad-object)
   )
)
      )
      (if (not (vl-catch-all-error-p
   (vl-catch-all-apply
   'vlax-invoke
   (list
      (vla-get-activedocument
         (vlax-get-acad-object)
      )
      'copyobjects
      (list obj)
      OwnrObj
   )
   )
         )
   )
(progn
   (setq
      new (vlax-ename->vla-object (entlast))
   )
   (vla-transformby new mat)
)
      )
      )
      (progn
      (and
(setq blk (make-anonymous-block obj))
;先做一个匿名图块
(setq ref (vlax-ename->vla-object (entlast)))
;插入块参照
      )
      (and lx (setq sX (/ 1 lx)))
;非均匀缩放则要取得各个比例值
      (and lY (setq sY (/ 1 lY)))
      (and lZ (setq sZ (/ 1 lZ)))
      (and sX
   sy
   sz
   (setq sclMat (list (list sX 0 0 1)
;乘以一个比例缩放矩阵使得比例均匀
      (list 0 sY 0 1)
      (list 0 0 sZ 1)
      (list 0 0 0 1)
)
   )
      )
      (setq
trsmat (MAT:mxm (varArray->List mat) sclMat)
      ) ;得到一个均匀缩放的变换矩阵
      (vla-transformby ref (vlax-tmatrix trsmat))
;变换参照
      ;;最后需要变换回去
      (vl-catch-all-apply
'vla-put-xscalefactor
(list
   ref
   (* (vla-get-xscalefactor ref) lX)
)
      )
      (vl-catch-all-apply
'vla-put-yscalefactor
(list
   ref
   (* (vla-get-yscalefactor ref) lY)
)
      )
      (vl-catch-all-apply
'vla-put-zscalefactor
(list
   ref
   (* (vla-get-zscalefactor ref) lZ)
)
      )
      (vl-catch-all-apply
'vlax-put
(list ref 'insertionpoint (mapcar 'last vv))
      )
      (if
(> (atof (getvar 'acadver)) 19.1)
   (IF ref
   ((ZX:COMMAND-S)
      "_.explode"
      (vlax-vla-object->ename ref)
   )
   )
   (vl-cmdf "_.explode"
   (vlax-vla-object->ename ref)
   )
      )
;炸开匿名块参照
      (vla-delete blk) ;删除匿名块定义
      )
   )
)
      )
      )
   )
)
   )
   (progn
(setq NEWS nil)
(setq en mark)
(while (setq en (entnext en))
   (setq NEWS (cons en NEWS))
)
(SETQ NEWS (VL-REMOVE NIL NEWS))
(setq parent nil)
(setq NEWS
         (mapcar
   (function (lambda (a)
      (cond
         ((and
   (= (cdr (assoc 0 (entget a))) "SEQEND")
   (cdr (assoc -2 (entget a)))
)
(set 'parent (cdr (assoc -2 (entget a))))
nil
         )
         ((and
   parent
   (= (cdr (assoc 5 (entget a)))
      (cdr (assoc 5 (entget parent)))
   )
)
(set 'parent nil)
a
         )
         ((AND parent)
nil
         )
         (t a)
      )
   )
   )
   NEWS
         )
)
(ENTDEL mark)
(setq NEWS (reverse (vl-remove nil NEWS)))
(setq
   NEWS (vl-remove-if-not
   (function (lambda (a) (entget a)))
   NEWS
         )
)
   )
)
  )
  NEWS
)

嘒彼小星 · 发表于 2023-8-10 15:53:37

nco的话用nentsel这个函数试试就是把(setq ent (entsel))这个换成(setq ent (nentsel))

chenyizhen28 · 发表于 2023-12-12 13:26:23

li_fang_2008 发表于 2023-8-8 15:01
这段代码的目的是选择一个实体对象，并使用NCOPY命令对其进行复制操作。

然而，command-s函数使用的是字 ...

这方法我用一次后，后面就没办法执行了，啥情况。

tensir · 发表于 2024-7-10 13:19:41

感谢作者的分享！

账号		自动登录	找回密码
密码			注册

[提问] NCOPY命令怎么在Lisp中调用

点评

评分

点评

评分