Finding vertices of a polyline inside a block

[Anonymous]

Hi; I'm looking for a code/function/solution that gives the vertices of a polyline inside a block relatively to its position,rotation or something else. I write a code but when i copy the block to another place, and then the code gives me the same list. (point list that relatively to its basepoint) (sorry my language mistakes) Thanks...

[Anonymous]

With some useful codes I can exactly do what i want. (Thanks to @Lee_Mac ). You can see at the sample drawing.

The code that I wrote is below.

(defun c:trp ()

  
  (defun *error* ( msg )
    (if oldcmdecho (setvar "cmdecho" cmdecho))
    (if oldsnap (setvar "osmode" oldsnap))
  (if (not (member msg '("Function cancelled" "quit / exit abort")))
    (princ (strcat "\nError: " msg))
    )
  (princ)
  )


  
  (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
  (princ "\nDIKKAT! Bloklarda kapalı polyline içindeki bütün trimlenebilir objeler trimleneceği için öncesinde layiso ile trimlenmeyecek katmanları kapatmanız gerekmektedir. Extrim komutu ile trimlenemeyen çizgitipleri ve hatchler trimlenmeyebilir")
  (if (tblsearch "layer" "Trimlayer")
    (setq trimlayer "Trimlayer")
    (progn
      (setq trimlayer(getstring "\nLütfen içleri trimlenecek polylineların bulunduğu katman ismini girin"))
      (while (= (tblsearch "layer" trimlayer) nil)
        (setq trimlayer(getstring "\nLütfen geçerli bir katman ismini girin"))
        )
      )
    )
  (princ "\nLütfen trim yapılacak blokları seçin")
  (setq secim (ssget "_:L" '((0 . "INSERT"))))
  (command "._-layer" "ON" trimlayer "")
  (foreach objevla (mapcar 'vlax-ename->vla-object
                           (vl-remove-if 'listp (mapcar 'cadr (ssnamex secim)))
                   ) ;_ end of mapcar
    (setq blockname (vlax-get-property objevla 'name))
    (setq entlist (get-block-entities blockname))
    (setq oldcmdecho (getvar "cmdecho")
          oldsnap (getvar "osmode"))
    (setvar "cmdecho" 0)
    (setvar "osmode" 0)
       
    (foreach ent entlist
      (setq entvla (vlax-ename->vla-object ent))
      (setq layer (vlax-get-property entvla 'Layer))
      (if (= Trimlayer layer) ; exttrim polyline'i varsa noktalari alip transfer ediyoruz 
        (progn (setq noktalar (poly-pts entvla))
          ;;; Noktalari WCS ye transfer ediyoruz
          (setq noktalar (apply 'LM:ApplyMatrixTransformation
                                (cons noktalar (LM:WCS->Geom objevla))
                         ) ;_  end_of apply
          ) ;_  end_of setq
          ;;; Ettik :)

          (entmake
            (append
              (list '(0 . "LWPOLYLINE")
                    '(100 . "AcDbEntity")
                    '(100 . "AcDbPolyline")
                    (cons 90 (length noktalar))	; number of vertices
                    '(70 . 1)	; 1 = closed, 0 = opened
                    (cons 38 0)	; elevation
                    )
              (mapcar '(lambda (pt) (cons 10 pt)) noktalar)
              )
            )

          (setq trimpline (entlast))          
          (setq trimcenter (get_centroid trimpline))
          (load "extrim")
          (etrim trimpline trimcenter)
          (command "._erase" trimpline "")

          
          



          ) ; Progn
      ) ;If
    ) ;Foreach entvla    /// blok icindeki tum nesneler icin
  ) ;Foreach objvla /// tum bloklar icin

  (setvar "cmdecho" oldcmdecho)
  (setvar "osmode" oldsnap)
  (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
) ;Defun
    

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun get-block-entities (blk / ent lst)
  ;; Define the function, declare local variables
  (if ;; If the following returns a non-nil value
      ;; i.e. if the block exists in the drawing
      (setq ent (tblobjname "block" blk))
    ;; get the BLOCK entity
    (while (setq ent (entnext ent))
      ;; Step through the entities in the block definition
      (setq lst (cons ent lst))
      ;; Construct a list of the block components
    ) ;_  end_of while
    ;; end WHILE
  ) ;_  end_of if
  ;; end IF
  (reverse lst)
  ;; Return the list
) ;_  end_of defun
;; end DEFUN


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Poly-Pts (gile) (X-Y Modified)
;;; Returns the vertices list of any type of polyline (WCS coordinates)
;;;
;;; Argument
;;; pl : a polyline (ename or vla-object)

(defun Poly-Pts (pl / pa pt lst)
  (vl-load-com)
  (setq pa (if (vlax-curve-IsClosed pl)
             (vlax-curve-getEndParam pl)
             (+ (vlax-curve-getEndParam pl) 1)
           ) ;_  end_of if
  ) ;_  end_of setq
  (while (setq pt (vlax-curve-getPointAtParam pl (setq pa (- pa 1))))
    (setq pt (list (car pt) (cadr pt)))
    (setq lst (cons pt lst))
  ) ;_  end_of while
) ;_  end_of defun






;;---------------------=={ WCS->Geom }==----------------------;;
;; ;;
;; Returns the Transformation Matrix and Translation Vector ;;
;; for transforming Block Definition Geometry to a Block ;;
;; Reference. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; SourceBlock - VLA Block Reference Object ;;
;;------------------------------------------------------------;;
;; Returns: List of 3x3 Transformation Matrix, Vector ;;
;;------------------------------------------------------------;;

(defun LM:WCS->Geom ( SourceBlock / norm ang x y z )
;; © Lee Mac 2010
(vl-load-com)

(setq norm (vlax-get SourceBlock 'Normal)
ang (vla-get-rotation SourceBlock))

(mapcar 'set '(x y z)
(mapcar
'(lambda ( prop alt )
(vlax-get-property SourceBlock
(if (vlax-property-available-p SourceBlock prop) prop alt)
)
)
'(XEffectiveScaleFactor YEffectiveScaleFactor ZEffectiveScaleFactor)
'(XScaleFactor YScaleFactor ZScaleFactor )
)
)
(
(lambda ( m )
(list m
(mapcar '- (vlax-get SourceBlock 'InsertionPoint)
(mxv m
(cdr (assoc 10 (tblsearch "BLOCK" (vla-get-name SourceBlock))))
)
)
)
)
(mxm
(mapcar '(lambda ( e ) (trans e 0 norm t))
'((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
)
(mxm
(list
(list (cos ang) (sin (- ang)) 0.)
(list (sin ang) (cos ang) 0.)
(list 0. 0. 1.)
)
(list
(list x 0. 0.)
(list 0. y 0.)
(list 0. 0. z)
)
)
)
)
)

;;-----------=={ 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 ) (vl-load-com)
;; © Lee Mac 2010
(cond
( (eq 'VLA-OBJECT (type target))

(vla-TransformBy target
(vlax-tMatrix
(append (mapcar '(lambda ( x v ) (append x (list v))) matrix vector)
'((0. 0. 0. 1.))
)
)
)
)
( (listp target)

(mapcar
(function
(lambda ( point ) (mapcar '+ (mxv matrix point) vector))
)
target
)
) 
)
)

;; Matrix x Vector - Lee Mac 2010
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Matrix x Matrix - Lee Mac 2010
;; Args: m,n - nxn matrices

(defun mxm ( m n )
( (lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)

;; Matrix Transpose - Lee Mac 2010
;; Args: m - nxn matrix

(defun trp ( m )
(apply 'mapcar (cons 'list m))
);
;|«Visual LISP© Format Options»
(96 2 1 2 T " end_of " 80 9 0 0 2 nil nil nil T)
;*** DO NOT add text below the comment! ***|;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get_centroid (ename / ename obj centroid)
  (command "region" ename "")
  (setq ename (entlast))
  (setq obj (vlax-ename->vla-object ename))
  (setq centroid (vlax-safearray->list (vlax-variant-value (vla-get-centroid obj))))
  (command "undo" "")
  (princ)
  centroid
) ;_  end_of defun