Jump to content

Leaderboard

Popular Content

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

  1. You don't need to use apply & append functions nor wrapping / covering list function , besides that you don't need to get X & Y only from variables start & end to exclude Z coordinates from them so they will be ignored on creation. Suppose a user hits enter when collecting inputs, what will happen when reaching while function ?
    2 points
  2. Look here: http://www.lee-mac.com/steal.html And please look here: https://www.cadtutor.net/forum/topic/427-code-posting-guidelines/ regards Wolfgang
    1 point
  3. If I am looking at it right, in your sample drawing there isn't an offset noted for each chainage distance? For example 7.300 offset is one text referring to a few chainages? You might need to do this with 2 mouse clicks per chainage rather than selecting a lot of the text in one go. Select the chainage text and then the offset? I have something similar to combine text but it is quite long for what you are wanting and would need some things removing. How are you with LISP routines? I have to go out shortly and not gong to get chance to do anything for you just now but this is what I would be thinking, and you might be able to put most of this together, asking again for clarification of the harder parts. Have a go, learn some stuff and it is more satisfying Set up the LISP (defun and so on): Make a blank list: (setq MyTexts (list)) start a while loop here Use MHUPPs example above to get text 1: (setq prefx (strcat (cdr (assoc 1 (entget (car (entsel "\nPick 1st Text"))))))) Use MHUPPs example above to get text 2: (setq sufx (strcat " " (cdr (assoc 1 (entget (car (entsel "\nPick 2nd Text"))))))) Join the 2 texts together: (setq MyText (strcat prefx sufx) (you can probably combine that step with the setq sufx step) Append that to a list for exporting to Excel (setq MyTexts (append Mytext MyTexts)) Update the original text using MHUPP from above: (vla-put-textstring txt (strcat (vla-get-TextString txt) sufx)) End the while loop here then you can use the MyTexts list to export to a spreadsheet, or create a CSV file or whatever you need to do. But for now, how about having a go at getting the above working, don't need to do the while loop yet, get that later. You'll probably need to do a bit of thinking
    1 point
  4. (cond ( (< elev 700.0) (setq lyr_txt "NO_ELEV")) ( (= (rem (fix elev) 2) 1) (setq lyr_txt (strcat "CONTOUR_EL" (itoa (1+ (fix elev)))))) (t (setq lyr_txt (strcat "CONTOUR_EL" (itoa (fix elev))))) );end_cond second line is what you want. 1. (fix elev) = fix that elevation number. Drop the decimal and change to an integer. (fix 0.0001) = 0 (fix 0.9999) = 0 (fix 1.0001) = 1 (fix 1.9999) = 1 2. (rem number1 number2) = [ number1 / number2 ]'s remain, Returns the remainder of the result of dividing number1 by number2. so, (rem number1 2) = This divides number1 by 2. Then the result is only 1 or 0. This will determine if number1 is odd or even, and so on. if result is 1 = number1 is odd if result is 0 = number1 is even 3. (= (remnumber1 2) 1) = if it's odd number. (1+ (fix elev)) = make it even by plus 1 Then its result will always be even. 0,2,4,6.. that will be layer name 4. itoa = number(integer) to text string, for make it to layer name 5. in 3rd line (t ~~~ is for already it's even number. so, directly make it as layer name. ======================================================= so, if you just want it always roundup. ( If it is enough to divide by even numbers without changing the range ) like example 900.0001 - 902.0000 => CONTOUR_EL 902 902.0001 - 904.0000 => CONTOUR_EL 904 904.0001 - 906.0000 => CONTOUR_EL 906 just +2 to elev. (setq elev (+ elev 2)) and If you want to use less than 700, you can also remove the limit as follows. (setq elev (+ elev 2)) ;edited line (cond ;( (< elev 700.0) (setq lyr_txt "NO_ELEV")) ;edited line ( (= (rem (fix elev) 2) 1) (setq lyr_txt (strcat "CONTOUR_EL" (itoa (1+ (fix elev)))))) (t (setq lyr_txt (strcat "CONTOUR_EL" (itoa (fix elev))))) );end_cond (defun rh:sammlung_n (o_lst grp / tmp n_lst) (setq n_lst nil) (cond ( (and o_lst (= (rem (length o_lst) grp) 0)) (while o_lst (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst))) (setq n_lst (cons (reverse tmp) n_lst) tmp nil) );end_while ) );end_cond (if n_lst (reverse n_lst)) );end_defun (vl-load-com) (defun c:layerElev ( / c_doc c_lyrs ss clyr cnt pl_obj p_lst elev lyr_txt) (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_lyrs (vla-get-layers c_doc) clyr (getvar 'clayer) );end_setq (prompt "\nSelect Polylines : ") (setq ss (ssget '((0 . "*POLYLINE")))) (cond (ss (repeat (setq cnt (sslength ss)) (setq pl_obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))) (cond ( (vlax-property-available-p pl_obj 'elevation) (setq elev (vlax-get pl_obj 'elevation))) ;;LWPolylines Polylines and 2DPolylines (t (setq p_lst (rh:sammlung_n (vlax-get pl_obj 'coordinates) 3) elev (caddr (car p_lst)) );end_setq ) );end_cond (setq elev (+ elev 2)) ;edited line (cond ;( (< elev 700.0) (setq lyr_txt "NO_ELEV")) ;edited line ( (= (rem (fix elev) 2) 1) (setq lyr_txt (strcat "CONTOUR_EL" (itoa (1+ (fix elev)))))) (t (setq lyr_txt (strcat "CONTOUR_EL" (itoa (fix elev))))) );end_cond (if (not (tblsearch "layer" lyr_txt)) (vla-add c_lyrs lyr_txt)) (vlax-put-property pl_obj 'layer lyr_txt) );end_repeat ) );end_cond (setvar 'clayer clyr) (princ) );end_defun ================================================================================================== or you want custom range (defun rh:sammlung_n (o_lst grp / tmp n_lst) (setq n_lst nil) (cond ( (and o_lst (= (rem (length o_lst) grp) 0)) (while o_lst (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst))) (setq n_lst (cons (reverse tmp) n_lst) tmp nil) );end_while ) );end_cond (if n_lst (reverse n_lst)) );end_defun (vl-load-com) (defun c:layerElev ( / c_doc c_lyrs ss clyr cnt pl_obj p_lst elev lyr_txt) (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_lyrs (vla-get-layers c_doc) clyr (getvar 'clayer) );end_setq (prompt "\nSelect Polylines : ") (setq ss (ssget '((0 . "*POLYLINE")))) (cond (ss (repeat (setq cnt (sslength ss)) (setq pl_obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))) (cond ( (vlax-property-available-p pl_obj 'elevation) (setq elev (vlax-get pl_obj 'elevation))) ;;LWPolylines Polylines and 2DPolylines (t (setq p_lst (rh:sammlung_n (vlax-get pl_obj 'coordinates) 3) elev (caddr (car p_lst)) );end_setq ) );end_cond (setq elev (ex:upsidefilter elev 20)) ;edited line (cond ;( (< elev 700.0) (setq lyr_txt "NO_ELEV")) ;edited line ( (= (rem (fix elev) 2) 1) (setq lyr_txt (strcat "CONTOUR_EL" (itoa (1+ (fix elev)))))) (t (setq lyr_txt (strcat "CONTOUR_EL" (itoa (fix elev))))) );end_cond (if (not (tblsearch "layer" lyr_txt)) (vla-add c_lyrs lyr_txt)) (vlax-put-property pl_obj 'layer lyr_txt) );end_repeat ) );end_cond (setvar 'clayer clyr) (princ) );end_defun (defun ex:upsidefilter ( a b / d e ) (setq d (rem a b)) ; divide by b, remain (setq e (/ (- a d) b)) ; divide by b, result without remain (if (/= d 0) (progn (cond ((> a 0) (setq e (+ e 1))) ((> a (* b -1)) (setq e 0)) ) ) ) (* e b) ; range filtered value ) you can adjust range set by (setq elev (ex:upsidefilter elev 20)) edit this "20"
    1 point
  5. If you look at this you will need to make lots of conds checking what is Z value it would make sense if a real big range 0 - 70 steps 10 to do a defun that compares. ( (< elev 700.0) (setq lyr_txt "NO_ELEV")) ( (<= elev 699.99999) (setq lyr_txt "ELEV_700")) ( (<= elev 689.99999) (setq lyr_txt "ELEV_680"))
    1 point
  6. http://mahru.co.kr/index.php?mid=cad_tip&order_type=asc&sort_index=readed_count&category=4087&listStyle=webzine&document_srl=17275 this link is a picture of the actual variables of the values displayed in the DIMSTYLE window. there is a problem with the language, but the screenshot is in English, so I link it. with this variable, you can edit exist dimension's style. like this way. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/dimension-txt-size-lisp/m-p/6751721/highlight/true#M347876 this edit is with already created dimension lines, regardless of DIMSTYLE. editing and saving the DIMSTYLE, will be taken care of by someone else. ->
    1 point
  7. Thanks again for helping me get better, I see that you like to make your programs fool proof, I thinks that's good, I guess we all should do it too.
    1 point
  8. Sorry forgot to add (vl-load-com) this is needed for any function that starts with vl, vla, vlax. like vla-get-length also had a wrong ss call out. Dont use quotes in the condition statements that will make them strings not numbers. most polylines in the example drawing are greater then 60 so wire will be error most of the time. (defun C:foo (/ poly e len spt pt1 pt2 SST lot SSX xfmr ept wire) (vl-load-com) (while (setq poly (vlax-ename->vla-object (setq e (car (entsel "\nSelect Polyline"))))) (setq len (+ (* 10 (fix ((if (minusp (vla-get-length poly)) - +) (/ (vla-get-length poly) (float 10)) 0.5))) 15)) ;Lee Mac round to nearest 10' add 15' (setq spt (vlax-curve-getStartPoint poly)) (setq pt1 (mapcar '- spt '(30 30))) (setq pt2 (mapcar '+ spt '(30 30))) ;(vl-cmdf "_rectangle" "_non" pt1 "_non" pt2) ;uncomment to see selection window (cond ((and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1)) (setq lot (cdr (assoc 1 (entget (ssname SST 0))))) ) ((and (setq SSX (ssget "C" pt1 pt2 '((0 . "INSERT") (2 . "HOTDOG_TX_N-2006")))) (= (sslength SST) 1)) (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (ssname SSX 0)) "KVA")) ) ) (setq SST nil SSX nil) (setq ept (vlax-curve-getendpoint poly)) (setq pt1 (mapcar '- ept '(30 30))) (setq pt2 (mapcar '+ ept '(30 30))) ;(vl-cmdf "_rectangle" "_non" pt1 "_non" pt2) ;uncomment to see selection window (cond ((and (setq SSX (ssget "C" pt1 pt2 '((0 . "INSERT") (2 . "HOTDOG_TX_N-2006")))) (= (sslength SSX) 1)) (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (ssname SSX 0)) "KVA")) ) ((and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1)) (setq lot (cdr (assoc 1 (entget (ssname SST 0))))) ) ) (if xfmr (progn) (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (car (entsel "\nSelect Transformr Block: "))) "KVA")) ) (if lot (progn) (setq lot (cdr (assoc 1 (entget (car (entsel "\nSelect Lot Number")))))) ) (cond ((and (eq xfmr "25 KVA") (<= len 50)) (setq wire "WIRE 1/0") ) ((and (eq xfmr "25 KVA") (<= len 55)) (setq wire "WIRE 4/0") ) ((and (eq xfmr "25 KVA") (> len 60)) (setq wire "ERROR") ) ((and (eq xfmr "50 KVA") (<= len 50)) (setq wire "WIRE 1/0") ) ((and (eq xfmr "50 KVA") (<= len 55)) (setq wire "WIRE 4/0") ) ((and (eq xfmr "50 KVA") (> len 60)) (setq wire "ERROR") ) ((and (eq xfmr "75 KVA") (<= len 50)) (setq wire "WIRE 1/0") ) ((and (eq xfmr "75 KVA") (<= len 55)) (setq wire "WIRE 4/0") ) ((and (eq xfmr "75 KVA") (> len 60)) (setq wire "ERROR") ) ) (if (setq blk (vlax-ename->vla-object (car (entsel "\nSelect Block: ")))) (progn (LM:vl-setattributevalue blk "FOOTAGE" (strcat (itoa len) "'")) (LM:vl-setattributevalue blk "WIRE" wire) (LM:vl-setattributevalue blk "LOT_NUM" lot) ) ) (command "_.Regen") (sssetfirst nil (ssadd e)) (mapcar 'set '(poly e len spt pt1 pt2 SST lot SSX xfmr ept wire) '(nil nil nil nil nil nil nil nil nil nil nil nil)) ) ) ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun LM:vl-getattributevalue ( blk tag ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) ) ;; Set Attribute Value - Lee Mac ;; Sets the value of the first attribute with the given tag found within the block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; val - [str] Attribute Value ;; Returns: [str] Attribute value if successful, else nil. (defun LM:vl-setattributevalue ( blk tag val ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (progn (vla-put-textstring att val) val) ) ) (vlax-invoke blk 'getattributes) ) ) --Edit also cleared variables at the end so when the command is run multiple times is a start fresh every time.
    1 point
  9. This was long time ago... Still, I've looked at my library, and found related things for MinEncCircle(s)... Have look at this ZIP - I think that you're looking for version with "circumplines-all.lsp"... I've packed all that I could think you may need/like residing enclosing circles/spheres... Regards, M.R. min-max-enc-plines-spheres.zip
    1 point
  10. I can download the lsp from the last message just fine. You have to be logged in, but for the rest I think it should work.
    1 point
  11. An example of a Process Flow Diagram.
    1 point
  12. Here is an example of a P&ID. BTW... The first drawing to be created when considering a new process is the Process Flow Diagram. This is then fleshed out via the creation of the Process Piping and Instrumentation Diagram (PP&ID or P&ID). With the advent of 3D piping programs such as PLANTworx, AutoPLANT and AutoCAD Plant we can now create a 3D drawing of the process piping and equipment and from that drawing we can extract both a P&ID as well as an isometric piping schematic.
    1 point
  13. That would not be considered a P&ID. That would be a piping isometric. "P&IDs are a schematic illustration of the functional relationship of piping, instrumentation and system equipment components used in the field of instrumentation and control or automation. They are typically created by engineers who are designing a manufacturing process for a physical plant."
    1 point
×
×
  • Create New...