Search the Community

Hello everyone, can anyone help me, I have a case example that is almost similar to the actual case I am experiencing now. In the 1st picture I have a shapefile of the administrative boundaries of the United States that I have entered into autocad, the shp attribute has been entered into the data object of each feature with the data object name "GADM", in the data object there are State and County fields, for the layer of each feature I use the County field reference so that each feature is currently layered with its respective county name. what I want is that as in the 2nd picture I want each feature to be grouped or made per block per category of state, is there a quick way, because I think in each feature there is a State field? Noted: The Autocad that I use is AutocadMap 2021. Pic 1 Pic 2

Hi, I tried to write an autolisp code and I got to a certain point, but it is not working as I wanted. I would like your suggestions and your support in revising the code. What I want to do is select a block. To find out which character (n) from the right is the "-" sign in the layer name of the line touching the block I selected. Then subtract 1 from this character(n) number and add n-1 from the right. Combining the part up to the character and the prefix text and writing to the block geometric point. The way this code works now is to combine the front text and the text to the right of the "-" sign of the last layer added to the layer list and write it to the center of the block. This wasn't something I wanted. (setq *textHeight* 8) (setq *layerName* "01 Equipment list 2") (setq *textColor* 1) ; (defun c:bs_ayar () (setq *textHeight* (getreal "\nEnter new text height: ")) (setq *layerName* (getstring "\nEnter new layer name: ")) (setq *textColor* (getint "\nEnter new color index (1 for Magenta): ")) (princ (strcat "\nText height is now " (rtos *textHeight*) ", layer name is " *layerName* ", color is " (itoa *textColor*) " was set to. ")) (princ) ) (defun c:bs4 () (setq prefix (getstring T "\nEnter prefix letter: ")) (setq blk (car (entsel "\nSelect Block: "))) (setq blkEnt (entget blk)) (setq insPt (cdr (assoc 10 blkEnt))) (setq ss (ssget "_X" (list (cons 0 "LINE,POLYLINE")))) (if (and ss (> (sslength ss) 0)) (progn (setq line (ssname ss 0)) (setq lineEnt (entget line)) (setq lineLayer (cdr (assoc 8 lineEnt))) (setq dashPos (vl-string-search "-" lineLayer)) (if dashPos (setq rightPart (substr lineLayer (+ dashPos 2))) (setq rightPart lineLayer) ) (command "._-LAYER" "_M" *layerName* "" "_C" *textColor* "" "") (command "._TEXT" insPt *textHeight* "" (strcat prefix rightPart)) (command "._-LAYER" "_S" *layerName* "") ) (princ "\nNo line or polyline was found touching the selected block.") ) (princ) )

Working to standardize a bill of material drawing that must consist of nothing more than text, lines, and blocks for a client that refuses to use datalinks and I was hoping to find a way to create a standard block that could act as a row in the table with cells containing text fields. Essentially, I would like to have the functionality of attribute definitions but have them copy down using some kind of array action. Has anyone had any luck/experience with something like this? I understand it's might be kind of impossible. Attached is what I'm hoping to have as default text in the newly generated row as the user pulls down the array arrow.

I received a drawing that contains a layer in the manager box. But when I attempted to Quick Select that layer, the result returns as "0" and this same layer cannot be deleted, since the message tells me that layers with objects cannot be deleted. I thawed all layers and still get "0" and the layer won't delete. This should mean that the layer is hidden inside a block. This drawing has several hundreds of blocks! Is there an application within AutoCAD that will reveal to me which block that layer is in?

Hi, I am Michel Can you kindly to help me to. I need a lisp for a cable routing. I have just a block consist of 3 attributes (TAG, SRTP, MVZ). I need to extract each relating value in separate column in excel. For example, if I select 5 blocks in drawing, I need to have 5 columns, each column has only 3 rows (3 attributes) and the possibility to have different rows for different electric cables in same file. Thank you in advance Michel richiesta.xlsx

Hi, I would like to know some help. 01 - Is there a possibility in this Lee Mac lisp, Automatically Label Attributes, that it can be changed so that every time I open a different file it asks me about the increment, prefix and suffix settings? Because in the current way it always loads the pre-configuration that is already in lisp. I don't want to have to edit the lisp to configure the numbers for each file. Note: I use attributed blocks and multileader blocks. 02 - I also use the Lisp Incremental Numbering Suite, I would like to know if the option for multileaders can be added. As the current options are only for text, mtext and blocks. For my use multileaders are more interesting. Because the use of block with attributes will have to be manually making the leader lines to indicate their positions and references after their insertion and when you have many blocks end up wasting valuable time. I would like to know if it is possible to make any of these changes, since lisps have many lines. Note: Sorry for the google translation. #NumIncV3-9.lsp AutoLabelAttributesV1-4.lsp

What command can I use to find a block by its name in my drawing and then delete it?

I'm trying to modify some code to achieve the following: Ask the user to pick multiple blocks, step through each block, get the extents of the block, and save a view with the view name equal to the name of the block. Doing some research I've managed to get the extents of the block but can't figure out how to store the block name as a variable and use it as the view name. The code I found will draw a rectangle around the block using vla-getboundingbox but I can't figure out how to assign the name of the block to a variable for use in the -view command. I have a few hundred blocks in the same drawing. Existing code is: (defun c:BlockExtentsToRectangle (/ BlockObject mn mx) (vl-load-com) (if (setq BlockObject (car (entsel "\n >> Select Object >> "))) (progn (vla-getboundingbox (vlax-ename->vla-object BlockObject) 'mn 'mx) (vl-cmdf "._rectang" (vlax-safearray->list mn) (vlax-safearray->list mx)))) (princ) )

Drawing A: old tag definition Drawing B: new tag definition Hi Guys, I have an opened drawing file A with an old attribute tag definition and brought in another attribute block with the same name but having a new attribution tag definition from a drawing file B. I had purposefully purged drawing A’s attribute block containing the old tag definition, hoping to bring in the same-name attribute from drawing B, having new tag definition. It went well except the Enhanced Attribute Editor still contains the old tag definition of drawing A – even though Battman shows the new defined tags from drawing B. This means that I need to somehow, Purge the old defined tags from drawing A. Am I able to purge the attribute’s definition from a drawing? I am doing this so I may not have to change the attribute block’s name and keep the new tag definition. Thanks for your time, "Mitch"

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.

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

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

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

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

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!

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!

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) )

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)

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.

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

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

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

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

Hi, i need this block point. please see attached file.

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