TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: well20152016 on August 09, 2017, 08:10:02 PM
-
The block aligns the block according to the text number + the insertion point!
-
Nice interesting little project.
How many sets do you need to arrange ?
How many in each set usually ?
Is this ongoing repeat work or only for one project ?
Are the item ID numbers always sequential ?
I assume the corner ID numbers and the plate ID's don't repeat ?
Your detail does not actually join the edges, if so, what gap is required ?
I assume you want to select ALL the items in one arrangement and have the program put the assembly together automatically ?
Regards,
added:
Are there always only 4 numbered points per item ?
-
If the situation is perfect,There may be 2 / 4 / 6 / 8... Number sub items
-
;;Multi block near alignment
;;Author: Fools, 2017.8.12
;;Just for practice
(DEFUN C:RefAlign (/ ANG ELST ENT2 LST1 LST2 MAT PTS1 PTS2 SSG)
(SETQ ssg (SSGET '((0 . "INSERT"))))
(SETQ elst (F-Ss2Lst ssg))
;;Sort by X axis
(SETQ elst (VL-SORT elst '(LAMBDA (x1 x2) (< (CAR (F-Dxf 10 (ENTGET x1))) (CAR (F-Dxf 10 (ENTGET x2)))))))
(WHILE elst
;;First BlockReference
(SETQ lst1 (F-BlockPtToRef (CAR elst)))
(IF (SETQ ent2 (CADR elst))
(PROGN ;;Second BlockReference
(SETQ lst2 (F-BlockPtToRef (CADR elst)))
;;交集-返2 (same number on Second)
(SETQ pts2 (F-Change (MAPCAR 'CADR (VL-REMOVE-IF-NOT '(LAMBDA (x) (ASSOC (CAR x) lst1)) lst2))))
;;交集-返1 (same number on First)
(SETQ pts1 (F-Change (MAPCAR 'CADR (VL-REMOVE-IF-NOT '(LAMBDA (x) (ASSOC (CAR x) lst2)) lst1))))
(SETQ pts1 (F-Polar pts1)) ;_offset 300
;;Rotate angle
(SETQ ang (- (APPLY 'ANGLE pts1) (APPLY 'ANGLE pts2)))
;;Trans to 0,0 -> Rotate -> Trans from 0,0
(SETQ mat (MAT:mxm (Mat:Tv (CAR pts1)) (MAT:mxm (Mat:Rz ang) (Mat:Tv (MAPCAR '- (CAR pts2))))))
(VLA-TRANSFORMBY (VLAX-ENAME->VLA-OBJECT ent2) (VLAX-TMATRIX mat))
)
)
(SETQ elst (CDR elst))
)
(PRINC)
)
;;偏移300
;;offset 300
(DEFUN F-Polar (pts / ang)
(SETQ ang (- (APPLY 'ANGLE pts) (* 0.5 PI)))
(MAPCAR '(LAMBDA (x) (POLAR x ang 300.)) pts)
)
;;调整Y值较小点为起点
;;Sort by Y axis
(DEFUN F-Change (pts)
(IF (MINUSP (CADR (APPLY 'MAPCAR (CONS '- pts))))
pts
(REVERSE pts)
)
)
;;将图块定义中的点坐标转换为图块实例处的世界坐标
;;Trans block pt to wcs
(DEFUN F-BlockPtToRef (BlockRef / ENTLST LST MAT)
(SETQ entlst (ENTGET BlockRef))
(SETQ lst (F-BlockEnts BlockRef))
(SETQ mat (MAT:RefGeom BlockRef))
(MAPCAR '(LAMBDA (x) (LIST (CAR x) (CAR (LM:ApplyMatrixTransformation (CDR x) (CAR mat) (CADR mat)))))
lst
)
)
;;DXF
(DEFUN F-Dxf (num lst) (CDR (ASSOC num lst)))
;;遍历图块
;;Block Table
(DEFUN F-BlockEnts (BlockRef / ename entlst outlst)
(SETQ ename (CDR (ASSOC -2 (TBLSEARCH "BLOCK" (CDR (ASSOC 2 (ENTGET BlockRef)))))))
(SETQ outlst nil)
(WHILE ename
(SETQ entlst (ENTGET ename))
(IF (= "TEXT" (CDR (ASSOC 0 entlst)))
(SETQ outlst (CONS (LIST (F-Dxf 1 entlst) (F-Dxf 10 entlst)) outlst))
)
(SETQ ename (ENTNEXT ename))
)
outlst
)
;;ssget -> list
(DEFUN F-Ss2Lst (ss / n lst)
(SETQ lst nil)
(REPEAT (SETQ n (SSLENGTH ss)) (SETQ lst (CONS (SSNAME ss (SETQ n (1- n))) lst)))
lst
)
;;;-----------------------------------------------------------;;
;;; 矩阵转置 ;;
;;; MAT:trp Transpose a matrix -Doug Wilson- ;;
;;; 输入：矩阵 ;;
;;; 输出：转置后的矩阵 ;;
;;;-----------------------------------------------------------;;
(DEFUN MAT:trp (m) (APPLY 'MAPCAR (CONS 'LIST m)))
;;;-----------------------------------------------------------;;
;;; 矩阵相乘 ;;
;;; MAT:mxm Multiply two matrices -Vladimir Nesterovsky- ;;
;;;-----------------------------------------------------------;;
(DEFUN MAT:mxm (m q) (MAPCAR (FUNCTION (LAMBDA (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 (FUNCTION (LAMBDA (r) (APPLY '+ (MAPCAR '* r v)))) m))
;;矩阵绕Z轴旋转
;;Rotate around the Z axis
(DEFUN Mat:Rz (ang)
(LIST (LIST (COS ang) (- (SIN ang)) 0. 0.)
(LIST (SIN ang) (COS ang) 0. 0.)
'(0. 0. 1. 0.)
'(0. 0. 0. 1.)
)
)
;;;-----------------------------------------------------------;;
;;; 平移变换矩阵方式 ;;
;;; 参数: ;;
;;; v - 位移矢量 ;;
;;;-----------------------------------------------------------;;
;;;---------------=={ Translate by Matrix }==-----------------;;
;;; ;;
;;; Translation Matrix ;;
;;;-----------------------------------------------------------;;
;;; Author: highflybird, Copyright ? 2012 ;;
;;;-----------------------------------------------------------;;
;;; Arguments: ;;
;;; v - Displacement vector by which to translate ;;
;;;-----------------------------------------------------------;;
(DEFUN Mat:Tv (v)
(LIST (LIST 1. 0. 0. (CAR v)) (LIST 0. 1. 0. (CADR v)) (LIST 0. 0. 1. (CADDR v)) '(0. 0. 0. 1.))
)
;;;-----------------------------------------------------------;;
;;; 功能：图块的变换矩阵 ;;
;;; 输入：块参照的图元名 ;;
;;; 输出：块参照的变换矩阵 ;;
;;;-----------------------------------------------------------;;
;;; 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 (FUNCTION (LAMBDA (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))))))
)
)
)
;;;-----------------------------------------------------------;;
;;; 变换函数 ;;
;;; 参数: ;;
;;; target - vla-object 或者点 ;;
;;; matrix - 3x3 矩阵 ;;
;;; vector - 移动向量 ;;
;;;-----------------------------------------------------------;;
;;;----------=={ Apply Matrix Transformation }==--------------;;
;;; ;;
;;; Transforms a VLA-Object or Point List using a ;;
;;; Transformation Matrix ;;
;;;-----------------------------------------------------------;;
;;; Author: Lee Mac, Copyright ? 2010 - www.lee-mac.com ;;
;;;-----------------------------------------------------------;;
;;; Arguments: ;;
;;; target - VLA-Object or Point List to Transform ;;
;;; matrix - 3x3 Matrix by which to Transform object ;;
;;; vector - 3D translation vector ;;
;;;-----------------------------------------------------------;;
(DEFUN LM:ApplyMatrixTransformation (target matrix vector)
(COND ((EQ 'VLA-OBJECT (TYPE target))
(VLA-TRANSFORMBY
target
(VLAX-TMATRIX
(APPEND (MAPCAR (FUNCTION (LAMBDA (x v) (APPEND x (LIST v)))) matrix vector) '((0. 0. 0. 1.)))
)
)
)
((LISTP target)
(MAPCAR (FUNCTION (LAMBDA (point) (MAPCAR '+ (MAT:mxv matrix point) vector))) target)
)
)
)
(PRINC "\nType RefAlign to start!")
(PRINC)
-
Very nice 8)
-
Very nice !THANK!
-
@Ronjonp, Thanks for your encouragement.
@Well20152016, Glad to help you.
:-)
-
A difficult example?