Leaderboard

if you want to ignore a color and set everything else back to byblock. (vlax-for x blk (if (/= (vla-get-color x) #) ;if not color purple # change it back to byblock (vla-put-Color x 0) ) (vla-put-linetype x "ByLayer") ;line type must be loaded to work (vla-put-linetypescale x #) ) Same, coming here each day is mostly to learn from everyone and have some light bulb moments from time to time if I'm lucky. just so happened to have this lisp already made up just had to edit it a little bit.

Why do you list AutoCAD 2021 as your software in your profile? Can you see now how that makes it difficult for others to help you? Mine says Civil 3D 2021 because that's the software I use everyday. Lots of others on here using similar software but not AutoCAD who offer help on here everyday like mhupp but none of them know what software you're using. Update your profile!

I am not brilliant at VLA, however in mhupps code above he has this which is the settings when you exit the refedit (if (/= (getvar 'refeditname) "") (progn (setq blk (vla-item (vla-get-blocks Drawing) (getvar 'refeditname))) (vl-cmdf "_.Refclose" "S") (vlax-for x blk (vla-put-Color x 0) ) (vla-Regen Drawing acAllViewports) ) If you add the settings you want in this part of the code then that should set up what you want as you exit. (vlax-for x blk (vla-put-Color x 0) ;; - ADDING THIS FOR LINETYPE AS AN EXAMPLE. THE LINE TYPE HAS TO BE LOADED FOR THIS TO WORK (vla-put-Linetype x "DASHDOT") ;; ) vla-put-Color x 0, change the '0' for the colour code you want if you want it all to be purple. I think vla-put-linetypescale doeslinetype scale... follow the above to add that in. Pretty sure I am going to be corrected in a moment or 2, but try that as a start

@NiccoLo, For better understanding, and maybe get further help, please upload such sample.dwg and LSP

thanks for your great code, it's helpful for me. I often use this routine, after Dimensioning Multiple Segments of a Polyline Lisp (DPI DPO). so, this is just little bit minor change of rlm's code, edit entsel to ssget for do this routine to multiple objects in one procedure (defun c:test2 ( / sel ent txp al ar mp uALR s txpp uvt tp exss exssent exssl exssindex) (defun deg2rad (ang / ) (/ (* PI ang) 180.0) ) (defun rad2deg ( ang / ) (/ (* 180.0 ang) PI) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;;; Calculate unit vector of vector a (defun uvec (a / d) (setq d (distance '(0 0 0) a) a (mapcar '/ a (list d d d)) ) ) ; Compute the dot product of 2 vectors a and b (defun dot ( a b / dd) (setq dd (mapcar '* a b)) (setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd))) ) ;end of dot (princ "\nDistance DIM: ") (setq dist (getreal)) (princ "\nSelect DIM: ") ;edited line (setq exss (ssget '((0 . "*dim*")))) ;edited line (setq exssl (sslength exss)) ;edited line (setq exssindex 0) ;edited line (repeat exssl ;edited line (setq exssent (entget (ssname exss exssindex))) ;edited line ;(while (setq sel (entsel "\nSelect DIM: ")) ;edited line ; (setq ent (car sel )) ;edited line (setq ent (cdr (car exssent))) ;edited line (setq txp (cdr (assoc 10 (entget ent)))) (setq al (cdr (assoc 13 (entget ent)))) (setq ar (cdr (assoc 14 (entget ent)))) ;;; (setq ang1 (angle al ar)) ;;; (setq mp (mid al ar)) ;;; ;;; (setq ang2 (angle mp txp)) ;;; ;;; (if (< ang1 ang2) ;;; (setq tp (polar mp (+ ang1 (deg2rad 90.0)) dist)) ;;; (setq tp (polar mp (- ang1 (deg2rad 90.0)) dist)) ;;; ) (setq mp (mapcar '/ (mapcar '+ al ar) '(2. 2. 2.) ) ) ; uALR = unit vector from al to ar (setq uALR (uvec (mapcar '- ar al))) (setq s (dot uALR (mapcar '- txp al))) ; txpp = projection of txp onto the line (setq txpp (mapcar '+ al (mapcar '* uALR (list s s s))) ) (setq uvt (uvec (mapcar '- txp txpp))) (setq tp (mapcar '+ mp (mapcar '* uvt (list dist dist dist)))) (entmod (subst (cons 10 tp) (assoc 10 (entget ent)) (entget ent)) ) (entmod (subst (cons 11 tp) (assoc 11 (entget ent)) (entget ent)) ) ;) ;edited line while delted (setq exssindex (+ exssindex 1)) ;edited line for repeat added ) ;edited line for repeat added (princ) )

I don't know. Tried changing the scale to see if that would do anything and something weird happened. this is the list off all my standard scales I have in BricsCAD. If you count down to from "custom" to 1/8"=1'-0" its 24th in the list. and StandardScale = 24. So i was like "huh that's weird". When I changed the viewport to 1:1 the StandardScale = 2. also 2nd in the list. Changed to 100:1 StandardScale = 13 and you guessed it 13th in the list. Doesn't seem to be anything wrong with the view port. its just how (vla-get-Standardscale (vlax-ename->vla-object v)) displays as.

Files starting with the characters A$C... are actually anonymous Groups not Blocks. If they were anonymous blocks they would start with the letter "U". As to deleting them... well, they cannot be erased with standard AutoCAD tools. To delete and remove these groups, you could use a freeware utility (lisp routine), available at CAD Studio called DelGrpA.

Correct me if I'm wrong but i don't think you can do this in just one lisp. because you can only run one lisp at a time. This is half of it just don't know how to change everything back to byblock before exit. ssget "_x" maybe? everything outside block won't get changed. this lisp will ask you to select a block to change its colors and refedit that block. You have to use the command again to save/exit if you want the colors to change back. or You could set up a reactor. (defun C:BlkEdit (/ Drawing ent blk) (vl-load-com) (setq Drawing (vla-get-activedocument (vlax-get-acad-object))) (if (/= (getvar 'refeditname) "") (progn (setq blk (vla-item (vla-get-blocks Drawing) (getvar 'refeditname))) (vl-cmdf "_.Refclose" "S") (vlax-for x blk (vla-put-Color x 0) ) (vla-Regen Drawing acAllViewports) ) (progn (if (eq (cdr (assoc 0 (setq ent (entget (car (entsel "\nSelect Blocks")))))) "INSERT") (progn (setq blk (vla-item (vla-get-blocks Drawing) (cdr (assoc 2 ent)))) (vlax-for x blk (vla-put-Color x 256) ) (sssetfirst nil (ssadd (cdr (assoc -1 ent)))) (vl-cmdf "-REFEDIT" "O" "A" "N") ) (Prompt "\nNothing Selected") ) ) ) (princ) )

