;|

R.K. McSwain, Copyright © 2012 - cadpanacea.com

|;

(defun C:PMP ( / fname cnt i)  
  (setq fname (getfiled "\nSelect Multisheet PDF File" (getvar "dwgprefix") "PDF" 0))
  (setq cnt (getint "\nNumber of sheets in this PDF to place ") i 1)
  (if fname
    (repeat cnt
      (vl-cmdf "-pdfattach" fname i (getpoint "\nPick LL point for next sheet ") 1.0 0.0)
      (setq i (1+ i))
    ) 
  )
  (princ)
)

;; Lee Mac
;; ONLY WORKS ON DTEXT
;; Found @ http://www.theswamp.org/index.php?topic=37429.0
(defun c:isotext ( / e i j k)
  (vl-load-com)
 ;(setq i (/ pi 6.) j -1.)
  (setq i 0 k (/ pi 6.) j -1.)
  ;; © Lee Mac 2011
  (if
    (and
      (setq e (car (entsel "\nSelect Text: ")))
      (eq (vla-get-Objectname (setq e (vlax-ename->vla-object e))) "AcDbText")
      (princ "\nPress [Tab] to Change Projection <Accept>")
    )      
    (while (= 9 (cadr (grread nil 14 0)))
     ;(vla-put-rotation     e i)
      (vla-put-rotation     e (* k (1- (* 2 (setq i (rem (+ i (max 0 (setq j (- j)))) 3))))))
     ;(vla-put-obliqueangle e (setq i (* i (setq j (- j)))))
      (vla-put-obliqueangle e (* j k))
    )
  )
  (princ)
)

;;; OB2WO (gile) -Gilles Chanteau- 10/03/07
;;; Creates a "Wipeout" from an object (circle, ellipse, or polyline with arcs)
;;; Works whatever the current ucs and object OCS

(defun c:ob2wo (/ ent lst nor)
  (vl-load-com)
  (if (and (setq ent (car (entsel)))
	   (member (cdr (assoc 0 (entget ent)))
		   '("CIRCLE" "ELLIPSE" "LWPOLYLINE")
	   )
	   (setq lst (ent2ptlst ent))
	   (setq nor (cdr (assoc 210 (entget ent))))
      )
    (progn
      (vla-StartundoMark
	(vla-get-ActiveDocument (vlax-get-acad-object))
      )
      (makeWipeout lst nor)
      (initget "Yes No")
      (if
	(= (getkword "\nDelete source object? [Yes/No] <No>: ")
	   "Yes"
	)
	 (entdel ent)
      )
      (vla-EndundoMark
	(vla-get-ActiveDocument (vlax-get-acad-object))
      )
    )
  )
)


;;; ENT2PTLST
;;; Returns the vertices list of the polygon figuring the curve object
;;; Coordinates defined in OCS

(defun ent2ptlst (ent / obj dist n lst p_lst prec)
  (vl-load-com)
  (if (= (type ent) 'ENAME)
    (setq obj (vlax-ename->vla-object ent))
  )
  (cond
    ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE"))
     (setq dist	(/ (vlax-curve-getDistAtParam
		     obj
		     (vlax-curve-getEndParam obj)
		   )
		   50
		)
	   n	0
     )
     (repeat 50
       (setq
	 lst
	  (cons
	    (trans
	      (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
	      0
	      (vlax-get obj 'Normal)
	    )
	    lst
	  )
       )
     )
    )
    (T
     (setq p_lst (vl-remove-if-not
		   '(lambda (x)
		      (or (= (car x) 10)
			  (= (car x) 42)
		      )
		    )
		   (entget ent)
		 )
     )
     (while p_lst
       (setq
	 lst
	  (cons
	    (append (cdr (assoc 10 p_lst))
		    (list (cdr (assoc 38 (entget ent))))
	    )
	    lst
	  )
       )
       (if (/= 0 (cdadr p_lst))
	 (progn
	   (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst))))))
		 dist (/ (- (if	(cdaddr p_lst)
			      (vlax-curve-getDistAtPoint
				obj
				(trans (cdaddr p_lst) ent 0)
			      )
			      (vlax-curve-getDistAtParam
				obj
				(vlax-curve-getEndParam obj)
			      )
			    )
			    (vlax-curve-getDistAtPoint
			      obj
			      (trans (cdar p_lst) ent 0)
			    )
			 )
			 prec
		      )
		 n    0
	   )
	   (repeat (1- prec)
	     (setq
	       lst (cons
		     (trans
		       (vlax-curve-getPointAtDist
			 obj
			 (+ (vlax-curve-getDistAtPoint
			      obj
			      (trans (cdar p_lst) ent 0)
			    )
			    (* dist (setq n (1+ n)))
			 )
		       )
		       0
		       ent
		     )
		     lst
		   )
	     )
	   )
	 )
       )
       (setq p_lst (cddr p_lst))
     )
    )
  )
  lst
)


