Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 05/05/2019 in all areas

  1. 1 point
  2. You can use a similar methodology as suggested in this post, but change the list of displacements & vectors to: (foreach itm (list (list (list (getvar 'dimscale) 0.0 0.0) '(0.0 1.0 0.0)) (list (list 0.0 (- (getvar 'dimscale)) 0.0) '(1.0 0.0 0.0)) ) (apply '(lambda ( dsp vec ) ...
    1 point
  3. Do you mean move the vertical xline in the positive x-direction, and move the horizontal xline in the negative y-direction, both by a distance equal to the DIMSCALE system variable?
    1 point
  4. I would probably approach it like this: (foreach itm '( (( 0.0 0.0 0.0) (1.0 0.0 0.0)) (( 0.0 0.0 0.0) (0.0 1.0 0.0)) ((50.0 0.0 0.0) (0.0 1.0 0.0)) ) (apply '(lambda ( dsp vec ) (entmake (list '(000 . "XLINE") '(100 . "AcDbEntity") '(100 . "AcDbXline") (cons 10 (mapcar '+ cen dsp)) (cons 11 vec) ) ) ) itm ) )
    1 point
  5. Here's a quick one using a lot of existing code - (defun c:blkxl ( / cen idx lst sel ) (if (setq sel (ssget '((0 . "INSERT")))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) lst (LM:blockreferenceboundingbox (vlax-ename->vla-object (ssname sel idx))) ) (if (and lst (setq cen (mapcar '/ (apply 'mapcar (cons '+ lst)) '(4.0 4.0 4.0)))) (foreach vec '((1.0 0.0 0.0) (0.0 1.0 0.0)) (entmake (list '(000 . "XLINE") '(100 . "AcDbEntity") '(100 . "AcDbXline") (cons 10 cen) (cons 11 vec) ) ) ) ) ) ) (princ) ) ;; Block Reference Bounding Box - Lee Mac ;; Returns a WCS point list describing a rectangular frame bounding all geometry of a supplied block reference. ;; Excludes Text, MText & Attribute Definitions. ;; ref - [vla] Block Reference Object (defun LM:blockreferenceboundingbox ( ref ) ( (lambda ( lst ) (apply (function (lambda ( m v ) (mapcar (function (lambda ( p ) (mapcar '+ (mxv m p) v))) lst) ) ) (refgeom (vlax-vla-object->ename ref)) ) ) (LM:blockdefinitionboundingbox (vla-item (vla-get-blocks (vla-get-document ref)) (vla-get-name ref) ) ) ) ) ;; Block Definition Bounding Box - Lee Mac ;; Returns a WCS point list describing a rectangular frame bounding all geometry of a supplied block definition. ;; Excludes Text, MText & Attribute Definitions. ;; def - [vla] Block Definition Object (defun LM:blockdefinitionboundingbox ( def / llp lst urp ) (vlax-for obj def (cond ( (= :vlax-false (vla-get-visible obj))) ( (= "AcDbBlockReference" (vla-get-objectname obj)) (setq lst (append lst (LM:blockreferenceboundingbox obj))) ) ( (and (not (wcmatch (vla-get-objectname obj) "AcDbAttributeDefinition,AcDb*Text")) (vlax-method-applicable-p obj 'getboundingbox) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp)))) ) (setq lst (vl-list* (vlax-safearray->list llp) (vlax-safearray->list urp) lst)) ) ) ) (LM:points->boundingbox lst) ) ;; Points to Bounding Box - Lee Mac ;; Returns the rectangular extents of a supplied point list (defun LM:points->boundingbox ( lst ) ( (lambda ( l ) (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) l)) a)) '( (caar cadar) (caadr cadar) (caadr cadadr) (caar cadadr) ) ) ) (mapcar '(lambda ( f ) (apply 'mapcar (cons f lst))) '(min max)) ) ) ;; 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, block or space) ;; Argument : an ename (defun refgeom ( ent / ang ang mat ocs ) (setq enx (entget ent) ang (cdr (assoc 050 enx)) 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)))))) ) ) ) ;; 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) ) ;; 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)) ) (vl-load-com) (princ)
    1 point
×
×
  • Create New...