NCOPY命令怎么在Lisp中调用
想调用NCOPY命令如下：
(setq ent (entsel))
(command-s "NCOPY" (car ent) "" pause pause "")
无效！
请问ent是什么类型数据才可被识别？
不是命令
(c:ncopy) 直接C:Ncopy估计很难控制执行。最好还是SendCommand模拟command 本帖最后由 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" "")
(itoa (car ent))) ？ 本帖最后由 lee50310 于 2023-8-11 06:31 编辑
by lee-mac
選擇物體==> 原地複製
執行指令: nc
(defun c:nc nil
(command "_.ncopy" "\\" "" "_non" '(0 0) "_non" '(0 0))
(princ)
)
(defun $ncopy-block$ (ent lst / blk en
lx ly lz make-anonymous-block
mark mat mat:mxm mat:mxvmat:trp
mxm mxv new news obj
ownrobjparent ref refgeomsclmat
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
) nco的话 用nentsel这个函数试试 就是把(setq ent (entsel))这个换成(setq ent (nentsel)) li_fang_2008 发表于 2023-8-8 15:01
这段代码的目的是选择一个实体对象，并使用NCOPY命令对其进行复制操作。
然而，command-s函数使用的是字 ...
这方法我用一次后，后面就没办法执行了，啥情况。:L 感谢作者的分享！
页:
[1]