Lisp for formatting drawing

[batony]

Hi CADTutor forum!

 

I'm really new in lips, i I would like to make a lips what can do the next steps:

 

1, all layer color -> set 252

2, all object color -> set by layer

3, if the linewight bigger then 0,25, select and modify 0,25

4, select all point and rotated dimension, -> delet all

5, right out„ do you want delete all wipeout? yes/no” if yes do incude blocks, if no go next

6, select all hatch what type is „ansi33” (hatch pattern palette), set them color red (index color 1)

7, delete all layouts

8, delete all text and mtext if „text height” more then 1499

9, purge all

 

(the most of these steps i got in custom command but the lips is better way to work faster)

 

Big thanks for helping me!

[Emmanuel Delay]

I have half of those requests

TODO: 1, 3, 5

Elaborate on issue 5 please

	;; 1, all layer color -> set 252
;; 2, all object color -> set by layer
;; 3, if the linewight bigger then 0,25, select and modify 0,25
;; 4, selec?t all point and rotated dimension, -> delet al?l?
;; 5, right out„ do you want delete all wipeout? yes/no” if yes do incude blocks, if no go next
;; 6, select all hatch what type is „ansi33” (hatch pattern palette), set them color re?d (index color 1)
;; 7, ?delete all layouts?
;; 8, delete all text and mtext if „text height” more then 1499?
;; 9, purge all
	(vl-load-com)
	;; FD for Format Dwg
(defun c:fd ( / )
    ;; 1
    ;; 2
  (set2bylayer)
    ;;3
    ;;4
  (deletePointsAndRotateddims)
    ;; 5
    ;; 6
  (makeHatchRedAgain)
    ;; 8
  (deleteBigTexts)
    ;; 7 & 9
  (deleteAllLayoutsAndPurge)
)
	;; Lee Mac - @see https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-delete-all-layouts-then-purge/td-p/5227633
