Leaderboard

My $0.05 Did you use chatGP for code ? (defun c:evp2 ( / ssvp tel sc vlag obj) (setq ssvp (ssget "X" '((0 . "VIEWPORT")))) (if (= ssvp nil)(progn (alert "NO viewports selected \n \nWill exit now ")(exit))) (repeat (setq tel (sslength ssvp)) (setq obj (vlax-ename->vla-object (ssname ssvp (setq tel (1- tel))))) (setq sc (vlax-get obj 'customscale)) (cond ((equal sc 1.0 1e-03)(setq vlag 0)) ((equal sc 10.0 1e-03)(setq vlag 0)) ((equal sc 5.0 1e-03)(setq vlag 0)) ((equal sc 50.0 1e-03)(setq vlag 0)) ((setq vlag 1)) ) (if (= vlag 1) (progn (vlax-put obj 'color 1) (alert "One or more viewports have got a wrong scale ! \n \nNow RED color ") (setq vlag nil) ) ) ) (princ) ) (c:evp2 )

It is often useful to make a note where you found a routine - every now and then they get updated on the forums, people find the thread and might have asked the same there.... so it is good to go and look but also good to recognise the author. The style of LISP above are similar to a couple of posters on here, they might come and take the credit... I use AutoCAD...so the above works but as far as I know the problems can be caused by vla- and vlax- functions, they arn't all supported. This might work, it might not, taking out the VLA- and VLAX- commands. Uses Lee Macs ProjectPointToLine (see his website for use). I've tried to annotate it so as it runs it will return in the command line what it is doing, what it has calculated and found - if anything there is nil and the routine doesn't work then ZWCad probably doesn't support that (or I have got it wrong). (defun c:Foo ( / col sel int old get inspt pt p1 p2) (defun LM:ProjectPointToLine ( pt p1 p2 / nm ) ;Find nearest point on line (p1-p2) to point (pt) (setq nm (mapcar '- p2 p1) p1 (trans p1 0 nm) pt (trans pt 0 nm) ) (trans (list (car p1) (cadr p1) (caddr pt)) nm 0) ) (while (/= (cdr (assoc 0 (entget (setq col (car (entsel "\nSelect a Line")))))) "LINE" ) (Princ "Missed, Try again!") ) ; end while (setq pt1 (cdr (assoc 10 (entget col)))) ;;line end point A (setq pt2 (cdr (assoc 11 (entget col)))) ;;line end point B (princ "\nLine Selected, Entity name: ")(princ col) (princ ". End A: ")(princ pt1)(princ ". End B: ")(princ pt2) (princ "\nSelect Text or Mtext: ") (setq sel (ssget "_:L" '((0 . "*TEXT")))) ;;text or Mtext (princ "\n")(princ (sslength sel))(princ " texts selected") (setq int 0) (while (< int (sslength sel)) (princ "\nWhile Loop iteration ")(princ (+ int 1))(princ "\n") (setq ent (ssname sel int)) (setq old (getvar 'nomutt))(setvar 'nomutt 1) (command "_.justifytext" ent "" "tr") (setvar 'nomutt old) (princ ". Text Justified to 'TR'") (setq get (entget ent)) (setq inspt (cons 10 (LM:ProjectPointToLine (cdr (assoc 10 get)) p1 p2) )) (princ "\nNew Insertion Point: ")(princ inspt) (setq get (subst inspt (assoc 10 get) get)) (entmod get)(entupd ent) (setq int (+ int 1)) ) ; end while (princ) ; exit silently ) For a quick routine it just looks at the closest points to a line, for more versatility it would be nice to do the same (without VLA- functions) for all entity types... but that is for another time.. just taking a break tonight from another (much larger) project update.

Where did get the codes from ? Post the link.

Just a little heads. If you are using these drawing in any type of production. its probably best to have additional information in the block name. like maybe the drawing name or something else to make them unique to that drawing. I had an auto block lisp that would look for the next available block name and create the next block. This lisp worked fine on its own but ended up wasted about a weeks worth of material and time. because we were moving blocks between two projects that where about 80% the same layout but minor changes changes between the two. What am i talking about? if you have two drawings and both have a block named "1DDS1.21" but in in drawing 1 its a 5" circle and in drawing 2 its a 3" circle. if you copy anything from drawing 2 and paste into drawing 1 lines, text, any entity that isn't a block come over 1:1. With blocks it changes and defaults to the block definition of the drawing your pasting into. so you think your copying over (4) 3" circles but when you are pasting into drawing 1 they become (4) 5" circles. or if they could be the same block just the base point is different location. then they are not in the same location when pasting.

Below is a preliminary example. Please let me know if it fits your requirements. ;+1 increment in block with attribute ;The tag is defined by the user: "NAME" ;The user is asked the number of characters to go from right to left ;If the number of characters is less than those requested, an alert message is displayed but the code is not stopped ;[Copyright ©R0m3r014] romerocruz.ivan@gmail.com diciembre 04 2023 (defun c:IAT( / IRtag IRss1 IRnumChars) (vl-load-com) (setq IRtag "NAME" IRnumChars (getint "\nNUMBER OF CHARACTERS ONE SCROLL: ") ) (if (setq *IRnum* (cond ( (getint (strcat "\nSTART NUMBER" (if *IRnum* (strcat " <" (itoa *IRnum*) "> : ") ": ")))) ( *IRnum* ))) (while (setq IRss1 (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1)))) (foreach x (vlax-invoke (vlax-ename->vla-object (ssname IRss1 0)) 'getattributes) (if (eq IRtag (vla-get-tagstring x)) (progn (setq IRoldText (vla-get-textstring x)) (if (< (strlen IRoldText) IRnumChars) (alert "Error: Text does not have enough characters to loop.") (progn (setq IRnewText (strcat (substr "0" 1 (- 2 (strlen (itoa *IRnum*)))) (itoa *IRnum*))) (setq IRcombinedText (strcat (substr IRoldText 1 (- (strlen IRoldText) IRnumChars)) IRnewText)) (vla-put-textstring x IRcombinedText) (setq *IRnum* (1+ *IRnum*)) ) ) ) ) ) ) ) (princ) )

"Should be able to do something its fishing time maybe later". Gone fishing no time to program been a couple of busy days off in a rocky boat. Will try to find some time now back on land. Try this very crude needs a second version that works by picking the reo bar and getting all correct info. (defun c:addnum ( / idx sel str ) (setq num (getint "\nstart number ")) (if (setq sel (ssget '((0 . "MULTILEADER")))) (repeat (setq idx (sslength sel)) (setq mld (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))) (vlax-for obj (vla-item (vla-get-blocks (vla-get-document mld)) (vla-get-contentblockname mld)) (if (and (= "AcDbAttributeDefinition" (vla-get-objectname obj)) (= :vlax-false (vla-get-constant obj)) ) (progn (setq oid (vla-get-objectid obj)) (if (= (vla-get-tagstring obj) "POS") (vla-setblockattributevalue mld oid (rtos num 2 0) ) ) ) ) ) (setq num (1+ num)) ) ) (princ) ) (C:emdl)

Ok looking at dwg, Can get Lengthprimaryshape Can get size1 Can get visibilty1 Re number if know the name of the block or blocks eg "Longitudinal Bar-rev1.0", can get how many blocks, so your next number is tot+1, you would not just insert the reobar rather use a lisp so it adds correct number at time of drafting. Could also do a missed some and just renumber all, that may though result in numbers all over the place rather than beam by beam. Should be able to do something its fishing time maybe later.

The number is the easy bit 01,02 and so on. You need some way of pick a bar and it auto works out its a "L" "Straight bar" "1 hook", "2 hook". I can think of about 10 different type of bar descriptions. The length would be auto generated from the pick object. So I would take a step back and think about that first rather than the end block answer. Post a dwg with example rebar shapes. I would do a Google about "drawing Rebar Autocad Lisp", I would expect they would have the add block part, I know I have done hook ends, for a "L" that was enter len1, len2 etc.

If this was modified to take away the dialogue box, do you think this would work? Command is RenB by AlanJT - he hasn't been on here for a couple of months though ;;https://www.cadtutor.net/forum/topic/46160-rename-block/ (defun c:RenB ( / ) (defun RenB (/ obj old new) ;; Rename Selected Block ;; Required Subroutines: AT:GeSel, AT:Getstring ;; Alan J. Thompson, 03.10.10 / 07.15.10 (if (and (AT:GetSel entsel "\nSelect block to rename: " (lambda (x) (if (and (eq "INSERT" (cdr (assoc 0 (entget (car x))))) (/= 4 (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 (entget (car x))))))) 4) ) ) (setq obj (vlax-ename->vla-object (car x))) ) ) ) (setq old (if (vlax-property-available-p obj 'effectivename) (vla-get-effectivename obj) (vla-get-name obj) ) ) (not (vl-position (setq new (AT:GetString "Specify new block name:" old)) (list old "" nil) ) ) ) (cond ((tblsearch "BLOCK" new) (alert (strcat "\"" new "\" already exists!"))) ((not (snvalid new)) (alert (strcat "\"" new "\" is an invalid name!"))) ((and (snvalid new) (not (tblsearch "block" new))) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-name (list (vla-item (vla-get-blocks (cond (*AcadDoc*) ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))) ) ) old ) new ) ) ) (alert (strcat "Block: " old " could not be renamed to: " new)) (alert (strcat "Block: " old " renamed to: " new)) ) ) ) ) (princ) ) (defun AT:GetSel (meth msg fnc / ent) ;; meth - selection method (entsel, nentsel, nentselp) ;; msg - message to display (nil for default) ;; fnc - optional function to apply to selected object ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC"))) ;; Alan J. Thompson, 05.25.10 (while (progn (setvar 'ERRNO 0) (setq ent (meth (cond (msg) ("\nSelect object: ") ) ) ) (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again.")) ((eq (type (car ent)) 'ENAME) (if (and fnc (not (fnc ent))) (princ "\nInvalid object!") ) ) ) ) ) ent ) (defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString) ;; Getstring Dialog Box ;; #Title - Title of dialog box ;; #Default - Default string within edit box ;; Alan J. Thompson, 08.25.09 (setq #FileName (vl-filename-mktemp "" "" ".dcl") #FileOpen (open #FileName "W") ) (foreach x '("TempEditBox : dialog {" "key = \"Title\";" "label = \"\";" "initial_focus = \"Edit\";" "spacer;" ": row {" ": column {" "alignment = centered;" "fixed_width = true;" ": text {" "label = \"\";" "}" "}" ": edit_box {" "key = \"Edit\";" "allow_accept = true;" "edit_width = 40;" "fixed_width = true;" "}" "}" "spacer;" ": row {" "fixed_width = true;" "alignment = centered;" ": ok_button {" "width = 11;" "}" ": cancel_button {" "width = 11;" "}" "}" "}//" ) (write-line x #FileOpen) ) (close #FileOpen) (setq #DclID (load_dialog #FileName)) (new_dialog "TempEditBox" #DclID) (set_tile "Title" #Title) (set_tile "Edit" #Default) (action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)") (action_tile "cancel" "(done_dialog)") (start_dialog) (unload_dialog #DclID) (vl-file-delete #FileName) #NewString ) (renB) )