相对块复制选择集，增加随目标块旋转镜像的功能【20210704更新】

masterlong · 发表于 2018-2-2 20:35:17

本帖最后由 masterlong 于 2021-7-4 17:16 编辑

很早以前放出的程序
相对块复制选择集

后来加入了副本随目标块旋转、镜像的功能
但一直没有时间针对210组码为(0 0 -1)的情况进行处理
今天有点空
把程序完善了一下
直接放上lsp和dcl文件供下载
————好像还不能直接上传附件

两个命令
AS 为指定图块组，添加关联选择集
ASR AS扩展，副本随目标图块旋转、镜像

文件需放到CAD支持目录下
或者自己手动修改程序路径
差什么函数说一下

;;;另存为【~~~adds```为指定的图块添加关联选择集.lsp】

;;选择一个参照块和一个要关联复制的选择集。指定目标块组后，逐一按相对位置进行复制
(defun c:as() (load "~~~adds```为指定图块组添加关联选择集.lsp") (setq rofollowblk "0") (c:adds))
(defun c:asR() (load "~~~adds```为指定图块组添加关联选择集.lsp") (setq rofollowblk "1") (c:adds))
(defun c:adds()
(adds_load)
(adds_err)
(princ "\n为指定图块组，添加关联选择集【对话框启动...】")(princ)
(setvar "cmdecho" 0)
(setq blk NIL blkss NIL addss NIL)
(setq adds_dcl (load_dialog "~~~adds.dcl"))
(adds_startdcl)
(adds_no_err)
(princ)
)
(defun adds_startdcl()
(new_dialog "adds" adds_dcl "")
(addsmode)
(action_tile "rofollowblk" "(setq rofollowblk $value)(addsmode)")
(action_tile "blksscosame" "(setq blksscosame $value)")
(action_tile "sel_addss" "(done_dialog 2)")
(action_tile "sel_blk" "(done_dialog 3)")
(setq oke (start_dialog))
(cond
((= oke 0)(adds_clear))
((= oke 2)(adds_sel_addss))
((= oke 3)(adds_sel_blk))
((= oke 8)(adds_dont_ro))
((= oke 9)(adds_do_ro))
)
)
(defun addsmode()
(if (= "0" rofollowblk)
(progn
(set_tile "rofollowblk" "0")
(action_tile "sel_blkss" "(done_dialog 8)")
)
(progn
(set_tile "rofollowblk" "1")
(action_tile "sel_blkss" "(done_dialog 9)")
)
)
(if (/= "1" blksscosame) (setq blksscosame "0"))
(set_tile "blksscosame" blksscosame)
(addsettite)
)
(defun addsettite()
(if addss
(if blk
(progn
(mode_tile "sel_addss" 1)
(mode_tile "sel_blk" 1)
(mode_tile "sel_blkss" 0)
(mode_tile "sel_blkss" 2)
(mode_tile "sel_blkss" 3)
)
(progn
(mode_tile "sel_blkss" 1)
(mode_tile "sel_addss" 1)
(mode_tile "sel_blk" 0)
(mode_tile "sel_blk" 2)
(mode_tile "sel_blk" 3)
)
)
(progn
(mode_tile "sel_blk" 1)
(mode_tile "sel_blkss" 1)
(mode_tile "sel_addss" 0)
(mode_tile "sel_addss" 2)
(mode_tile "sel_addss" 3)
)
)
)
(defun adds_clear()
(if blk (redraw blk 4))
(if addss (ssdraw addss 4))
(setq blk NIL blkss NIL addss NIL)
)
(defun adds_sel_addss()
(princ "\n选择要关联添加的选择集...")
(setq addss (ssget))
(ssdraw addss 3)
(adds_startdcl)
)
(defun adds_sel_blk()
(princ "\n指定参照图块...")
(if (setq blk (ssget ":e:s" '((0 . "insert"))))
(progn
(setq blk (ssname blk 0))
(setq blkinspo (trueINSPO blk))
(setq blkco (dxf blk 62))
(setq the_blk50 (dxf 50 blk))
(if (= -1 (last (dxf 210 blk))) (setq the_blk50 (- PI the_blk50))) ;;获取图块的修正角度
(setq blkname (dxf 2 blk))
(redraw blk 3)
)
)
(adds_startdcl)
)
(defun adds_dont_ro()
(princ "\n指定目标图块组...")
(if (= blksscosame "1")
(setq blkss (ssget (list '(0 . "insert") (cons 2 blkname)(cons 62 blkco))))
(setq blkss (ssget (list '(0 . "insert") (cons 2 blkname))))
)
(if (and blkss addss)
(progn
(setq blkss (ssdel blk (ssadd blk blkss)))
(foreach x (ss2list blkss)
(setq xinspo (trueINSPO x))
(command "copy" addss "" "non" blkinspo "non" xinspo)
)
)
(adds_startdcl)
)
)
(defun adds_do_ro()
(setq blkname (dxf 2 blk))
(redraw blk 3)
(princ "\n指定目标图块组...")
(if (= blksscosame "1")
(setq blkss (ssget (list '(0 . "insert") (cons 2 blkname)(cons 62 blkco))))
(setq blkss (ssget (list '(0 . "insert") (cons 2 blkname))))
)
;;重写代码【代码貌似ok】
(if blkss
(progn
(setq blkss (ssdel blk (ssadd blk blkss))) ;;滤除参照块
(if (= -1 (last (dxf 210 blk))) (blk-1to1 blk)) ;;如果参照块本身210是00-1，改为001
(setq addssmidpo (getmidpo (ssbox addss))) ;;目标选择集的中心点
(setq nipt (MAT:TransNested addssmidpo (list blk) 0 2)) ;;该中心点对应于参照块定义的坐标【nipt】
(foreach x (ss2list blkss)
(setq mirr_x_yn NIL mirr_y_yn NIL) ;;设定允许翻转初始值
(setq nopt (btrans nipt x)) ;;获取nipt对应x的实际坐标
;;如果x本身210是00-1，改为001。同时设定副本需两次镜像
(if (= -1 (last (dxf 210 x)))
(progn (blk-1to1 x) (setq mirr_x_yn T mirr_y_yn T))
)
;;计算副本的旋转角
(setq curr_blk50 (dxf 50 x))
(setq cha50 (- curr_blk50 the_blk50))
(setq ro50 (* (/ cha50 PI) 180.0))
;;;根据当前块的xy，再进行单次mirr的设定
(if (> 0 (dxf 41 x))
(setq mirr_x_yn (null mirr_x_yn))
)
(if (> 0 (dxf 42 x))
(setq mirr_y_yn (null mirr_y_yn))
)
;;复制副本并进行最终的旋转镜像处理
(setq thelast (entlast))
(command "copy" addss "" "non" addssmidpo "non" nopt)
(setq newss (entbackss thelast))
(command "rotate" newss "" "non" nopt ro50)
(if mirr_x_yn
(command "mirror" newss "" "non" nopt "non" (polar nopt (+ curr_blk50 d_090) 1000) "y")
)
(if mirr_y_yn
(command "mirror" newss "" "non" nopt "non" (polar nopt curr_blk50 1000) "y")
)
)
(adds_clear)
)
(adds_startdcl)
)
)
(defun adds_err()
(setvar "cmdecho" 0)
(command "undo" "g")
(setq adds_olderr *error* )
(defun *error*(msg)
(redraw)
(setvar "cmdecho" 0)
(command "undo" "e")
(setq *error* adds_olderr)
(princ)
)
(defun adds_no_err()
(redraw)
(setvar "cmdecho" 0)
(command "undo" "e")
(setq *error* adds_olderr)
(princ)
)
(princ)
)
(defun adds_load()
(load "~~~adds```为指定图块组添加关联选择集.lsp")
(setq thetiplist '( "AS 为指定图块组，添加关联选择集"
"ASR AS扩展，选择集副本随目标图块旋转、镜像"
)
)
(setq *ent2obj* vlax-Ename->Vla-Object
d_090 (* PI 0.5)
d_180 PI
d_360 (* PI 2)
)
(princ)
)
;999`````````````````````````````````````````````````````````````````````````````公共函数
;999公共函数
;;blk-1to1 将已确定210为00-1的图块更改为001
(defun blk-1to1( b / pooo )
(if (= -1 (caddr (dxf 210 b)))
(progn
(setq pooo (trueinspo b))
(entmodsome b (list
(cons 210 '(0 0 1))
(cons 50 (- d_360 (dxf b 50)))
(cons 41 (- (dxf b 41)))
(cons 10 pooo)
)
)
)
)
)
;999公共函数
;;按指定的模式重画一个选择集的全部物体<改模式时，需要先反绘。1-2 3-4.(1->4=1->2->4)> 【支持模型多视口，支持布局中视口】
;; 1:显示 2:消隐 3:高亮 4:低亮
(defun ssredraw( ss mode )
(ssdraw ss mode)
)
(defun ssdraw( ss mode / i ent vp )
(if (= (strcase (getvar "ctab")) "MODEL")
(if (member mode '(1 2 3 4))
(foreach vp (reverse (vports))
(setvar "cvport" (car vp))
(cond
((= (type ss) 'PICKSET)
(foreach ent (ss2list ss)
(redraw ent mode)
)
)
((= (type ss) 'list)
(foreach ent ss
(redraw ent mode)
)
)
((= (type ss) 'ename)
(redraw ss mode)
)
)
)
)
(cond
((= (type ss) 'PICKSET)
(foreach ent (ss2list ss)
(redraw ent mode)
)
)
((= (type ss) 'list)
(foreach ent ss
(redraw ent mode)
)
)
((= (type ss) 'ename)
(redraw ss mode)
)
)
)
(princ)
)
;999公共函数
;;y:gettrueINSPO 获取一个块的实际块心 (trans blk'dxf10 blk 1)
;;举例
;;(trueINSPO blockent)
(defun trueINSPO( blkent / pt po )
(setq pt (dxf 10 blkent))
(if (setq po (trans pt blkent 1))
po
pt
)
)
;999公共函数
;;dxf 获取图元某个dxf组码（内参不限种类顺序：：： n ent [entget ent] ）
(defun dxf( n ent / temp tmp )
(if (/= (type n) 'int)
(setq temp ent
ent n
n temp
)
)
(if (= (type ent) 'ENAME)
(setq temp (entget ent))
(setq temp ent)
)
(if (= n 62)
(if (setq tmp (assoc n temp)) (cdr tmp) 256)
(cdr (assoc n temp))
)
)
;999公共函数
;;求点对中点
(defun getmidpo( pts / P1 P2 X Y )
(setq p1 (car pts) p2 (cadr pts))
(if (= (length p1) (length p2))
nil
(setq p1 (list (car p1) (cadr p1))
p2 (list (car p2) (cadr p2))
)
)
(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
)
;999公共函数
;;选择集的最小（正交）包围框 ————选择集包含二次样条曲线时，包围框可能不准，暂时没解决的办法
(defun ssbox( ss / ll ur aa bb )
(if (= (type ss) 'PICKSET)
(setq ss (ss2list ss))
)
(foreach x ss
(vla-getboundingbox (*ent2obj* x) 'll 'ur)
(setq aa (cons (vlax-safearray->list ll) aa)
bb (cons (vlax-safearray->list ur) bb)
)
)
(mapcar '(lambda(a b) (apply 'mapcar (cons a b)))
'(min max)
(list aa bb)
)
)
;999公共函数
;;选择集转为图元列表
(defun ss2list ( ss / n i elist )
(cond
((null ss) NIL)
((and (= (type ss) 'Pickset) (null (sslength ss)))
NIL
)
((= (type ss) 'Pickset)
(setq n (sslength ss)
i n
elist '()
)
(repeat n
(setq i (1- i))
;;如果没有这个if，那么选择集中被删除的图元，也会被加入到列表之中————但是极其偶尔也有可能，图元不存在但是能entget（遇到过一次，原因不明，或许是CAD的BUG）
(if (entget (ssname ss i))
(setq elist (cons (ssname ss i) elist))
)
)
elist
)
((= (type ss) 'ename)
(list ss)
)
((= (type ss) 'list)
(vl-remove-if-not ''((x) (and (= (type x) 'ename) (entget x))) ss)
)
( T NIL )
)
)
;999公共函数
(defun entbackss ( ent / backss)
(if (and ent (*ent2obj* ent))
(progn
(setq backss (ssadd))
(while (setq ent (entnext ent))
(if (not (member (cdr (assoc 0 (entget ent))) '("ATTRIB" "VERTEX" "SEQEND")))
(setq backss (ssadd ent backss))
)
)
(if (zerop (sslength backss))
(setq backss NIL)
)
backss
)
)
)
;999公共函数
;;修改一个图元的多个数据 ——————不是所有的图元都适用此方式 ——————此函数尚未考虑组码不存在时的情况：比如62
(defun entmodsome( ent dxfdatalist )
(entmod (append (list (cons -1 ent)) dxfdatalist))
)
;999999999999999999999999999999999````````````````````````````以下是高飞鸟大侠的矩阵变换函数``````````很牛B的函数，但我感觉有BUG，求出的点Z坐标实际应该为0，但计算结果不为0。
; ————这或许也不是BUG，而是二进制计算导致的误差
; ————图块z坐标原来为0的好办，直接设为0即可消除误差。但是原来就不为0时，这个误差就不好处理了
;;;-----------------------------------------------------------;;
;;; 块参照的变换矩阵和逆矩阵 ;;
;;;-----------------------------------------------------------;;
;;;-----------------------------------------------------------;;
;;; 功能：某点在块内坐标系统和世界或者用户坐标系统的转换 ;;
;;; 参数： pt 要变换的点。 ;;
;;; rlst 用 nentselp或者nentsel得到的表的最后一项 ;; 就是图块主图元为元素的单表 (last (nentsel)) = (list (car (entsel))) = (<图元名: 75873f48>)
;;; from 坐标系：0,WCS; 1,当前UCS; 2,块参照坐标系RCS ;;
;;; to 坐标系：0,WCS; 1,当前UCS; 2,块参照坐标系RCS ;;
;;;-----------------------------------------------------------;;
;;; MAT:TransNested (gile) ;;
;;; Translates a point coordinates from WCS or UCS to RCS ;;
;;; -coordinates system of a ;;
;;; reference (xref or block) whatever its nested level- ;;
;;; ;;
;;; Arguments ;;
;;; pt : the point to translate ;;
;;; rlst : the parents entities list from the deepest nested ;;
;;; to the one inserted in current space -same as ;;
;;; (last (nentsel)) or (last (nentselp)) ;;
;;; from to : as with trans function: 0.WCS, 1.UCS, 2.RCS ;;
;;;-----------------------------------------------------------;;
;999应用范例
;999：：：：已知图框块定义中，图签右上角点坐标，求该点位在世界坐标系中的坐标
;|
(setq po (MAT:TransNested '(-180 49) (list (car (entsel))) 2 0))
|;
;;相对块定义的一点坐标，对应WCS中的坐标
(defun btrans( pt blk )
(MAT:TransNested pt (list blk) 2 0)
)
(defun MAT:TransNested (pt rlst from to / GEOM)
(and (= 1 from) (setq pt (trans pt 1 0)))
(and (= 2 to) (setq rlst (reverse rlst)))
(and (or (= 2 from) (= 2 to))
(while rlst
(setq geom (if (= 2 to)
(MAT:RevRefGeom (car rlst))
(MAT:RefGeom (car rlst))
)
rlst (cdr rlst)
pt (mapcar '+ (MAT:mxv (car geom) pt) (cadr geom))
)
)
)
(if (= 1 to)
(trans pt 0 1)
pt
)
)
;;已知WCS中的坐标，求相对于块定义中的点坐标
(defun transb( pt blk )
(MAT:TransNested pt (list blk) 0 2)
)
;;;-----------------------------------------------------------;;
;;; 功能：图块的变换矩阵 ;;
;;; 输入：块参照的图元名 ;;
;;; 输出：块参照的变换矩阵 ;;
;;;-----------------------------------------------------------;;
;;; MAT:RefGeom (gile) ;;
;;; Returns a list which first item is a 3x3 transformation ;;
;;; matrix(rotation,scales normal) and second item the object ;;
;;; insertion point in its parent(xref, bloc or space) ;;
;;; ;;
;;; Argument : an ename ;;
;;;-----------------------------------------------------------;;
(defun MAT:RefGeom ( ename / elst ang norm mat )
(setq elst (entget ename)
ang (cdr (assoc 50 elst))
norm (cdr (assoc 210 elst))
)
(list
(setq mat (MAT:mxm
(mapcar ''((v) (trans v 0 norm T))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
(MAT: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 elst)) 0.0 0.0)
(list 0.0 (cdr (assoc 42 elst)) 0.0)
(list 0.0 0.0 (cdr (assoc 43 elst)))
)
)
)
)
(mapcar '-
(trans (cdr (assoc 10 elst)) norm 0)
(MAT:mxv mat (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst))))))
)
)
)
;;;-----------------------------------------------------------;;
;;; 功能：图块的变换矩阵的逆矩阵 ;;
;;;-----------------------------------------------------------;;
;;; MAT:RevRefGeom (gile) ;;
;;; MAT:RefGeom inverse function ;;
;;; 输入：块参照的图元名 ;;
;;; 输出：块参照的变换矩阵的逆矩阵 ;;
;;;-----------------------------------------------------------;;
(defun MAT:RevRefGeom ( ename / entData ang norm mat )
(setq entData (entget ename)
ang (- (cdr (assoc 50 entData)))
norm (cdr (assoc 210 entData))
)
(list
(setq mat (MAT:mxm
(list (list (/ 1 (cdr (assoc 41 entData))) 0.0 0.0)
(list 0.0 (/ 1 (cdr (assoc 42 entData))) 0.0)
(list 0.0 0.0 (/ 1 (cdr (assoc 43 entData))))
)
(MAT:mxm
(list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(mapcar ''((v) (trans v norm 0 T))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
)
)
)
(mapcar '-
(cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 entData)))))
(MAT:mxv mat (trans (cdr (assoc 10 entData)) norm 0))
)
)
)
;;;-----------------------------------------------------------;;
;;; 矩阵相乘 ;;
;;; MAT:mxm Multiply two matrices -Vladimir Nesterovsky- ;;
;;;-----------------------------------------------------------;;
(defun MAT:mxm( m q )
(mapcar ''((r) (MAT:mxv (MAT:trp q) r)) m)
)
;;;-----------------------------------------------------------;;
;;; 向量或点的矩阵变换(向量乘矩阵) ;;
;;; Matrix x Vector - Vladimir Nesterovsky ;;
;;; Args: m - nxn matrix, v - vector in R^n ;;
;;;-----------------------------------------------------------;;
(defun MAT:mxv( m v )
(mapcar ''((r) (apply '+ (mapcar '* r v))) m)
)
;;;-----------------------------------------------------------;;
;;; 矩阵转置 ;;
;;; MAT:trp Transpose a matrix -Doug Wilson- ;;
;;; 输入：矩阵 ;;
;;; 输出：转置后的矩阵 ;;
;;;-----------------------------------------------------------;;
(defun MAT:trp( m )
(apply 'mapcar (cons 'list m))
)
;;;-----------------------------------------------------------;;
;;; 平齐实体的变换矩阵 -by highflybird ;;
;;; 输入：Ent - 实体名 ;;
;;; 输出：平齐这个实体的变换矩阵和它的逆矩阵 ;;
;;;-----------------------------------------------------------;;
(defun Mat:EntityMatrix (Ent / z dxf Cen obj an m1 mat Inv org)
(setq dxf (entget ent))
(if (setq Cen (cdr (assoc 10 dxf))) ;Insertpoint,center or startpoint,etc.
(if (null (caddr Cen))
(setq Cen (append Cen '(0.0)))
)
(setq Cen '(0 0 0))
)
(setq obj (vlax-ename->vla-object Ent))
(if (and (vlax-property-available-p obj 'elevation) ;If it has elevation value.
(wcmatch (vla-get-objectname obj) "*Polyline") ;It's a "AcDb2dPolyline" or "AcDbPolyline" object
)
(setq z (vla-get-elevation obj)
Cen (list (car Cen) (cadr Cen) (+ (caddr Cen) z)) ;add elevation value
)
)
(if (vlax-property-available-p obj 'rotation) ;if it has a rotaion angle
(setq an (vla-get-rotation obj))
(setq an 0)
)
(MAT:Trans1 0 Ent Cen an) ;return two matrices, the first is WCS->OCS,the second is OCS->WCS
)
;;;-----------------------------------------------------------;;
;;; 通用变换矩阵 by highflybird ;;
;;; 输入：from - 原坐标系， ;;
;;; to - 目的坐标系， ;;
;;; Org - 目的坐标系的原点相对原坐标系的位置 ;;
;;; Ang - 相对于原坐标系的旋转角度 ;;
;;; 输出：两个矩阵，一个是从原坐标系变换到目的坐标系的变换矩阵;;
;;; 一个是从目的坐标系变换到原坐标系的变换矩阵 ;;
;;;-----------------------------------------------------------;;
(defun MAT:Trans1 (from to Org Ang / Mat Rot Inv Cen)
(setq Mat (mapcar ''((v) (trans v from to T))
'((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
)
)
(if (not (equal ang 0 1e-14))
(setq Rot (list (list (cos ang) (- (sin ang)) 0.)
(list (sin ang) (cos ang) 0.)
(list 0. 0. 1.)
)
mat (MAT:mxm mat Rot)
)
)
(setq Cen (trans Org to from))
(setq Inv (mat:trp mat))
(list
(Mat:DispToMatrix Inv (mat:mxv Inv (mapcar '- Cen))) ;from->to (trans pt from to)
(Mat:DispToMatrix mat Cen) ;to->from (trans pt to from)
)
)
;;;-----------------------------------------------------------;;
;;; Append displacement vector to a matrix -Highflybird- ;;
;;; 把位移矢量添加到矩阵中 ;;
;;; 输入：mat -- 矩阵(3x3)，disp -- 位移矢量 ;;
;;; 输出：一个4X4的变换CAD的标准变换矩阵 ;;
;;;-----------------------------------------------------------;;
(defun Mat:DispToMatrix (mat disp)
(append
(mapcar 'append mat (mapcar 'list disp))
'((0. 0. 0. 1.))
)
)
(princ)

;;选择一个参照块和一个要关联复制的选择集。指定目标块组后，逐一按相对位置进行复制 
(defun c:as()  (load "~~~adds```为指定图块组添加关联选择集.lsp") (setq rofollowblk "0") (c:adds)) 
(defun c:asR() (load "~~~adds```为指定图块组添加关联选择集.lsp") (setq rofollowblk "1") (c:adds)) 
 
(defun c:adds() 
  (adds_load) 
  (adds_err) 
  (princ "\n为指定图块组，添加关联选择集【对话框启动...】")(princ) 
  (setvar "cmdecho" 0) 
  (setq blk NIL  blkss NIL  addss NIL) 
  (setq adds_dcl (load_dialog "~~~adds.dcl")) 
  (adds_startdcl) 
  (adds_no_err) 
(princ) 
) 
 
(defun adds_startdcl() 
  (new_dialog "adds" adds_dcl "") 
  (addsmode) 
  (action_tile "rofollowblk" "(setq rofollowblk $value)(addsmode)") 
  (action_tile "blksscosame" "(setq blksscosame $value)") 
  (action_tile "sel_addss" "(done_dialog 2)") 
  (action_tile "sel_blk"   "(done_dialog 3)") 
   
  (setq oke (start_dialog)) 
  (cond 
    ((= oke 0)(adds_clear)) 
    
    ((= oke 2)(adds_sel_addss)) 
    ((= oke 3)(adds_sel_blk)) 
    
    ((= oke 8)(adds_dont_ro)) 
    ((= oke 9)(adds_do_ro)) 
  ) 
) 
 
(defun addsmode() 
  (if (= "0" rofollowblk) 
    (progn 
      (set_tile "rofollowblk" "0") 
      (action_tile "sel_blkss" "(done_dialog 8)") 
    ) 
    (progn 
      (set_tile "rofollowblk" "1") 
      (action_tile "sel_blkss" "(done_dialog 9)") 
    ) 
  ) 
  (if (/= "1" blksscosame) (setq blksscosame "0")) 
  (set_tile "blksscosame" blksscosame) 
  (addsettite) 
) 
(defun addsettite() 
  (if addss 
    (if blk 
      (progn 
        (mode_tile "sel_addss" 1) 
        (mode_tile "sel_blk"   1) 
        (mode_tile "sel_blkss" 0) 
        (mode_tile "sel_blkss" 2) 
        (mode_tile "sel_blkss" 3) 
      ) 
      (progn 
        (mode_tile "sel_blkss" 1) 
        (mode_tile "sel_addss" 1) 
        (mode_tile "sel_blk"   0) 
        (mode_tile "sel_blk"   2) 
        (mode_tile "sel_blk"   3) 
      ) 
    ) 
    (progn 
      (mode_tile "sel_blk"   1) 
      (mode_tile "sel_blkss" 1) 
      (mode_tile "sel_addss" 0) 
      (mode_tile "sel_addss" 2) 
      (mode_tile "sel_addss" 3) 
    ) 
  ) 
) 
 
(defun adds_clear() 
  (if blk (redraw blk 4)) 
  (if addss (ssdraw addss 4)) 
  (setq blk NIL  blkss NIL  addss NIL) 
) 
 
(defun adds_sel_addss() 
  (princ "\n选择要关联添加的选择集...") 
  (setq addss (ssget)) 
  (ssdraw addss 3) 
  (adds_startdcl) 
) 
 
(defun adds_sel_blk() 
  (princ "\n指定参照图块...") 
  (if (setq blk (ssget ":e:s" '((0 . "insert")))) 
    (progn 
      (setq blk (ssname blk 0)) 
      (setq blkinspo (trueINSPO blk)) 
      (setq blkco (dxf blk 62)) 
       
      (setq the_blk50 (dxf 50 blk)) 
      (if (= -1 (last (dxf 210 blk)))    (setq the_blk50 (- PI the_blk50)))      ;;获取图块的修正角度 
               
      (setq blkname   (dxf  2 blk)) 
      (redraw blk 3) 
    ) 
  ) 
  (adds_startdcl) 
) 
 
(defun adds_dont_ro() 
  (princ "\n指定目标图块组...") 
  (if (= blksscosame "1") 
    (setq blkss (ssget (list '(0 . "insert") (cons 2 blkname)(cons 62 blkco)))) 
    (setq blkss (ssget (list '(0 . "insert") (cons 2 blkname)))) 
  ) 
  (if (and blkss addss) 
    (progn 
      (setq blkss (ssdel blk (ssadd blk blkss))) 
      (foreach x (ss2list blkss) 
        (setq xinspo (trueINSPO x)) 
        (command "copy" addss "" "non" blkinspo "non" xinspo) 
      ) 
    ) 
    (adds_startdcl) 
  ) 
) 
 
 
(defun adds_do_ro() 
  (setq blkname (dxf 2 blk)) 
  (redraw blk 3) 
   
  (princ "\n指定目标图块组...") 
  (if (= blksscosame "1") 
    (setq blkss (ssget (list '(0 . "insert") (cons 2 blkname)(cons 62 blkco)))) 
    (setq blkss (ssget (list '(0 . "insert") (cons 2 blkname)))) 
  ) 
   
  ;;重写代码【代码貌似ok】 
  (if blkss 
    (progn 
      (setq blkss (ssdel blk (ssadd blk blkss)))            ;;滤除参照块 
      (if (= -1 (last (dxf 210 blk))) (blk-1to1 blk))          ;;如果参照块本身210是00-1，改为001 
      (setq addssmidpo (getmidpo (ssbox addss)))            ;;目标选择集的中心点 
      (setq nipt (MAT:TransNested addssmidpo (list blk) 0 2))    ;;该中心点对应于参照块定义的坐标【nipt】 
 
      (foreach x (ss2list blkss) 
        (setq mirr_x_yn NIL   mirr_y_yn NIL)              ;;设定允许翻转初始值 
        (setq nopt (btrans nipt x))                    ;;获取nipt对应x的实际坐标 
 
        ;;如果x本身210是00-1，改为001。同时设定副本需两次镜像 
        (if (= -1 (last (dxf 210 x))) 
          (progn (blk-1to1 x) (setq mirr_x_yn T   mirr_y_yn T)) 
        )          
        ;;计算副本的旋转角 
        (setq curr_blk50 (dxf 50 x)) 
        (setq cha50 (- curr_blk50 the_blk50)) 
        (setq ro50 (* (/ cha50 PI) 180.0)) 
 
        ;;;根据当前块的xy，再进行单次mirr的设定 
        (if (> 0 (dxf 41 x)) 
          (setq mirr_x_yn (null mirr_x_yn)) 
        ) 
        (if (> 0 (dxf 42 x)) 
          (setq mirr_y_yn (null mirr_y_yn)) 
        ) 
         
        ;;复制副本并进行最终的旋转镜像处理 
        (setq thelast (entlast)) 
        (command "copy" addss "" "non" addssmidpo "non" nopt) 
        (setq newss (entbackss thelast)) 
        (command "rotate" newss "" "non" nopt ro50) 
        (if mirr_x_yn 
          (command "mirror" newss "" "non" nopt "non" (polar nopt (+ curr_blk50 d_090) 1000) "y") 
        ) 
        (if mirr_y_yn 
          (command "mirror" newss "" "non" nopt "non" (polar nopt curr_blk50 1000) "y") 
        ) 
      ) 
      (adds_clear) 
    ) 
    (adds_startdcl) 
  ) 
) 
 
 
(defun adds_err() 
    (setvar "cmdecho" 0) 
    (command "undo" "g") 
    (setq adds_olderr *error* ) 
   
     (defun *error*(msg) 
       (redraw) 
      (setvar "cmdecho" 0) 
       (command "undo" "e") 
      (setq *error* adds_olderr) 
     (princ) 
     ) 
   
     (defun adds_no_err() 
       (redraw) 
       (setvar "cmdecho" 0) 
       (command "undo" "e") 
       (setq *error* adds_olderr) 
    (princ) 
     ) 
   
(princ) 
) 
(defun adds_load() 
  (load "~~~adds```为指定图块组添加关联选择集.lsp") 
  (setq thetiplist '(  "AS     为指定图块组，添加关联选择集" 
                "ASR    AS扩展，选择集副本随目标图块旋转、镜像" 
              ) 
  ) 
  (setq *ent2obj* vlax-Ename->Vla-Object 
      d_090   (* PI 0.5) 
      d_180   PI 
      d_360   (* PI 2) 
  ) 
(princ) 
) 
 
 
 
 
 
 
 
;999`````````````````````````````````````````````````````````````````````````````公共函数 
 
 
 
 
;999公共函数 
;;blk-1to1  将已确定210为00-1的图块更改为001 
(defun blk-1to1( b / pooo ) 
  (if (= -1 (caddr (dxf 210 b))) 
    (progn 
      (setq pooo (trueinspo b)) 
      (entmodsome b  (list 
                    (cons 210 '(0 0 1)) 
                    (cons 50 (- d_360 (dxf b 50))) 
                    (cons 41 (- (dxf b 41))) 
                    (cons 10 pooo) 
                ) 
      ) 
    ) 
  ) 
) 
 
;999公共函数 
;;按指定的模式重画一个选择集的全部物体<改模式时，需要先反绘。1-2 3-4.(1->4=1->2->4)>    【支持模型多视口，支持布局中视口】 
;;  1:显示  2:消隐  3:高亮  4:低亮 
(defun ssredraw( ss mode ) 
  (ssdraw ss mode) 
) 
(defun ssdraw( ss mode / i ent vp ) 
  (if (= (strcase (getvar "ctab")) "MODEL") 
    (if (member mode '(1 2 3 4)) 
      (foreach vp (reverse (vports)) 
        (setvar "cvport" (car vp)) 
        (cond 
          ((= (type ss) 'PICKSET) 
            (foreach ent (ss2list ss) 
              (redraw ent mode) 
            ) 
          ) 
          ((= (type ss) 'list) 
            (foreach ent ss 
              (redraw ent mode) 
            ) 
          ) 
          ((= (type ss) 'ename) 
            (redraw ss mode) 
          ) 
        ) 
      ) 
    ) 
    (cond 
      ((= (type ss) 'PICKSET) 
        (foreach ent (ss2list ss) 
          (redraw ent mode) 
        ) 
      ) 
      ((= (type ss) 'list) 
        (foreach ent ss 
          (redraw ent mode) 
        ) 
      ) 
      ((= (type ss) 'ename) 
        (redraw ss mode) 
      ) 
    ) 
  ) 
(princ) 
) 
 
;999公共函数 
;;y:gettrueINSPO  获取一个块的实际块心   (trans blk'dxf10 blk 1) 
;;举例 
;;(trueINSPO blockent) 
(defun trueINSPO( blkent / pt po ) 
  (setq pt (dxf 10 blkent)) 
  (if (setq po (trans pt blkent 1)) 
    po 
    pt 
  ) 
) 
 
;999公共函数 
;;dxf  获取图元某个dxf组码（内参不限种类顺序：：： n ent [entget ent] ） 
(defun dxf( n ent / temp tmp ) 
  (if (/= (type n) 'int) 
    (setq temp   ent 
        ent  n    
        n    temp 
    ) 
  ) 
  (if (= (type ent) 'ENAME) 
    (setq temp (entget ent)) 
    (setq temp ent) 
  ) 
  (if (= n 62) 
    (if (setq tmp (assoc n temp))  (cdr tmp)  256) 
    (cdr (assoc n temp)) 
  ) 
) 
 
;999公共函数 
;;求点对中点 
(defun getmidpo( pts / P1 P2 X Y ) 
  (setq p1 (car pts) p2 (cadr pts)) 
  (if (= (length p1) (length p2)) 
    nil 
    (setq p1 (list (car p1) (cadr p1)) 
        p2 (list (car p2) (cadr p2)) 
    ) 
  ) 
  (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2) 
) 
 
;999公共函数 
;;选择集的最小（正交）包围框                    ————选择集包含二次样条曲线时，包围框可能不准，暂时没解决的办法 
(defun ssbox( ss / ll ur aa bb ) 
  (if (= (type ss) 'PICKSET) 
    (setq ss (ss2list ss)) 
  ) 
  (foreach x ss 
    (vla-getboundingbox (*ent2obj* x) 'll 'ur) 
    (setq aa (cons (vlax-safearray->list ll) aa) 
        bb (cons (vlax-safearray->list ur) bb) 
    ) 
  ) 
  (mapcar '(lambda(a b) (apply 'mapcar (cons a b))) 
    '(min max) 
    (list aa bb) 
  ) 
) 
 
;999公共函数 
;;选择集转为图元列表 
(defun ss2list ( ss / n i elist ) 
  (cond 
    ((null ss) NIL) 
    ((and (= (type ss) 'Pickset) (null (sslength ss))) 
        NIL 
    ) 
    ((= (type ss) 'Pickset) 
      (setq n  (sslength ss) 
          i n 
          elist '() 
      ) 
      (repeat n 
        (setq i (1- i)) 
        ;;如果没有这个if，那么选择集中被删除的图元，也会被加入到列表之中————但是极其偶尔也有可能，图元不存在但是能entget（遇到过一次，原因不明，或许是CAD的BUG） 
        (if (entget (ssname ss i)) 
          (setq elist (cons (ssname ss i) elist)) 
        ) 
      ) 
      elist 
    ) 
    ((= (type ss) 'ename) 
      (list ss) 
    ) 
    ((= (type ss) 'list) 
      (vl-remove-if-not ''((x) (and (= (type x) 'ename) (entget x))) ss) 
    ) 
    ( T NIL ) 
  ) 
) 
 
;999公共函数 
(defun entbackss ( ent / backss) 
  (if (and ent (*ent2obj* ent)) 
    (progn 
      (setq backss (ssadd)) 
      (while (setq ent (entnext ent)) 
        (if (not (member (cdr (assoc 0 (entget ent))) '("ATTRIB" "VERTEX" "SEQEND"))) 
          (setq backss (ssadd ent backss)) 
        ) 
      ) 
      (if (zerop (sslength backss)) 
        (setq backss NIL) 
      ) 
      backss 
    ) 
  ) 
) 
 
;999公共函数 
;;修改一个图元的多个数据      ——————不是所有的图元都适用此方式    ——————此函数尚未考虑组码不存在时的情况：比如62 
(defun entmodsome( ent dxfdatalist ) 
  (entmod (append (list (cons -1 ent)) dxfdatalist)) 
) 
 
 
 
 
 
;999999999999999999999999999999999````````````````````````````以下是高飞鸟大侠的矩阵变换函数``````````很牛B的函数，但我感觉有BUG，求出的点Z坐标实际应该为0，但计算结果不为0。 
;                                                        ————这或许也不是BUG，而是二进制计算导致的误差 
;                                                        ————图块z坐标原来为0的好办，直接设为0即可消除误差。但是原来就不为0时，这个误差就不好处理了 
 
;;;-----------------------------------------------------------;; 
;;; 块参照的变换矩阵和逆矩阵                               ;; 
;;;-----------------------------------------------------------;; 
 
 
;;;-----------------------------------------------------------;; 
;;; 功能： 某点在块内坐标系统和世界或者用户坐标系统的转换     ;; 
;;; 参数： pt 要变换的点。                                    ;; 
;;;        rlst 用 nentselp或者nentsel得到的表的最后一项      ;;    就是图块主图元为元素的单表 (last (nentsel)) = (list (car (entsel))) = (<图元名: 75873f48>) 
;;;        from  坐标系：0,WCS; 1,当前UCS; 2,块参照坐标系RCS  ;; 
;;;        to    坐标系：0,WCS; 1,当前UCS; 2,块参照坐标系RCS  ;; 
;;;-----------------------------------------------------------;; 
;;; MAT:TransNested (gile)                                    ;; 
;;; Translates a point coordinates from WCS or UCS to RCS     ;; 
;;; -coordinates system of a                               ;; 
;;; reference (xref or block) whatever its nested level-      ;; 
;;;                                               ;; 
;;; Arguments                                         ;; 
;;; pt : the point to translate                            ;; 
;;; rlst : the parents entities list from the deepest nested  ;; 
;;;        to the one inserted in current space -same as      ;; 
;;;        (last (nentsel)) or (last (nentselp))             ;; 
;;; from to : as with trans function: 0.WCS, 1.UCS, 2.RCS     ;; 
;;;-----------------------------------------------------------;; 
 
;999应用范例 
;999：：：：已知图框块定义中，图签右上角点坐标，求该点位在世界坐标系中的坐标 
;| 
(setq po (MAT:TransNested '(-180 49) (list (car (entsel))) 2 0)) 
|; 
;;相对块定义的一点坐标，对应WCS中的坐标 
(defun btrans( pt blk ) 
  (MAT:TransNested pt (list blk) 2 0) 
) 
(defun MAT:TransNested (pt rlst from to / GEOM) 
  (and (= 1 from) (setq pt (trans pt 1 0))) 
  (and (= 2 to) (setq rlst (reverse rlst))) 
  (and  (or (= 2 from) (= 2 to)) 
      (while rlst 
        (setq geom (if  (= 2 to) 
                  (MAT:RevRefGeom (car rlst)) 
                  (MAT:RefGeom (car rlst)) 
                ) 
            rlst (cdr rlst) 
            pt   (mapcar '+ (MAT:mxv (car geom) pt) (cadr geom)) 
        ) 
      ) 
  ) 
  (if (= 1 to) 
    (trans pt 0 1) 
    pt 
  ) 
) 
;;已知WCS中的坐标，求相对于块定义中的点坐标 
(defun transb( pt blk ) 
  (MAT:TransNested pt (list blk) 0 2) 
) 
 
 
 
;;;-----------------------------------------------------------;; 
;;; 功能：图块的变换矩阵                                      ;; 
;;; 输入：块参照的图元名                                      ;; 
;;; 输出：块参照的变换矩阵                                    ;; 
;;;-----------------------------------------------------------;; 
;;; MAT:RefGeom (gile)                                 ;; 
;;; Returns a list which first item is a 3x3 transformation   ;; 
;;; matrix(rotation,scales normal) and second item the object ;; 
;;; insertion point in its parent(xref, bloc or space)       ;; 
;;;                                                    ;; 
;;; Argument : an ename                                    ;; 
;;;-----------------------------------------------------------;; 
 
(defun MAT:RefGeom ( ename / elst ang norm mat ) 
  (setq  elst (entget ename) 
      ang  (cdr (assoc 50 elst)) 
      norm (cdr (assoc 210 elst)) 
  ) 
  (list 
    (setq mat (MAT:mxm 
              (mapcar ''((v) (trans v 0 norm T)) 
                    '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) 
              ) 
              (MAT: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 elst)) 0.0 0.0) 
                    (list 0.0 (cdr (assoc 42 elst)) 0.0) 
                    (list 0.0 0.0 (cdr (assoc 43 elst))) 
                ) 
              ) 
          ) 
    ) 
    (mapcar '- 
          (trans (cdr (assoc 10 elst)) norm 0) 
          (MAT:mxv mat (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst)))))) 
    ) 
  ) 
) 
 
 
 
;;;-----------------------------------------------------------;; 
;;; 功能：图块的变换矩阵的逆矩阵                              ;; 
;;;-----------------------------------------------------------;; 
;;; MAT:RevRefGeom (gile)                                   ;; 
;;; MAT:RefGeom inverse function                             ;; 
;;; 输入：块参照的图元名                                      ;; 
;;; 输出：块参照的变换矩阵的逆矩阵                            ;; 
;;;-----------------------------------------------------------;; 
(defun MAT:RevRefGeom ( ename / entData ang norm mat ) 
  (setq  entData (entget ename) 
      ang    (- (cdr (assoc 50 entData))) 
      norm    (cdr (assoc 210 entData)) 
  ) 
  (list 
    (setq mat (MAT:mxm 
              (list (list (/ 1 (cdr (assoc 41 entData))) 0.0 0.0) 
                  (list 0.0 (/ 1 (cdr (assoc 42 entData))) 0.0) 
                  (list 0.0 0.0 (/ 1 (cdr (assoc 43 entData)))) 
              ) 
              (MAT:mxm 
                (list (list (cos ang) (- (sin ang)) 0.0) 
                    (list (sin ang) (cos ang) 0.0) 
                    '(0.0 0.0 1.0) 
                ) 
                (mapcar ''((v) (trans v norm 0 T)) 
                      '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) 
                ) 
              ) 
          ) 
    ) 
    (mapcar '- 
          (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 entData))))) 
          (MAT:mxv mat (trans (cdr (assoc 10 entData)) norm 0)) 
    ) 
  ) 
) 
 
 
;;;-----------------------------------------------------------;; 
;;; 矩阵相乘                                                  ;; 
;;; MAT:mxm Multiply two matrices -Vladimir Nesterovsky-      ;; 
;;;-----------------------------------------------------------;; 
(defun MAT:mxm( m q ) 
  (mapcar ''((r) (MAT:mxv (MAT:trp q) r)) m) 
) 
 
 
;;;-----------------------------------------------------------;; 
;;; 向量或点的矩阵变换(向量乘矩阵)                            ;; 
;;; Matrix x Vector - Vladimir Nesterovsky                    ;; 
;;; Args: m - nxn matrix, v - vector in R^n                   ;; 
;;;-----------------------------------------------------------;; 
(defun MAT:mxv( m v ) 
  (mapcar ''((r) (apply '+ (mapcar '* r v))) m) 
) 
 
 
;;;-----------------------------------------------------------;; 
;;; 矩阵转置                                                  ;; 
;;; MAT:trp Transpose a matrix -Doug Wilson-                  ;; 
;;; 输入：矩阵                                                ;; 
;;; 输出：转置后的矩阵                                        ;; 
;;;-----------------------------------------------------------;; 
(defun MAT:trp( m ) 
  (apply 'mapcar (cons 'list m)) 
) 
 
 
;;;-----------------------------------------------------------;; 
;;; 平齐实体的变换矩阵  -by highflybird                    ;; 
;;; 输入：Ent - 实体名                                        ;; 
;;; 输出：平齐这个实体的变换矩阵和它的逆矩阵                  ;; 
;;;-----------------------------------------------------------;; 
(defun Mat:EntityMatrix (Ent / z dxf Cen obj an m1 mat Inv org) 
  (setq dxf (entget ent)) 
  (if (setq Cen (cdr (assoc 10 dxf)))        ;Insertpoint,center or startpoint,etc. 
    (if (null (caddr Cen)) 
      (setq Cen (append Cen '(0.0))) 
    ) 
    (setq Cen '(0 0 0)) 
  ) 
  (setq obj (vlax-ename->vla-object Ent))       
  (if (and (vlax-property-available-p obj 'elevation)    ;If it has elevation value. 
        (wcmatch (vla-get-objectname obj) "*Polyline")  ;It's a "AcDb2dPolyline" or "AcDbPolyline" object 
     ) 
    (setq z   (vla-get-elevation obj) 
        Cen (list (car Cen) (cadr Cen) (+ (caddr Cen) z))  ;add elevation value 
    ) 
  ) 
  (if (vlax-property-available-p obj 'rotation)                 ;if it has a rotaion angle 
    (setq an (vla-get-rotation obj)) 
    (setq an 0) 
  ) 
  (MAT:Trans1 0 Ent Cen an)           ;return two matrices, the first is WCS->OCS,the second is OCS->WCS 
) 
 
 
;;;-----------------------------------------------------------;; 
;;; 通用变换矩阵 by highflybird                         ;; 
;;; 输入：from - 原坐标系，                                   ;; 
;;;       to   - 目的坐标系，                                 ;; 
;;;       Org  - 目的坐标系的原点相对原坐标系的位置           ;; 
;;;       Ang  - 相对于原坐标系的旋转角度                     ;; 
;;; 输出：两个矩阵，一个是从原坐标系变换到目的坐标系的变换矩阵;; 
;;;       一个是从目的坐标系变换到原坐标系的变换矩阵          ;; 
;;;-----------------------------------------------------------;; 
(defun MAT:Trans1 (from to Org Ang / Mat Rot Inv Cen) 
  (setq Mat (mapcar  ''((v) (trans v from to T)) 
                '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.)) 
         ) 
  ) 
  (if (not (equal ang 0 1e-14)) 
    (setq Rot (list   (list (cos ang) (- (sin ang)) 0.) 
                (list (sin ang) (cos ang) 0.) 
                (list 0. 0. 1.) 
          ) 
        mat (MAT:mxm mat Rot) 
    ) 
  ) 
  (setq Cen (trans Org to from)) 
  (setq Inv (mat:trp mat)) 
  (list 
    (Mat:DispToMatrix Inv (mat:mxv Inv (mapcar '- Cen)))  ;from->to (trans pt from to) 
    (Mat:DispToMatrix mat Cen)           ;to->from (trans pt to from) 
  ) 
) 
 
 
;;;-----------------------------------------------------------;; 
;;; Append displacement vector to a matrix   -Highflybird-    ;; 
;;; 把位移矢量添加到矩阵中                                    ;; 
;;; 输入：mat -- 矩阵(3x3)，disp -- 位移矢量                  ;; 
;;; 输出：一个4X4的变换CAD的标准变换矩阵                      ;; 
;;;-----------------------------------------------------------;; 
(defun Mat:DispToMatrix  (mat disp) 
  (append 
    (mapcar 'append mat (mapcar 'list disp)) 
    '((0. 0. 0. 1.)) 
  ) 
) 
 
 
 
 
 
 
 
 
 
 
 
 
 
(princ)

;;;另存为【~~~adds.dcl】

spacer_x : spacer {
height = 0.4;
width = 0.4;
horizontal_margin = none;
vertical_margin = none;
}
adds : dialog {
label = "为指定图块组复制关联选择集";
: boxed_column {
children_alignment = centered; width= 36; fixed_width = true;
//spacer_1;
: button {label= "指定关联选择集"; key= "sel_addss"; width= 24; fixed_width = true; height = 2.5;}
spacer_1;
//: row {
: button {label= "指定参照图块"; key= "sel_blk"; width= 24; fixed_width = true; height = 2.5;}
// : toggle {key = "sameco";label = "指定颜色";}
//}
spacer_1;
: button {label= "指定目标图块组"; key= "sel_blkss"; width= 24; fixed_width = true; height = 2.5;}
spacer_1;
}
: boxed_column {
spacer_x;
: row {
spacer_1;spacer_1;spacer_1;
: toggle {key = "rofollowblk"; label = "随目标图块旋转、镜像";}
spacer_1;
}
spacer_x;
: row {
spacer_1;spacer_1;spacer_1;
: toggle {key = "blksscosame"; label = "目标组与参照图块同色";}
spacer_1;
}
spacer_x;
}
spacer_1;
: row {
spacer_0;
: button {label = "取消"; key = "cancel"; is_cancel = true; width = 6; fixed_width=true; height = 1; }
spacer_0;
}
spacer_1;
}

spacer_x : spacer { 
    height = 0.4; 
    width = 0.4; 
    horizontal_margin = none; 
    vertical_margin = none; 
} 
 
 
 
adds : dialog { 
  label = "为指定图块组复制关联选择集"; 
  : boxed_column { 
    children_alignment = centered; width= 36; fixed_width = true; 
    //spacer_1; 
    : button {label= "指定关联选择集"; key= "sel_addss";  width= 24; fixed_width = true; height = 2.5;} 
    spacer_1; 
    //: row { 
      : button {label= "指定参照图块";   key= "sel_blk";    width= 24; fixed_width = true; height = 2.5;} 
    //  : toggle {key = "sameco";label = "指定颜色";} 
    //} 
    spacer_1; 
    : button {label= "指定目标图块组";   key= "sel_blkss";    width= 24; fixed_width = true; height = 2.5;} 
    spacer_1; 
  } 
  : boxed_column { 
    spacer_x; 
    : row { 
      spacer_1;spacer_1;spacer_1; 
      : toggle {key = "rofollowblk";  label = "随目标图块旋转、镜像";} 
      spacer_1; 
    } 
    spacer_x; 
    : row { 
      spacer_1;spacer_1;spacer_1; 
      : toggle {key = "blksscosame";  label = "目标组与参照图块同色";} 
      spacer_1; 
    } 
    spacer_x; 
  } 
  spacer_1; 
  : row { 
    spacer_0; 
    : button {label = "取消"; key = "cancel"; is_cancel = true; width = 6; fixed_width=true; height = 1; } 
    spacer_0; 
  } 
  spacer_1; 
}

edsion24 · 发表于 2021-7-9 11:12:11

命令: Abbs
未知命令“ABBS”。按 F1 查看帮助。

命令: ASR
DEFUN 语法错误: (MAT<IMG SRC= "static/image/smiley/default/biggrin.gif" SMILIEID= "3" BORDER= "0" ALT= "" />ISPTOMATRIX (MAT DISP) (APPEND (MAPCAR (QUOTE APPEND) MAT (MAPCAR (QUOTE LIST) DISP)) (QUOTE ((0.0 0.0 0.0 1.0)))))
命令:
命令: AS
DEFUN 语法错误: (MAT<IMG SRC= "static/image/smiley/default/biggrin.gif" SMILIEID= "3" BORDER= "0" ALT= "" />ISPTOMATRIX (MAT DISP) (APPEND (MAPCAR (QUOTE APPEND) MAT (MAPCAR (QUOTE LIST) DISP)) (QUOTE ((0.0 0.0 0.0 1.0)))))
命令:

masterlong · 发表于 2018-2-2 20:49:49

本帖最后由 masterlong 于 2021-7-4 17:12 编辑

经常用的一个小程序
未加入出错处理————————————————————已添加
扩展空间很大
比如根据图块的xyz比例复制时自动缩放、镜像
或者根据块的角度自动旋转———————————————旋转、镜像已添加，缩放感觉意义不大，未予支持
也可以加入图块的指定属性为复制条件等等

使用小技巧
对话框出现时直接按空格
相当于选中下一步操作的按钮

本来可以不用对话框
但是前两个操作（单选和多选）容易搞混
加个对话框对使用者来说比较清晰
而且对话框也便于今后扩展功能

差什么函数说一下

panliang9 · 发表于 2018-2-5 11:45:55

本帖最后由 panliang9 于 2018-2-5 12:12 编辑

@masterlong
楼主，这个工作的意思应该是选中一个参照块，然后再选一个块，就会根据前一个块的信息对后一个块做出旋转，缩放等动作是吧，但是我加载后输入
AS，还有ADDS命令，都没有任何反应！
我把前面DCL部分用文本另存为dcl文件，设置了支持文件搜索路径，也没有反应或者提示缺函数等等，是哪里没有做对呢！
请楼主再指点一下！

ruirui999 · 发表于 2018-2-3 19:55:56

我早就有这种了，很实用。建议不要用对话框，对话框没效率。

panliang9 · 发表于 2018-2-5 12:14:17

ruirui999 发表于 2018-2-3 19:55
我早就有这种了，很实用。建议不要用对话框，对话框没效率。

这样的好东西，能不能分享一下！

masterlong · 发表于 2018-2-5 13:42:31

先选择一组要复制的图元
再选择一个参照块
最后选择一组与参照同名的块
第1组图元以块心为基点进行复制

这是这个程序的功能
缩放镜像什么的
是可以扩展出来的功能

为什么设对话框已经说过了

对话框的名称 = ~~~adds.dcl

panliang9 · 发表于 2018-2-5 14:10:26

masterlong 发表于 2018-2-5 13:42
先选择一组要复制的图元
再选择一个参照块
最后选择一组与参照同名的块

成了，就是DCL文件命名的问题！谢谢楼主，后面看什么样的高频场景可以看这个功能用进去，甚至扩展！

masterlong · 发表于 2018-2-5 14:30:10

作为电气专业
这样的场景是相当多的
水、暖提资的消火栓、泵、风机啥的
我都习惯进行替换

当然不替换也不是不可以
但是不利于后面绘图过程中的图层控制

ghgh0130 · 发表于 2018-2-9 15:43:37

ghgh0130 · 发表于 2018-2-9 15:44:33

好东西

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

[源码] 相对块复制选择集，增加随目标块旋转镜像的功能【20210704更新】

浏览过的版块