Perhaps it is a matter of user technique. When I want to draw a line perpendicular from an existing line, I do not use the Perpendicular Object Snap. I rely on the Polar Tracking. When you pick the line, I only use Endpoint, Midpoint or nearest Object Snap. Centre Object snap refers only to circular entities. It appears that when you pick the line using those Snaps, the line is identified as the last segment, and thus Polar tracking works relative to that line. You have to be careful that only the chosen line is in the picking box otherwise AutoCAD doesn't know which line you are choosing. It always works for me.

@Emmanuel Delay your code places the dimension on the opposite side of the line when ar is to the left of al and the aligned dimension goes from left to right. Here's a before and after shot. I avoid using angles although sometimes it is easier. Here's a modified version of your code using vectors. (defun deg2rad (ang / ) (/ (* PI ang) 180.0) ) (defun rad2deg ( ang / ) (/ (* 180.0 ang) PI) ) ;; midpoint of 2 given points (defun mid ( pt1 pt2 / ) (mapcar '(lambda (x y) (+ (* 0.5 x) (* 0.5 y))) pt1 pt2 ) ) ;;; Calculate unit vector of vector a (defun uvec (a / d) (setq d (distance '(0 0 0) a) a (mapcar '/ a (list d d d)) ) ) ; Compute the dot product of 2 vectors a and b (defun dot ( a b / dd) (setq dd (mapcar '* a b)) (setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd))) ) ;end of dot (defun c:test2 ( / sel ent txp al ar mp uALR s txpp uvt tp ) (princ "\nDistance DIM: ") (setq dist (getreal)) (while (setq sel (entsel "\nSelect DIM: ")) (setq ent (car sel )) (setq txp (cdr (assoc 10 (entget ent)))) (setq al (cdr (assoc 13 (entget ent)))) (setq ar (cdr (assoc 14 (entget ent)))) ;;; (setq ang1 (angle al ar)) ;;; (setq mp (mid al ar)) ;;; ;;; (setq ang2 (angle mp txp)) ;;; ;;; (if (< ang1 ang2) ;;; (setq tp (polar mp (+ ang1 (deg2rad 90.0)) dist)) ;;; (setq tp (polar mp (- ang1 (deg2rad 90.0)) dist)) ;;; ) (setq mp (mapcar '/ (mapcar '+ al ar) '(2. 2. 2.) ) ) ; uALR = unit vector from al to ar (setq uALR (uvec (mapcar '- ar al))) (setq s (dot uALR (mapcar '- txp al))) ; txpp = projection of txp onto the line (setq txpp (mapcar '+ al (mapcar '* uALR (list s s s))) ) (setq uvt (uvec (mapcar '- txp txpp))) (setq tp (mapcar '+ mp (mapcar '* uvt (list dist dist dist)))) (entmod (subst (cons 10 tp) (assoc 10 (entget ent)) (entget ent)) ) (entmod (subst (cons 11 tp) (assoc 11 (entget ent)) (entget ent)) ) ) (princ) )