(defun deleteAllLayoutsAndPurge ( / yesconfirm)
    ;;(initget "Yes No")
    ;;(setq yesconfirm (getkword "\nDelete all layouts & purge? [Yes/No] <Yes>: ") )
    (setq yesconfirm "Yes")
    (if (/= "No" yesconfirm)
        (progn
            (vlax-for l (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
                (if (/= (vla-get-name l) "Model")
                    (vla-delete l)
                )
            )
            (command
                "_.-layer" "_t" "0" "_s" "0" ""
                "_.-purge" "_r" "*" "_n"
                "_.-purge" "_a" "*" "_n"
                "_.audit" "_y"
                "_.-purge" "_a" "*" "_n"
            )
        )
        (princ "\nAll layouts remain. Nothing has been purged.")
    )
    (princ)
)
	(defun deleteBigTexts ( / i texts)  
  (if (setq texts (ssget "_X" '((0 . "TEXT,MTEXT") ))) (progn
    (setq i 0)
    (repeat (sslength texts)
      (if (> (cdr (assoc 40 (entget (ssname texts i)))) 1499.0 )
        (entdel  (ssname texts i))
      )
      (setq i (+ i 1))
    )
  ))
)
	(defun makeHatchRedAgain ( / i hatches)
  (if (setq hatches (ssget "_X" '((0 . "HATCH") (2 . "ANSI33")))) (progn
    (setq i 0)
    (repeat (sslength hatches)
    (vla-put-color (vlax-ename->vla-object (ssname hatches i))  1)
    (setq i (+ i 1))
    )
  ))
)
	;; "AcDbAlignedDimension" => aligned with the objects
;; "AcDbRotatedDimension" => horizontal or vertical dimensions
(defun deletePointsAndRotateddims ( / i toDelete)
  (if (setq toDelete (ssget "_X" '((0 . "POINT")))) (progn
  (setq i 0)
  (repeat (sslength toDelete)
    (entdel  (ssname toDelete i))
    (setq i (+ i 1))
  )
  ))
  ;; select only rotated dimensions - http://forums.augi.com/showthread.php?52176-Lisp-to-select-only-Rotated-Dimensions
  (if (setq toDelete (ssget "_X" '((0 . "DIMENSION") ))) (progn
  (setq i 0)
  (repeat (sslength toDelete)
    (if (= "AcDbAlignedDimension" (vla-get-ObjectName (vlax-ename->vla-object (ssname toDelete i))))
      (entdel  (ssname toDelete i))
    )
    (setq i (+ i 1))
  )
  ))
)
	;; Lee Mac
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/a-lisp-to-make-all-entities-color-quot-by-layer-quot/td-p/4840793
(defun set2bylayer ( / d )
    (vlax-for b (vla-get-blocks (setq d (vla-get-activedocument (vlax-get-acad-object))))
        (if (and (= :vlax-false (vla-get-isxref b)) (not (wcmatch (vla-get-name b) "`*D*,_*")))
            (vlax-for o b (vl-catch-all-apply 'vla-put-color (list o acbylayer)))
        )
    )
    (vla-regen d acallviewports)
    (princ)
)
(princ)
	

[batony]

thx for help!

1, but its look like the lips stop after the 3. purge (see picture)

2, i modified the command to: (its make all layer color 252, unlock, unfreeze, on)

(command

	                "_.-layer" "_t" "*" "_s" "0" "_u" "*" "_on" "*" "_c" "252" "*" ""

	                "_.-purge" "_r" "*" "_n"

	                "_.-purge" "_a" "*" "_n"

	                "_.audit" "_y"

	                "_.-purge" "_a" "*" "_n"

	            )[code]

3, select only rotated dimensions-its work for me if i delet the 4. row

(if (setq toDelete (ssget "_X" '((0 . "DIMENSION") ))) (progn
  (setq i 0)
  (repeat (sslength toDelete)
     (entdel  (ssname toDelete i))
    (setq i (+ i 1))
  )
  ))

4, \\5.1 new\\ i used this Command string: ^C^C^C_hatsel;change;p;c;254;;  (it will make all hatch color 242, but in block not...) how can i take it in one lips?

(defun c:hatsel (/ sset)
(ssget "X" (list (cons 0 "HATCH")))
(setq sset (ssget "P"))
(sssetfirst sset sset)
(princ)
)

[ronjonp]

Try this .. untested.

(defun c:foo (/ a d)
  ;; RJP » 2018-08-22
  (setq d (vla-get-activedocument (vlax-get-acad-object)))
  ;; Remove all layouts
  (vlax-for l (vla-get-layouts d) (vl-catch-all-apply 'vla-delete (list l)))
  ;; Unlock layers and make color 252
  (vlax-for l (vla-get-layers d)
    (vla-put-color l 252)
    (cond ((= -1 (vlax-get l 'lock)) (vlax-put l 'lock 0) (setq a (cons l a))))
  )
  (vlax-for b (vla-get-blocks d)
    (if	(= 0 (vlax-get b 'isxref))
      (vlax-for	o b
	(cond
	  ((vlax-write-enabled-p o)
	   ;; Color bylayer
	   (vla-put-color o 256)
	   ;; If the lineweight is greater than 25 set to bylayer?
	   (and (> 25 (vla-get-lineweight o)) (vla-put-lineweight o -1))
	   ;; Delete points and aligned dimensions
	   (cond ((wcmatch (vla-get-objectname o) "AcDbAlignedDimension,AcDbPoint") (vla-delete o))
		 ;; ANSI33 hatch to color 1
		 ((and (wcmatch (vla-get-objectname o) "AcDbHatch")
		       (= "ANSI33" (vla-get-patternname o))
		  )
		  (vla-put-color o 1)
		 )
		 ;; Delete text with height greater than 1499
		 ((and (wcmatch (vla-get-objectname o) "AcDbText,AcDbMText")
		       (< 1499 (vla-get-height o))
		  )
		  (vla-delete o)
		 )
		 ;; Delete wipeouts .. lets see if you can add the option ;)
		 ((and (wcmatch (vla-get-objectname o) "AcDbWipeout")) (vla-delete o))
	   )
	  )
	)
      )
    )
  )
  ;; Relock layers
  (foreach l a (vlax-put l 'lock -1))
  ;; Purge 3 times
  (repeat 3 (vla-purgeall d))
  ;; Regen to see changes
  (vla-regen d acallviewports)
  (princ)
)
(vl-load-com)

 

Edited August 22, 2018 by ronjonp

[batony]

Thx emmanuel work me 100% yours code

 

someone can help to edit this?

https://forums.autodesk.com/t5/autocad-forum/select-all-hatches-with-lisp/td-p/2123357

i I would like to select all hatch and modifi them color to 254

(defun c:teszt1 ( / )

	 (if (setq hatches (ssget "_X" '((0 . "HATCH") ))) (progn

	    (setq i 0)

	    (repeat (sslength hatches)

	    (vla-put-color (vlax-ename->vla-object (ssname hatches i))  3)

	    (setq i (+ i 1))

	    )

	  ))

	)

	)[CODE]

it run and work but got error message when load ("extra right paren on input") what i miss?

 

here code for setbylayer all "lineweight" its dont work

(defun c:test2 ( / )

	(command

	      "_.-setbylayer" "_a" "" "_y" "_y" ""

	)

	)

[CODE]

 

 

Edited August 23, 2018 by batony

[ronjonp]

14 minutes ago, batony said:

Thx emmanuel work me 100% yours code

 

someone can help to edit this?

Did you even try this?

 

[Emmanuel Delay]

In both our codes (ronjonp's code solves more issues than mine, so it looks like), 
this turns hatch of type "ANSI33" to color 1 (red).  

[code]
  ((and (wcmatch (vla-get-objectname o) "AcDbHatch")
       (= "ANSI33" (vla-get-patternname o))
    )
    (vla-put-color o 1)
  )
[/code]

Change it to this in order to make all hatches color 254

[code]
  ((wcmatch (vla-get-objectname o) "AcDbHatch")   
    (vla-put-color o 254)
  )
[/code]

[batony]

I cant insert 2 step in my big lsp

;;allhatchcolor254

;;makehatchredagain

 

[/code]

;; 1, all layer color -> set 252
;; 2, all object color -> set by layer
;; 3, if the linewight bigger then 0,25, select and modify 0,25
;; 4, selec?t all point and rotated dimension, -> delet al?l?
;; 5, right out„ do you want delete all wipeout? yes/no” if yes do incude blocks, if no go next
;; 6, select all hatch what type is „ansi33” (hatch pattern palette), set them color re?d (index color 1)
;; 7, ?delete all layouts?
;; 8, delete all text and mtext if „text height” more then 1499?
;; 9, purge all
    (vl-load-com)
    ;; FD for Format Dwg
(defun c:fd ( / )
    ;; 1
    ;; 2
  (set2bylayer)
    ;;3
    ;;4
  (deletePointsAndRotateddims)
    ;; 5
    ;; 6
  (makeHatchRedAgain)
    ;; 8
  (deleteBigTexts)
    ;; 7 & 9
  (deleteAllLayoutsAndPurge)
)
    ;; Lee Mac - @see https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-delete-all-layouts-then-purge/td-p/5227633
(defun deleteAllLayoutsAndPurge ( / yesconfirm)
    ;;(initget "Yes No")
    ;;(setq yesconfirm (getkword "\nDelete all layouts & purge? [Yes/No] <Yes>: ") )
    (setq yesconfirm "Yes")
    (if (/= "No" yesconfirm)
        (progn
            (vlax-for l (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
                (if (/= (vla-get-name l) "Model")
                    (vla-delete l)
                )
            )
            (command
                "_.-layer" "_t" "*" "_s" "0" "_u" "*" "_on" "*" "_c" "252" "*" ""
                "_.-purge" "_r" "*" "_n"
                "_.-purge" "_a" "*" "_n"
                "_.audit" "_y"
                "_.-purge" "_a" "*" "_n"
            )
        )
      )
 )
        (defun deleteBigTexts ( / i texts)  
  (if (setq texts (ssget "_X" '((0 . "TEXT,MTEXT") ))) (progn
    (setq i 0)
    (repeat (sslength texts)
      (if (> (cdr (assoc 40 (entget (ssname texts i)))) 1499.0 )
        (entdel  (ssname texts i))
      )
      (setq i (+ i 1))
    )
  ))
)
    (defun makeHatchRedAgain ( / i hatches)
  (if (setq hatches (ssget "_X" '((0 . "HATCH") (2 . "ANSI33")))) (progn
    (setq i 0)
    (repeat (sslength hatches)
    (vla-put-color (vlax-ename->vla-object (ssname hatches i))  1)
    (setq i (+ i 1))
    )
  ))
)
    ;; "AcDbAlignedDimension" => aligned with the objects
;; "AcDbRotatedDimension" => horizontal or vertical dimensions
(defun deletePointsAndRotateddims ( / i toDelete)
  (if (setq toDelete (ssget "_X" '((0 . "POINT")))) (progn
  (setq i 0)
  (repeat (sslength toDelete)
    (entdel  (ssname toDelete i))
    (setq i (+ i 1))
  )
  ))
  ;; select dimensions
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if (tblsearch "DIMSTYLE" "Standard")
    (command "-DIMSTYLE" "R" "Standard")
  )

  (vlax-for blk    (vla-get-blocks aDoc)
    (if
      (eq :vlax-false (vla-get-isXref blk))
       (vlax-for h blk
     (cond
       ((and (vlax-write-enabled-p h)
         (vl-string-search "Dimension" (vla-get-ObjectName h))
        )
        (vla-delete h)
       )

     )
       )
    )
  )
  (repeat 4 (vla-purgeall aDoc))
)
(vl-load-com)
    ;; Lee Mac
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/a-lisp-to-make-all-entities-color-quot-by-layer-quot/td-p/4840793
(defun set2bylayer ( / d )
    (vlax-for b (vla-get-blocks (setq d (vla-get-activedocument (vlax-get-acad-object))))
        (if (and (= :vlax-false (vla-get-isxref b)) (not (wcmatch (vla-get-name b) "`*D*,_*")))
            (vlax-for o b (vl-catch-all-apply 'vla-put-color (list o acbylayer)))
        )
    )
    (vla-regen d acallviewports)
    (princ)
)
(princ)

 

[/code]

 

[ronjonp]

HELLO.