Jump to content

Search the Community

Showing results for tags 'block'.



More search options

  • Search By Tags

    Type tags separated by commas.
  • Search By Author

Content Type


Forums

  • CADTutor
    • News, Announcements & FAQ
    • Feedback
  • AutoCAD
    • AutoCAD Beginners' Area
    • AutoCAD 2D Drafting, Object Properties & Interface
    • AutoCAD Drawing Management & Output
    • AutoCAD 3D Modelling & Rendering
    • AutoCAD Vertical Products
    • AutoCAD LT
    • CAD Management
    • AutoCAD Bugs, Error Messages & Quirks
    • AutoCAD General
    • AutoCAD Blogs
  • AutoCAD Customization
    • The CUI, Hatches, Linetypes, Scripts & Macros
    • AutoLISP, Visual LISP & DCL
    • .NET, ObjectARX & VBA
    • Application Beta Testing
    • Application Archive
  • Other Autodesk Products
    • Autodesk 3ds Max
    • Autodesk Revit
    • Autodesk Inventor
    • Autodesk Software General
  • Other CAD Products
    • BricsCAD
    • SketchUp
    • Rhino
    • SolidWorks
    • MicroStation
    • Design Software
    • Catch All
  • Resources
    • Tutorials & Tips'n'Tricks
    • AutoCAD Museum
    • Blocks, Images, Models & Materials
    • Useful Links
  • Community
    • Introduce Yourself
    • Showcase
    • Work In Progress
    • Jobs & Training
    • Chat
    • Competitions

Categories

  • Programs and Scripts
  • 2D AutoCAD Blocks
  • 3D AutoCAD Blocks
  • Images
    • Backgrounds

Find results in...

Find results that contain...


Date Created

  • Start

    End


Last Updated

  • Start

    End


Filter by number of...