;;; MakeWipeout creates a "wipeout" from a points list and the normal vector of the object

(defun MakeWipeout (pt_lst nor / dxf10 max_dist cen dxf_14)

  (setq	dxf10 (list (apply 'min (mapcar 'car pt_lst))
		    (apply 'min (mapcar 'cadr pt_lst))
		    (caddar pt_lst)
	      )
  )
  (setq
    max_dist
     (float
       (apply 'max
	      (mapcar '- (apply 'mapcar (cons 'max pt_lst)) dxf10)
       )
     )
  )
  (setq cen (mapcar '+ dxf10 (list (/ max_dist 2) (/ max_dist 2) 0.0)))
  (setq
    dxf14 (mapcar
	    '(lambda (p)
	       (mapcar '/
		       (mapcar '- p cen)
		       (list max_dist (- max_dist) 1.0)
	       )
	     )
	    pt_lst
	  )
  )
  (setq dxf14 (reverse (cons (car dxf14) (reverse dxf14))))
  (entmake (append (list '(0 . "WIPEOUT")
			 '(100 . "AcDbEntity")
			 '(100 . "AcDbWipeout")
			 '(90 . 0)
			 (cons 10 (trans dxf10 nor 0))
			 (cons 11 (trans (list max_dist 0.0 0.0) nor 0))
			 (cons 12 (trans (list 0.0 max_dist 0.0) nor 0))
			 '(13 1.0 1.0 0.0)
			 '(70 . 7)
			 '(280 . 1)
			 '(71 . 2)
			 (cons 91 (length dxf14))
		   )
		   (mapcar '(lambda (p) (cons 14 p)) dxf14)
	   )
  )
)

;;; file: RB.lsp                                                    ;;;
;;; data: 22/10/2008                                                ;;;
;;; note: rinomina il blocco selezionato                            ;;;
;;;                                                                 ;;;
;;; aggiornamento: (Versione 2) - 01/04/2009                        ;;;
;;;              - default sulla casella OK                         ;;;
;;;              - controllo esistenza nome blocco                  ;;;
;;;                                                                 ;;;
;;; aggiornamento: (Versione 3) - 02/04/2009                        ;;;
;;;              - allargata casella editazione nome blocco         ;;;
;;;                                                                 ;;;
;;; aggiornamento: (Versione 4) - 28/10/2012                        ;;;
;;;              - rinomina blocchi dinamici e blocchi anonimi      ;;;
;;;              - creazione di blocchi anonimi                     ;;;
;;;              - inglobamento DCL nel lisp                        ;;;
;;;                                                                 ;;;
;;; autore: Gian Paolo Cattaneo                                     ;;;


(defun c:RB (/ :bb old new dcl_id)

    (prompt "\n ") (prompt "\n ") (prompt "\n ")
    (if
        (while (not :bb)
            (setvar 'errno 0)
            (setq :bb (car (entsel "\nSelezionare il Blocco da Rinominare")))
            (if (= 7 (getvar 'errno))
                (alert "Nessun oggetto selezionato")
            )
            (if (= 'ename (type :bb))
                (if (null (wcmatch (cdr (assoc 0 (entget :bb))) "INSERT"))
                    (progn
                        (alert "L'oggetto non è un Blocco")
                        (setq :bb nil)
                    )
                    (progn
                        (setq old (vla-get-effectivename (vlax-ename->vla-object :bb)))
                    )
                )
            )
        )
        (progn
            (RB_dcl)
            (while
                (and
                    (/= (strcase old) (strcase new))
                    (tblsearch "BLOCK" new)
                )
                (alert "Un blocco con questo nome esiste già")
                (RB_dcl)
            )
            (vla-put-Name
                (vla-item
                    (vla-get-blocks
                        (vla-get-activedocument
                            (vlax-get-acad-object)
                        )
                    )
                    old
                )
                new
            )
        )
    )
    (prompt "\n ") (prompt "\n ") (prompt "\n ")
    (princ)
)


(defun RB_dcl ( / DCLname)
    (setq DCLname (strcat (getvar 'localrootprefix) "RB_V4.dcl"))
    (if (not (findfile DCLname)) (crea_dcl_RB))   
    (if (= POSIZ_DCL_RB nil) (setq POSIZ_DCL_RB (list -1 -1)))   
    (setq dcl_id (load_dialog DCLname))       
    (if (not (new_dialog "RB4" dcl_id "" POSIZ_DCL_RB)) (exit))    
    (setq new old)
    (set_tile "new" new)
    (action_tile "new" "(setq new $value)")
    (start_dialog)
    (unload_dialog dcl_id)
)


(defun crea_dcl_RB (/ fn f)
    (setq fn  DCLname)
    (setq f (open fn "w"))
    (write-line "RB4:dialog {" f)
    (write-line "label = \"RB - Rinomina Blocco (Vers. 4)\";" f)
    (write-line "" f)
    (write-line "    initial_focus=\"new\";" f)
    (write-line "" f)
    (write-line "    : spacer {}" f)
    (write-line "    : spacer {}" f)
    (write-line "    : spacer {}" f)
    (write-line "" f)
    (write-line "    : text {" f)
    (write-line "    label = \"Nuovo Nome Blocco:\";" f)
    (write-line "    alignment = centered;" f)
    (write-line "    } " f)
    (write-line "" f)
    (write-line "    : text {" f)
    (write-line "    label = \"(digitare:  *U  per creare un Blocco Anonimo)\";" f)
    (write-line "    alignment = centered;" f)
    (write-line "    } " f)
    (write-line "" f)
    (write-line "    : spacer {}" f)
    (write-line "" f)    
    (write-line "    : edit_box {" f)
    (write-line "    key=\"new\";" f)
    (write-line "    allow_accept=true;" f)
    (write-line "    }" f)
    (write-line "" f)
    (write-line "    : spacer {}" f)
    (write-line "    : spacer {}" f)
    (write-line "    : spacer {}" f)
    (write-line "" f)
    (write-line "    ok_only;" f)
    (write-line "" f)
    (write-line "    : spacer {}" f)
    (write-line "    : spacer {}" f)
    (write-line "    : spacer {}" f)
    (write-line "" f)
    (write-line "    : text { " f)
    (write-line "    label = \"Copyright  ©  2012  -  Gian Paolo Cattaneo\";" f)
    (write-line "    alignment = centered;" f)
    (write-line "    }" f)
    (write-line "" f)
    (write-line "}" f)
    (close f)
    (load_dialog fn)
)

;******************************************************************************

(vl-load-com)

(prompt "\n ") (prompt "\n ") (prompt "\n ")
(princ "\nRinominare un Blocco (V.4) - by Gian Paolo Cattaneo")
(princ "\nDigitare RB per lanciare il lisp")
(princ)