Found 201 results

  1. So the problem im having is i have code that runs to show the offset of measured points to design points, unfortunately the code works by inserting one of 4 predefined blocks for NSEW, or one of 4 when in 2 directions; only showing orthogonal distances. These work by passing through the distance to the block tag, and then comparing the EW, and/or NS values to determine the correct arrow direction to insert the correct block. What i want is instead of using orthogonal distances, is to have an arrow block within these blocks, that changes the direction of the arrow, based on a bearing that you pass through. eg if the horizontal distance between 2 points is 25mm at a bearing of 45 degrees, then a tag is created as per normal with 25 and an arrow point 45 degrees. Any good ideas? I've looked in the forums and couldn't find anything to solve this. Attached is an image of what i have currently made, note the aligned one showing 130mm is kinda what i want, but that arrow is not dynamic, it just goes left or right and the whole block is just rotated to show the bearing. It makes for a messy plan and a lot of neck craning to present to a client
  2. Hello, i try to insert block view in dcl format. I want when i chose block name to have block view to. Something like this.
  3. I found a lisp (attached) to change object line type. But this lisp is not changing nested blocks line types and forcing one by one selection . I need to change linetype of all objects include nested blocks and as area selection. Please help ChangeObjLinetype.lsp
  4. I found valuable lisp for auto creation block. I want to improve this lisp to following requirement * block selected object individually, not in one block thanks AUTO-BLOCK.LSP
  5. Hello! I'm looking for a solution to my problem. I have a block (center in the attached image) that I'd like to be able to scale as usual, but I want the red circle to remain the same size always. This particular one is a symbol for a smoke detector and the red circle is supposed to be the coverage of this detector. That is why I want the coverage circle to remain a constant diameter of let's say 10 meters, but I'd still like to be able to scale the smoke detector symbol depending on viewport scale. I also want the circle to follow the detector so that I don't have to select both. Other requests are the ability to freeze or turn off visibility of the circle, but I'd still want it to follow the smoke detector if moved. Is any of this doable? What are your thoughts? Thanks!
  6. Can anyone help me for the create lisp for following condition . * I have 200 of text separately in my drawing ..i want block them individually each one. *i want select 200 of text at once block them individually .. Can any one create lisp for that.thank
  7. So I have been trying to figure this out with several approaches now and I need some help. I would like to send all Wipeouts, or really any specified entity type, within a block to the back of the draw order. Is there a way to do this using Lee Mac's Apply To Block Objects routine? I tried this in conjunction with his draw order routines but the MovetoBottom command kept failing. I'm pretty rough with VisualLisp which is part of the issue when trying to troubleshoot his great routines. Or what about this approach? (I dont really understand it, again Visual Lisp) Below is what I tried. I do understand Vanilla Lisp. Visual Lisp I barely know the basics, but eager to learn. Please help me improve my capabilities. I love autolisp. Thank you. The issue is clearly with the lambda function and my improper use of it Im sure. The ssget I am trying to do is incorrect approach for use with his function. ;=========================================================== ; 11/Sep/2020 10:09 AM[Friday] AUTHOR: Brandon Gum ;-- ;DESCRIPTION: ;Select block with wipeout. ;Will send wipeout objects the back of the draw orer ;=========================================================== (defun c:test ( / s ) (princ "\nSelect Block: ") (if (setq s (ssget "_+.:E:S" '((0 . "INSERT")))) (LM:ApplytoBlockObjects (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-effectivename (vlax-ename->vla-object (ssname s 0))) '(lambda ( obj ) (BG:WipeoutToBottom)) ) ) (princ) ) (vl-load-com) (princ) (defun BG:WipeoutToBottom( / ) (LM:movetobottom (ssget "X" '((0 . "WIPEOUT")))) ;(princ) );end of defun ;===============Below here are Lee's draw order functions============== My LeeMac Based Approach.LSP
  8. Hi guys, I am new to LISP and CAD customization at all, so what I am asking for is a guide where to look and how to approach my problem. Sorry for my English, I am not a native speaker. My goal is to create button which will insert a block into my drawing (I know how to do that), block is a simple circle with a number, which represent a reference for some element, a stud for example. What it should do.... 1) click a my made button which start inserting a block with a midpoint (done) 2) click in a drawing and insert the block to a anyplace I want (dont know how to continue inserting without hitting the button again) 3) inserting the block will still continue but now it will be second one(3rd,4th etc.) and the number in a circle will be increasing by 1 4) I would like to specify from which number the increment numbering should start.
  9. Hi all, I'm not new to AutoCAD but I've honestly never created a dynamic block and don't know what I need to do. I've watched a few tutorials on dynamic blocks but what I am trying to do seems a little different than the typical use-case. I do a lot of audio-visual one-line drawings in AutoCAD. I have device equipment blocks showing all input and output connectors. I manually make them for every device but am looking to have a go-to generic dynamic block for one-off simple devices. Here are examples of finished manually created blocks: However, what I am looking for is a block that dynamically transform from this: To this: Ideally, block parameters would define how many "lines" of connections there is. Or, I am guessing there is a way for the block to be stretched such that the lines of connections become visible, but I do not want free stretch. The bottom edge of the rectangle should be a specific spacing from the middle of the last line of text. I'm sure the text could be shown or hidden with visibility, but then I don't understand how I'd resize the rectangle as required. Attributes can allow text for NAME and CONN for each IN/OUT. The manufacturer, model, and DEV_ID are all attributes. If for example there are a different number of inputs/outputs, I imagine just leaving the text attributes blank is enough to effectively hide them. If there's videos on doing this sort of dynamic block, links are appreciated. Most of the videos I've found are discussing layout/graphic objects. Thanks!
  10. I want to change the text "A" in my dynamic block to "B,C,D,E,..." When i click on a blue arrow. and the text "16 A" to "20 A , 25 A, ..." When i click on another blue arrow. what is the best way to do this ?
  11. This lisp for working select single block but i want to need create dimension for multiple block. help me!! (defun C:Bdim ( / ) (if (and (setq sel (entsel "Select a block: ")) (= (cdr (assoc 0 (setq nfo (entget (car sel))))) "INSERT") ) (vlax-for item (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))(cdr (assoc 2 nfo))) (setq items (vlax-vla-object->ename item)) (setq EntityData (entget items)) (if (= (cdr (assoc 0 EntityData)) "LINE") (progn (vl-cmdf "_.dimaligned" "_non" (cdr (assoc 10 EntityData)) "_non" (cdr (assoc 11 EntityData)) "_non" (cdr (assoc 10 EntityData))) ) ) ) (prompt "\nNo block selected") ) (princ) )
  12. I have this, but how can I make a block of the circle in order to put the color blue? (setq R 10) (setq P1 (getpoint "center:" )) (command "circle" P1 R)
  13. I have this block of text as you can see in the image below, and in the window show me this "VIGA V-SS01 (.25X .50)", BUT I DONT WANT THAT SHOW ME THIS. I want to the program ask me a question first, for example: What is the name? so I will set the answer of this question in the block I have. SO, I want to have this in the window "VIGA V- (AND THE ANSWER OF THE QUESTION)" EXAMPLE: Computer: What is the name? User write: L22 Then, that will show me: "VIGA V- L22" I will glad if you can help me, If you have already notice, I dont know to much about the topic.
  14. I have shared a Dynamic Block and you can download through the link below and also can watch video that demonstrate it how to use 2D dynamic block to develop a flat pattern of a cylinder that has been oblique Section. Dynamic Block Download Link
  15. I have a drawing that has two different blocks (see attached), what I needed to do was transfer over the attributes of one block over to the other (both have different tags). For example copying over attributes in "rev0_date" from the first block tag over to "revslot1date" in the second block tag , I ran across some code in the forums that did just that created by Lee Mac.The problem with it is it only transfers one attribute over, I modified it a little but its still not exactly what I need. The way it currently works is - It asks me to choose the first block with the attributes to copy, once selected it then asks me to choose the second block that will have the attributes pasted to it, once I've selected them, it then pastes the first specified tag attribute in the first block to the second, after that I have to repeat the process again, clicking the block with the attribute to copy and then choosing the second block to paste, I have to keep repeating these steps, clicking the first block then the second over and over until all the tag attributes have been copied over. My question is how can I stop having click the first and then second block over and over again for each tag and instead only have to go through the process once (click first block, then second and then transfer all the attributes over at once). Here is my current code (sorry if its a mess I'm very new to this): (defun c:blockswap ( / _SelectBlockWithTag a b des src tag ) (vl-load-com) (setq DAT1A "Rev0_Date" ; Source Attribute Tag 1 DES1A "Rev0_Desc" ; Source Attribute Tag 2 REV1A "Rev0" ; Source Attribute Tag 3 RDB1A "Rev0_Drawn_By" ; Source Attribute Tag 4 REV1B "RevSlot1Number" ; Destination Attribute Tag 3 DES1B "RevSlot1Description" ; Destination Attribute Tag 2 DAT1B "RevSlot1Date" ; Destination Attribute Tag 1 RDB1B "RevSlot1DrawnBy" ; Destination Attribute Tag 4 ) (defun _SelectBlockWithTag ( tag / e a ) (setq tag (strcase tag)) (while (progn (setvar 'ERRNO 0) (setq f (car (entsel (strcat "\nSelect Block with attribute " tag ": ")))) (cond ( (= 7 (getvar 'ERRNO)) (princ "\nMissed, Try Again.") ) ( (not f) nil ) ( (and (eq "INSERT" (cdr (assoc 0 (entget f)))) (= 1 (cdr (assoc 66 (entget f)))) ) (if (not (setq z (vl-some (function (lambda ( x ) (if (eq tag (strcase (vla-get-tagstring x))) x) ) ) (vlax-invoke (vlax-ename->vla-object f) 'getattributes) ) ) ) (princ (strcat "\nBlock does not contain tag " tag ".")) ) ) ( (princ "\nInvalid Object Selected.") ) ) ) ) z ) (and (setq aa (_SelectBlockWithTag DAT1A)) (setq ab (_SelectBlockWithTag DAT1B)) ) (vla-put-textstring ab (vla-get-textstring aa)) (and (setq ba (_SelectBlockWithTag DES1A)) (setq bb (_SelectBlockWithTag DES1B)) ) (vla-put-textstring bb (vla-get-textstring ba)) (and (setq ca (_SelectBlockWithTag REV1A)) (setq cb (_SelectBlockWithTag REV1B)) ) (vla-put-textstring cb (vla-get-textstring ca)) (and (setq da (_SelectBlockWithTag RDB1A)) (setq db (_SelectBlockWithTag RDB1B)) ) (vla-put-textstring db (vla-get-textstring da)) (princ) ) drawing.dwg
  16. Dynamic Block of ASME B16.5 Flanges Rating 150# 300# 400# 600# 900# 1500# 2500# Sizes From 1/2" to 24" Watch The video of Dynamic Block Block https://www.youtube.com/watch?v=sdFtOPWggFo ASME B16.5 Flange Plan.dwg
  17. Hello, I am looking for a lisp that will allow me to increment an attribute in a block from one block to the next by doing a window selection. The lisp that I have now that I got from Chaitanya Chikkala (see below) works great, but I have to select each block individually. With 2000+ blocks it is easy to make a mistake. When I window select with it, it numbers them as they were added to the drawing. This does not work for me because multiple people work on drawings and then are combined into a master drawing so the order is wrong. Is there a way for a direction to be added, even if it is just along the x or y axis? Or is there a lisp that already does this? Any help is very much appreciated. (defun c:incr (/ ent obj x i ST_STR) (command "._undo" "_be") (SETQ ST_STR1 (GETSTRING "\nENTER STARTING NUMBER OF THE SEQUENCE(ANY ALPHABET/WORD)")) (SETQ ST_STR (GETSTRING "\nENTER STARTING NUMBER OF THE SEQUENCE(ANY INTEGER)")) (vl-load-com) (setq i 0) (prompt "\nSelect blocks one at a time and in order") (SETQ BLOCK_LIST (SSGET)) (SETQ BLOCK_LIST (FORM_SSSET BLOCK_LIST)) (while (< I (LENGTH BLOCK_LIST)) (SETQ ST_STR (STRCAT "" ST_STR)) (SETQ TEMP_ELE (NTH 0 (ATTRIBUTE_EXTRACT (NTH I BLOCK_LIST)))) (SETQ TEMP_ATTRIBUTE (STRCAT ST_STR1 ST_STR)) (SETQ TEMP_TAG (NTH 0 TEMP_ELE)) (MODIFY_ATTRIBUTES (NTH I BLOCK_LIST) (LIST TEMP_TAG) (LIST TEMP_ATTRIBUTE)) (SETQ ST_STR (ITOA (+ (ATOI ST_STR) 1))) (setq i (+ i 1)) ) (command "._undo" "_e") (princ)) (DEFUN FORM_SSSET (SSSET / I TEMP_ELE LIST1) (SETQ I 0) (SETQ TEMP_ELE NIL) (SETQ LIST1 NIL_) (WHILE (< I (SSLENGTH SSSET)) (SETQ TEMP_ELE (SSNAME SSSET I)) (SETQ LIST1 (CONS TEMP_ELE LIST1)) (SETQ I (+ I 1)) ) (REVERSE LIST1) ) (DEFUN ATTRIBUTE_EXTRACT (ENTNAME / ENT_OBJECT SAFEARRAY_SET I LIST1) (SETQ SAFEARRAY_SET NIL) (SETQ ENT_OBJECT ENTNAME) (SETQ ENT_OBJECT (VLAX-ENAME->VLA-OBJECT ENT_OBJECT)) (IF (= (VLAX-GET-PROPERTY ENT_OBJECT "HASATTRIBUTES") :VLAX-TRUE) (PROGN (SETQ SAFEARRAY_SET (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLAX-INVOKE-METHOD ENT_OBJECT "GETATTRIBUTES") ) ) ) (SETQ I 0) (SETQ LIST1 NIL) (WHILE (< I (LENGTH SAFEARRAY_SET)) (SETQ LIST1 (CONS (LIST (VLAX-GET-PROPERTY (NTH I SAFEARRAY_SET) "TAGSTRING") (VLAX-GET-PROPERTY (NTH I SAFEARRAY_SET) "TEXTSTRING") ) LIST1 ) ) (SETQ I (+ I 1)) ) (SETQ LIST1 (REVERSE LIST1)) (SETQ LIST1 (SORT_FUN LIST1 0 0))) (SETQ LIST1 NIL) )LIST1 ) (DEFUN MODIFY_ATTRIBUTES (ENTNAME IDENTIFIER VALUE / TEMP_ELE ENT_OBJECT SAFEARRAY_SET I J) (SETQ SAFEARRAY_SET NIL) (SETQ ENT_OBJECT ENTNAME) (SETQ ENT_OBJECT (VLAX-ENAME->VLA-OBJECT ENT_OBJECT)) (IF (= (VLAX-GET-PROPERTY ENT_OBJECT "HASATTRIBUTES") :VLAX-TRUE) (PROGN (SETQ SAFEARRAY_SET (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLAX-INVOKE-METHOD ENT_OBJECT "GETATTRIBUTES") ) ) ) (SETQ I 0) (SETQ J 0) (SETQ LIST1 NIL) (WHILE (< I (LENGTH SAFEARRAY_SET)) (SETQ TEMP_ELE (VLAX-GET-PROPERTY (NTH I SAFEARRAY_SET) "TAGSTRING")) (IF (/= (VL-POSITION TEMP_ELE IDENTIFIER) NIL) (PROGN (VLAX-PUT-PROPERTY (NTH I SAFEARRAY_SET) "TEXTSTRING" (NTH (VL-POSITION TEMP_ELE IDENTIFIER) VALUE)) )) (SETQ I (+ I 1)) ) ))) (DEFUN SORT_FUN (LIST1 FLAG1 FLAG2 /) (IF (= NIL (VL-CONSP (CAR LIST1))) (PROGN (SETQ LIST1 (INDEX_ADD LIST1)) (SETQ LIST1 (VL-SORT LIST1 '(LAMBDA (X Y) (< (CADR X) (CADR Y))) ) ) (SETQ LIST1 (MAPCAR '(LAMBDA (X) (CADR X)) LIST1)) ) (PROGN (IF (NOT (ATOM (NTH FLAG1 (NTH 0 LIST1)))) (SETQ LIST1 (VL-SORT LIST1 '(LAMBDA (X Y) (< (NTH FLAG2 (NTH FLAG1 X)) (NTH FLAG2 (NTH FLAG1 Y))) ) ) ) (PROGN (SETQ LIST1 (VL-SORT LIST1 '(LAMBDA (X Y) (< (NTH FLAG2 X) (NTH FLAG2 Y))) ) ) ) ) ) ) LIST1 )
  18. Need a small help to modify a lisp. The lisp attached here is working, Normally command 'CN' allow me to place a "CRBLK" block with incremental number for ATT TAG "00" as i click where i wants.later when using command "FCRT" i will get all the attributes tag value and Coordinates in a individual separate Tables (As Field text). Just need some small modifications to add another Attribute in same block with value "IL=00" which i can edit later by clicking on it (attribute editor). and later when using command "FCRT", it'll also gives the output as ATT tag values then coordinates then Second ATT Tag Value individual separate Tables. The existing lisp is working good, just needs some small modification, Though its a long lisp codes and i have no idea on this.. Have attached a screenshot, DWG and Lisp file for reference.. Thanks. here is the long lisp code ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Title: Cordinates with Table ;; ;; Purpose: Numbering & create table ;; ;; Written: Bijoy Manoharan ;; ;; Command: CN, CSN, RES, CRT ;; ;; Date : Sep-2011 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Modifications: ;; ;; 1-fixed list sorting function ;; ;; 2-aded fields table command FCRT ;; ;; Written: Mahmoud Awad ;; ;; Date : Dec-2015 ;; ;; Mail :mmawad@ymail.com ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; sub function error (defun trap1 (errmsg) (setvar "attdia" ad) (setvar "attreq" aq) (setq *error* temperr) (prompt "\n Enter Command CSN for Point Sub Numbering or CRT for Table") (princ) ) ;defun (defun trap2 (errmsg) (setvar "attdia" ad) (setvar "attreq" aq) (setq *error* temperr) (prompt "\n Enter Command CN to Continue Point Numbering or CRT for Table") (princ) ) ;defun (defun trap3 (errmsg) (setq *error* temperr) (prompt "\nCoordinate Table Command Cancelled") (princ) ) ;defun ;;-----------------------------------sub function to create block ;;;--- create block function start ----- (defun crb ( ) (if (not (tblsearch "BLOCK" "CRBLK")) (progn (if (not (tblsearch "STYLE" "Isocp")) (entmake (list (cons 0 "STYLE") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbTextStyleTableRecord") (cons 2 "Isocp") (cons 70 0) (cons 40 2.5) (cons 3 "Isocp.ttf") ) ) ) (entmake (list (cons 0 "BLOCK") (cons 8 "0") (cons 370 0) (cons 2 "CRBLK") (cons 70 2) (cons 4 "Block to Place Coordinate Points") (list 10 0.0 0.0 0.0) ) ) (entmake (list (cons 0 "CIRCLE") (cons 8 "0") (cons 370 0) (list 10 0.0 0.0 0.0) (cons 40 1.25) ) ) (entmake (list (cons 0 "ATTDEF") (cons 8 "0") (cons 370 0) (cons 7 "Isocp") (list 10 3.0 2.5 0.0) (list 11 3.0 2.5 0.0) (cons 40 2.5) (cons 1 "00") (cons 3 "Coordinate Point") (cons 2 "00") (cons 70 0) (cons 72 0) (cons 74 2) ) ) (entmake (list (cons 0 "ENDBLK") (cons 8 "0") ) ) ;;;--- To set block units in metre 70-6 ( (lambda ( lst ) (regapp "ACAD") (entmod (append (subst (cons 70 6) (assoc 70 lst) lst) (list (list -3 (list "ACAD" (cons 1000 "DesignCenter Data") (cons 1002 "{") (cons 1070 1) (cons 1070 1) (cons 1002 "}") ) ) ) ) ) ) (entget (cdr (assoc 330 (entget (tblobjname "BLOCK" "CRBLK"))))) ) ;;;--- To make block annotative ( (lambda ( lst ) (regapp "ACAD") (regapp "AcadAnnotative") (entmod (append (subst (cons 70 1) (assoc 70 lst) lst) (list (list -3 (list "ACAD" (cons 1000 "DesignCenter Data") (cons 1002 "{") (cons 1070 1) (cons 1070 1) (cons 1002 "}") ) (list "AcadAnnotative" (cons 1000 "AnnotativeData") (cons 1002 "{") (cons 1070 1) (cons 1070 1) (cons 1002 "}") ) ) ) ) ) ) (entget (cdr (assoc 330 (entget (tblobjname "BLOCK" "CRBLK"))))) ) ) ) ;;;--- to disable allow explod----- (vl-load-com) (setq BLOCKS (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object) ) ) BLK (vla-Item BLOCKS "CRBLK") ) (vla-put-explodable (vla-Item BLOCKS "CRBLK") :vlax-false) ;;;--- end to disable allow explod----- (princ) ) ;;;--- create function block end ----- ;;------------------------main functions------- (defun c:CN(/ num num1 pt ptlist name mh-text ad aq) (command "cmdecho"0) (setq clay (getvar "clayer")) (setq ad (getvar "attdia")) (setq aq (getvar "attreq")) (setq temperr *error*) (setq *error* trap1) (setvar "attdia" 0) (setvar "attreq" 1) ;;; input text name (if (not namef) (setq namef "")) (setq name (getstring (strcat "\nEnter prefix text <" namef ">: "))) (if (= name "") (setq name namef) (setq namef name)) ;;; input number (if (not nf-ns) (setq nf-ns 1)) ; default number (setq NUM (getreal (strcat "\nEnter point number : <" (rtos nf-ns 2 0) ">: "))) (if (not num) (setq num nf-ns) (setq nf-ns num)) ; to create new layer (if (not (tblsearch "layer" "Coordinate Points")) (command "-LAYER" "N" "Coordinate Points" "C" "7" "Coordinate Points" "LT" "Continuous" "Coordinate Points""LW" "0.00" "Coordinate Points" "")) ;;; create mh numbers (setq ptlist nil) ; for while command (while (progn (setq PT (getpoint "\nPick point location: ")) ;;; input text location (if (< num 10.0) (setq num1 (strcat "0" (rtos num 2 0)))) (if (>= num 10.0) (setq num1 (rtos NUM 2 0))) (crb) ;create block (setq mh-text (strcat name num1)) ; combine text into one variable (if (not (= pt nil)) (command "CLAYER" "Coordinate Points")) ;if (if (not (= pt nil)) (command "-insert" "CRBLK" pt "1" "1" "0" mh-text)) ;if (if (not (= pt nil)) (setvar "clayer" clay)) ;if (setq by (strcat (Chr 66)(Chr 73)(Chr 74)(Chr 79)(Chr 89)(Chr 183)(Chr 86)(Chr 183)(Chr 77))) (if (not (= pt nil)) (setq num (+ num 1))) ; for increment (if (not (= pt nil)) (setq suf (- num 1))) (if (not (= pt nil)) (setq nf-ns num)) (setq ptlist (append ptlist (list pt))) ; to stop while command ) ;progn ) ;while (setvar "clayer" clay) (princ) ) ;defun (defun c:CSN(/ numf snum sf-ss mh-text pt ptlist ptx pty name ad aq) (command "cmdecho"0) (setq clay (getvar "clayer")) (setq ad (getvar "attdia")) (setq aq (getvar "attreq")) (setq temperr *error*) (setq *error* trap2) (setvar "attdia" 0) (setvar "attreq" 1) ;;; input name (if (not namef) (setq namef "")) (setq name (getstring (strcat "\nEnter prefix text <" namef ">: "))) (if (= name "") (setq name namef) (setq namef name)) ;;; input number (if (not suf) (setq suf 1)) ; default number (setq NUMF (getreal (strcat "\nEnter point number : <" (rtos suf 2 0) ">: "))) (if (not numf) (setq numf suf) (setq suf numf)) ;;; input sub number (if (not sf-ss) (setq sf-ss 1)) ; default number (setq SNUM (getreal (strcat "\nEnter point subnumber : <" (rtos sf-ss 2 0) ">: "))) (if (not snum) (setq snum sf-ss) (setq sf-ss snum)) ;;; set arial.ttf to default linestyle (if (not (tblsearch "style" "Isocp")) (command "-style" "Isocp" "Isocp.ttf" 2.5 "1" 0 "n" "n")) ; to create new layer (if (not (tblsearch "layer" "Coordinate Points")) (command "-LAYER" "N" "Coordinate Points" "C" "7" "Coordinate Points" "LT" "Continuous" "Coordinate Points""LW" "0.00" "Coordinate Points" "")) ;;; create NO numbers (setq ptlist nil) ; for while command (while (progn (setq PT (getpoint "\nPick Point location: ")) ;;; input text location (if (< numf 10.0) (setq numf1 (strcat "0" (rtos numf 2 0)))) (if (>= numf 10.0) (setq numf1 (rtos numf 2 0))) (if (< snum 10.0) (setq snum1 (strcat "0" (rtos snum 2 0)))) (if (>= snum 10.0) (setq snum1 (rtos snum 2 0))) (crb) ;create block (setq mh-text (strcat name numf1 "-" snum1)) ; combine text into one variable (if (not (= pt nil))(command "CLAYER" "Coordinate Points")) (if (not (= pt nil))(command "-insert" "CRBLK" pt "1" "1" "0" mh-text)) (if (not (= pt nil))(setvar "clayer" clay)) (if (not (= pt nil))(setq snum (+ snum 1))) ; for increment (if (not (= pt nil))(setq nf-ns (+ numf 1))) (setq ptlist (append ptlist (list pt))) ; to stop while command ) ;progn ) ;while (princ) ) ;defun (defun c:RES () (setq namef "") (prompt "\nPrefix Text Variable Reseted") (princ) ) ;defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;---------- sub function for Table---------- (defun CRTable () (setq LEN (length CORDS)) ;(setq CORDS (acad_strlsort CORDS)) ;;;sorts list into order (setq CORDS (vl-sort CORDS '(lambda (x1 x2) (< (atoi x1) (atoi x2))))) ;;; sorts list into order NEW (setq CNT 0) (if (= (getvar "tilemode") 1) (setvar "tilemode" 0)) (command "pspace") (setq SP (getpoint "\nPick start point for table")) (setq ht 2.5) ;; text hieght (command "-style" "Isocp" "Isocp.ttf" 2.5 "1" 0 "n" "n") (if (not (tblsearch "layer" "Coordinate Table")) (command "-LAYER" "N" "Coordinate Table" "C" "7" "Coordinate Table" "LT" "Continuous" "Coordinate Table""LW" "0.00" "Coordinate Table" "")) (if (/= SP nil) ;;;checks for null input (progn (setq TXTX (car SP)) ;;;gets x coord of text start point (setq fx txtx) ;;; set first x value (setq TXTY (cadr SP)) ;;;gets y coord (setq fy TXTY) (setq encw 25.00) ; easting & northing Column width (setq nocw 20.00) ; number Column width (setq ten (/ encw 2)) (setq tno (+ (/ nocw 2) ten)) ;; place easting & northing text (entmake (list (cons 0 "text") (cons 1 "COORDINATES") (cons 7 "Isocp") (cons 8 "Coordinate Table") (cons 10 (list (+ TXTX 2.5) (+ TXTY (/ ht 2) (* ht 2)))) (cons 11 (list (+ TXTX 2.5) (+ TXTY (/ ht 2) (* ht 2)))) (cons 40 3.0) (cons 50 0.0) (cons 72 4) ) ) (entmake (list (cons 0 "text") (cons 1 "POINTS") (cons 7 "Isocp") (cons 8 "Coordinate Table") (cons 10 (list (- TXTX tno) TXTY)) (cons 11 (list (- TXTX tno) TXTY)) (cons 40 ht) (cons 50 0.0) (cons 72 4) ) ) (entmake (list (cons 0 "text") (cons 1 "EASTING") (cons 7 "Isocp") (cons 8 "Coordinate Table") (cons 10 (list TXTX TXTY)) (cons 11 (list TXTX TXTY)) (cons 40 ht) (cons 50 0.0) (cons 72 4) ) ) (entmake (list (cons 0 "text") (cons 1 "NORTHING") (cons 7 "Isocp") (cons 8 "Coordinate Table") (cons 10 (list (+ TXTX encw) TXTY)) (cons 11 (list (+ TXTX encw) TXTY)) (cons 40 ht) (cons 50 0.0) (cons 72 4) ) ) ;; place easting & northing horizontal table lines (entmake (list (cons 0 "line") (cons 8 "Coordinate Table") (cons 10 (list (- TXTX (+ ten nocw)) (+ TXTY ht))) (cons 11 (list (+ TXTX ten encw) (+ TXTY ht))) ) ) (entmake (list (cons 0 "line") (cons 8 "Coordinate Table") (cons 10 (list (- TXTX (+ ten nocw)) (- TXTY ht))) (cons 11 (list (+ TXTX ten encw) (- TXTY ht))) ) ) (repeat LEN (setq TXTY (- TXTY (* 2 HT))) ;;;set new y coord for text (setq SP (list TXTX TXTY)) ;;;creates code start point (setq CORD (nth CNT CORDS)) ;;;gets coord from list (setq COLEN (strlen CORD)) ; (setq COM 1 GAP 1) (while (/= COLEN COM) ; (setq COM1 (substr CORD COM 1)) ;finds ',' in strings for (if (and (= COM1 ",") (= GAP 1)) (setq S1 COM GAP 2)) ;spliting string (if (and (= COM1 ",") (= GAP 2)) (setq S2 COM)) ; (setq COM (+ COM 1)) ; ) ;while (setq CODE (substr CORD 1 (- S1 1))) ;;;strips of code (setq SON (substr CORD (+ S1 1) (- S2 S1 1))) ;;;strips of north (setq SOE (substr CORD (+ S2 1) (- COLEN S2))) ;;;strips of east (entmake (list (cons 0 "text") (cons 1 code) (cons 7 "Isocp") (cons 8 "Coordinate Table") (cons 10 (list (- TXTX tno) TXTY)) (cons 11 (list (- TXTX tno) TXTY)) (cons 40 ht) (cons 50 0.0) (cons 72 4) ) ) (entmake (list (cons 0 "text") (cons 1 soe) (cons 7 "Isocp") (cons 8 "Coordinate Table") (cons 10 (list TXTX TXTY)) (cons 11 (list TXTX TXTY)) (cons 40 ht) (cons 50 0.0) (cons 72 4) ) ) (entmake (list (cons 0 "text") (cons 1 son) (cons 7 "Isocp") (cons 8 "Coordinate Table") (cons 10 (list (+ TXTX encw) TXTY)) (cons 11 (list (+ TXTX encw) TXTY)) (cons 40 ht) (cons 50 0.0) (cons 72 4) ) ) (entmake (list (cons 0 "line") (cons 8 "Coordinate Table") (cons 10 (list (- TXTX (+ ten nocw)) (- TXTY ht))) (cons 11 (list (+ TXTX ten encw) (- TXTY ht))) ) ) ;; horizontal lines (setq hl (entlast)) ; set hl as last horizontal line (setq CNT (+ CNT 1)) ) ;repeat (setq ly (caddr (assoc 10 (entget hl)))) ;set last y value ;; place easting & northing vertical table lines (entmake (list (cons 0 "line") (cons 8 "Coordinate Table") (cons 10 (list (- fx ten) (+ fy ht))) (cons 11 (list (- fx ten) ly)) ) ) (entmake (list (cons 0 "line") (cons 8 "Coordinate Table") (cons 10 (list (+ fx ten) (+ fy ht))) (cons 11 (list (+ fx ten) ly)) ) ) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 "Coordinate Table") (cons 90 4) (cons 70 1) (cons 10 (list (- fx (+ ten nocw)) (+ fy (* ht 4)))) (cons 10 (list (+ fx (+ ten encw)) (+ fy (* ht 4)))) (cons 10 (list (+ fx (+ ten encw)) ly)) (cons 10 (list (- fx (+ ten nocw)) ly)) ) ) ; inner rectangle (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 "Coordinate Table") (cons 90 4) (cons 70 1) (cons 10 (list (- fx (+ ten nocw 1)) (+ fy (* ht 4) 1))) (cons 10 (list (+ fx (+ ten encw 1)) (+ fy (* ht 4) 1))) (cons 10 (list (+ fx (+ ten encw 1)) (- ly 1))) (cons 10 (list (- fx (+ ten nocw 1)) (- ly 1))) ) ) ; outer rectangle (command "erase" hl "") ) ; progn ) ;if (command "redraw") (princ) ) ; defun ;;-------------Main function to make List of points----- (defun c:CRT (/ txtx txty len cord cords cnt sp ht code son soe sox soy so1 encw nocw ten tno lat hl ly fx fy) (setvar "cmdecho" 0) (setq temperr *error*) (setq *error* trap3) (setq CORDS nil LEN nil CNT 0) ;;resets coord list to nil (princ (strcat "\n ")) (initget 1 "All Select") (setq sel (strcase (getkword "\Select individual coordinate points or Select All (S or A): "))) (if (= sel "SELECT") (setq SS (ssget '((2 . "crblk")))) (setq SS (ssget "X" '((2 . "crblk"))))) (command "UCS" "WORLD") (while (/= SS nil) ;;;checks for nil selection (setq LEN (sslength SS)) (repeat LEN (setq SO0 (ssname SS CNT)) (setq CORD (cdr (assoc '10 (entget SO0)))) ;;;gets coords of point (setq SOX (rtos (car CORD) 2 3)) ;;;strips off X coord (setq SOY (rtos (cadr CORD) 2 3)) ;;;strips off Y coord (setq SO1 (entnext SO0)) ;;;gets attribute entity (setq CODE (cdr (assoc '1 (entget SO1)))) ;;;strips off point code from attribute (setq CORD (strcat CODE "," SOY "," SOX)) ;;;creates string of code,y,x (setq CORDL (list CORD)) ;;;converts into list (if (= CORDS nil) (setq CORDS CORDL) (setq CORDS (append CORDL CORDS))) ;;;starts new list or adds to old (setq CNT (+ CNT 1)) ) (setq SS nil) ;;;finishes loop ) ;while (command "UCS" "P") (if (/= (length CORDS) 0) (CRTable)) (setq *error* temperr) (prompt "\n Coordinate Table is Placed\n © Bijoy Manoharan 2011 www.cadlispandtips.com") (princ) ) ;defun ;;------------- end Main function -------------------- ;;-------------Main function to make List of points by fields and in reail table----- (defun c:FCRT (/ e n blk corlis txtx txty len cord cords cnt sp ht code son soe sox soy so1 encw nocw ten tno lat hl ly fx fy) (setvar "cmdecho" 0) (setq temperr *error*) (setq *error* trap3) (setq CORDS nil LEN nil CNT 0) ;;resets coord list to nil (princ (strcat "\n ")) (initget 1 "All Select") (setq sel (strcase (getkword "\Select individual coordinate points or Select All (S or A): "))) (if (= sel "SELECT") (setq SS (ssget '((2 . "crblk")))) (setq SS (ssget "X" '((2 . "crblk"))))) (command "UCS" "WORLD") (if (/= SS nil) (repeat (setq n (sslength ss)) (setq blk (ssname ss (setq n (- n 1)))) (setq corlis (cons (list (cdr (assoc '1 (entget (entnext blk)))) (strcat "%<\\AcObjProp Object(%<\\_ObjId " (ObjectID (vlax-ename->vla-object (entnext blk))) ">%).TextString>%") (strcat "%<\\AcObjProp Object(%<\\_ObjId " (ObjectID (vlax-ename->vla-object blk)) ">%).InsertionPoint \\f \"" "%lu2%pt1%pr3" "\">%") (strcat "%<\\AcObjProp Object(%<\\_ObjId " (ObjectID (vlax-ename->vla-object blk)) ">%).InsertionPoint \\f \"" "%lu2%pt2%pr3" "\">%") ) corlis ) ) ) ) (if (> (setq n (length corlis)) 0) (progn ;(setq n (+ n 1)) (setq corlis (vl-sort corlis '(lambda (x1 x2) (< (if (> (atoi (car x1)) 0) (atoi (car x1)) (car x2)) (if (> (atoi (car x2)) 0) (atoi (car x2)) (car x2)))))) (initget 1) (setq pt (getpoint "\nSelect point for table: ")) (foreach li corlis (if (not e) (setq e pt) (setq e (list (+ (car e) (vla-get-width tap) 3) (cadr e) (caddr e)))) (command "-TABLE" 1 3 e) (setq tap (vlax-ename->vla-object (entlast))) (vla-SetText tap 0 0 (strcat "BEND - " (nth 1 li))) (vla-SetText tap 2 0 (strcat "E=" (nth 2 li))) (vla-SetText tap 3 0 (strcat "N=" (nth 3 li))) ) ) ) (command "UCS" "P") (setq *error* temperr) (prompt "\n Coordinate Table is Placed") (princ) ) ;defun (defun ObjectID ( obj ) (eval (list 'defun 'ObjectID '( obj ) (if (and (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE")) (vlax-method-applicable-p (vla-get-utility (acdoc)) 'getobjectidstring) ) (list 'vla-getobjectidstring (vla-get-utility (acdoc)) 'obj ':vlax-false) '(itoa (vla-get-objectid obj)) ) ) ) (ObjectID obj) ) (defun acdoc nil (eval (list 'defun 'acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (acdoc) ) ;;------------- end Main function -------------------- ATT Cordinates IN Table - CN,FCRT.LSP Drawing - Copy111.dwg
  19. I've been looking for a routine that will allow me to transfer an attribute from one block to another. Ideally I'd like to click on one block which contains the attribute I want (from a field called ID_1), then click on another block and copy the attribute to another specific field (ID_2). I need to do this to quite a few blocks so I'd like to just continue to click between the two types of block. I thought I could modify the code on this page http://www.cadtutor.net/forum/showthread.php?32085-Need-Lisp-to-update-attributes, but this appears to place the same attribute on every block I click. Any help is greatly appreciated!
  20. Hello, I apologize if my terminology is off as I generally do not work in CAD/LISP. I am working on a lisp routine that draws blocks and adds attributes to the blocks (labels). I set the blocks to be a solid hatch and set their colour with (setvar "cecolor" "255"). After I finished I realized it would be nice to add the ability to draw the blocks without fill if the user wishes. I thought their would be a system variable something like (setvar "transparency" "100") but I can't find anything. Does anyone know how to set the transparency of block fill using LISP or how to set the colour to NULL? Thanks
  21. Good morning all, I am trying to create a linetype that uses a polyline/block to create a series of thicker arrows. I have written: *DIVERSION,DIVERSION DRAIN -----> -----> A,.982117,-.256835,[DIVERSION,DIVERSION.SHX,X=0,S=.25].977201 But it does not seem to work just comes out as a series of dashes. I have attached a few things that may help. Cheers Allison DIVERSION.lin DIVERSION.shp DIVERSION.shx
  22. Hi. I am generating a block using ENTMAKE, but I have noticed that the property "InsUnits (RO)" indicates "Unitless". The variable "INSUNITS of the document (drawing) is set to "6" for Meters, but when generating the Block the property is set as Unitless. How do I assign the property to the BLOCK as this is the INSUNITS variable? (defun ent-block (nameBlock pto-ins atrib-var / ) (entmake (list '(0 . "BLOCK") '(100 . "AcDbEntity") '(100 . "AcDbBlockBegin") '(8 . "0") (cons 2 nameBlock) (cons 10 pto-ins) (cons 70 (if atrib-var 2 0)) ) ) ) (defun makeBlockGMM (listaEntNames nameBlock pto-ins atrib-var / msg ciclo) (defun ciclo ( listaEntNames / X) (foreach X listaEntNames (entmake (entget X)) ) ) (if (vl-catch-all-error-p (setq resultado01 (vl-catch-all-apply 'ent-block (list nameBlock pto-ins atrib-var)))) (progn (prompt (setq msg (strcat "**ERROR en Cabecera, mensage de error: " (vl-catch-all-error-message resultado01)))) ) ) (if (and (not msg ) (vl-catch-all-error-p (setq resultado02 (vl-catch-all-apply 'ciclo (list listaEntNames))))) (progn (prompt (setq msg (strcat "**ERROR en creacion de entidades, mensage de error: " (vl-catch-all-error-message resultado02)))) ) ) (if (and (equal resultado1 nil) (equal resultado2 nil)) (progn (ent-endblock) ) ) ) (defun ent-endblock ( / ) (entmake (list '(0 . "ENDBLK") '(100 . "AcDbEntity") '(100 . "AcDbBlockEnd") '(8 . "0") ) ) ) Regards.
  23. I have a block with about 60 single-line text entities, 40 of which have a place holder character that needs to change based on how the block is used. For example, "~1a" and "~1b" need to change to "P1a" and "P1b", where "~" is the place holder and "P" is the letter for this 1 block. The next instance of the same block will need a different letter. This is not a good application for attributes. I found Lee Mac's LISP c:ReplaceBlockText in this thread using vlax-for, but it appears to work on the block definition and changes the text for every instance of the block in the drawing. I need this to work on 1 selected instance of the block. Any help is appreciated, even if it's a point in the right direction.
  24. Hello, In this DWG i need to pair text (which is room function) with block attribute "FUNCTION" that i've created. I can do this manually but it's over 1000 blocks ,so that make me wonder is it possible to create LISP which take nearest text into block attribute. I've found that LISP (https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/add-text-value-to-a-block-attibute/td-p/7949545) but it's swaping texts over rooms for example in room where laboratorium is located it name it biuro which is located next to it. Sorry for my plain english, I'm not native speaker. Thanks in advance! test_1.dwg
×
×
  • Create New...