All Activity

(defun c:ctf (/ bm num i obj db p1 p2 midpt point_list table pt) (setvar "osmode" 0) ; Select all lines (setq bm (ssget '((0 . "LINE")))) (if bm (progn ; Get number of lines (setq num (sslength bm)) (setq i 0) (setq point_list '()) ; Initialize list to store points ; Loop through each line (repeat num (setq obj (ssname bm i)) ; Get entity name (setq db (entget obj)) ; Get entity data (setq p1 (cdr (assoc 10 db))) ; Start point (setq p2 (cdr (assoc 11 db))) ; End point ; Calculate midpoint (setq midpt (mapcar '/ (mapcar '+ p1 p2) '(2 2 2))) ; Store points in list (setq point_list (cons (list p1 p2 midpt) point_list)) (setq i (1+ i)) ) (setq pt (getpoint "\nSpecify table insertion point: ")) (if pt (progn ; Create table (command "._TABLE" 4 3 pt) ; Set header (command "._TABLEdit" "A1" "TEXT" "sr.no") (command "._TABLEdit" "B1" "TEXT" "Start Point") (command "._TABLEdit" "c1" "TEXT" "endPoint") (command "._TABLEdit" "D1" "TEXT" "mid Point") ; extract data of the lines and filling in cells of table ; point_list data stored ;autocad ver 2025 ) (princ "\nNo insertion point specified.") ) ) (princ "\nNo lines selected.") ) (setvar "osmode" 511) (princ) ) I need to help data automatically fill in the cells of the table table.dwg

They are using ZWCAD. and dynamic blocks are a propriety feature of AutoDesk. (or at least were not fully functional when i was using BricsCAD might be a feature now)

Not sure why you are asking me about units, you could try making the variable names "Aunits". with double quotes, works in Bricscad, else you can use a foreach loop but I would use car & cadr in the loop, (list (list "aunits" 2)("list 'auprec"4)(......)) Just a suggestion for labelling, the character "A" is (chr 65) (chr x) so you can start with a number and each time you run the section lisp it will add 1 to the x, this will do up to 26. You can save the value of X by using ldata so when dwg is opened again you still have next value and can display that in a prompt. So Enter will give next value. Yes there is code for AA AB etc. Why not a dynamic block then can have a single stretch parameter based on the two pick points.

As Steven P said, your arcs in order to keep the same display or look should be converted to ellipses or splines, because they are in 3d and to be displayed in 2d should be converted because they're not plain sections of circles as an arc in 2d is meant to be, that's why most of the codes don't apply to what you want

Hi Bigal I try but I have problem with the angles. In my template the units set (mapcar 'setvar (list 'aunits 'auprec 'angdir 'angbase 'lunits 'luprec 'insunits ) (list 2 4 1 (/ pi 2) 2 3 6)) ; for ZWCAD (defun C:SECTIONLINE ( / pt1 pt2 dirpt baseAngle dirAngle ang arrowBase arrowHeight secLetter txtpt1 txtpt2 angleDeg p1 p2 p3 offset letterOffset) (command "._STYLE" "Section" "Arial" 0.0 1.4 0 "N" "N" "N") (if (= (tblsearch "layer" "Section") nil) (vl-cmdf "_layer" "_m" "Section" "_c" "10" "" "_lw" "0.05" "" "") ) (setvar "clayer" "Section") (setq arrowBase 0.69) (setq arrowHeight 0.27) (setq offset 0.11) (setq letterOffset 0.31) (setq pt1 (getpoint "\nSelect first point of section line: ")) (if (not (and pt1 (listp pt1))) (progn (princ "\nCanceled or invalid first point.") (quit)) ) (setq pt2 (getpoint pt1 "\nSelect second point of section line: ")) (if (not (and pt2 (listp pt2))) (progn (princ "\nCanceled or invalid second point.") (quit)) ) (setq dirpt (getpoint "\nPick a point to define section direction: ")) (if (not (and dirpt (listp dirpt))) (progn (princ "\nCanceled or invalid direction point.") (quit)) ) (setq secLetter (getstring T "\nEnter section letter (e.g., A, B): ")) (if (= secLetter "") (setq secLetter "A")) (setq baseAngle (angle pt1 pt2)) (setq dirAngle (angle pt1 dirpt)) (setq ang (if (< (abs (- baseAngle dirAngle)) (/ pi 2.0)) dirAngle (+ dirAngle pi))) (command "._LINE" "_non" pt1 "_non" pt2 "") (setq p1 (polar pt1 baseAngle offset) (setq p2 (polar p1 (+ baseAngle (/ pi 2.0)) (/ arrowBase 2.0))) (setq p3 (polar p1 (- baseAngle (/ pi 2.0)) (/ arrowBase 2.0))) (command "._PLINE" "_non" p2 "_non" (polar p1 ang arrowHeight) "_non" p3 "_non" p2 "") (command "._HATCH" "SOLID" "_L" "" "") (setq txtpt1 (polar pt1 ang letterOffset)) (setq angleDeg (* 400.0 (/ baseAngle pi))) (command "._TEXT" "J" "MC" "_non" txtpt1 0.27 angleDeg secLetter) (setq p1 (polar pt2 (- baseAngle pi) offset)) (setq p2 (polar p1 (+ baseAngle (/ pi 2.0)) (/ arrowBase 2.0))) (setq p3 (polar p1 (- baseAngle (/ pi 2.0)) (/ arrowBase 2.0))) (command "._PLINE" "_non" p2 "_non" (polar p1 ang arrowHeight) "_non" p3 "_non" p2 "") (command "._HATCH" "SOLID" "_L" "" "") (setq txtpt2 (polar pt2 ang letterOffset)) (command "._TEXT" "J" "MC" "_non" txtpt2 0.27 angleDeg secLetter) (princ "\nSection line created successfully.") (princ) ) Thanks

arcs in this case will need to be converted to ellipses to display properly.. something to think about

ı tried but dindt work for arc. But thanks for interest

I'm sure I did because I tried exploding an object. But it didn't fill. There must be an error somewhere, but I couldn't find it, so I tried another method. Also, I'm a new programmer and I started writing lips without knowing anything about ACAD, so it was extra difficult. I'm glad this forum exists :)))

Thanks for interest. you can try this dwg also. I 'm waiting yours code. arc.dwg

You can try this dwg. But ı wrote code for arc this code. arc.dwg ((member entType '("ARC" "CIRCLE" "ELLIPSE") ) (vla-put-Center data (vlax-3d-point (list (car (vlax-get data 'Center)) (cadr (vlax-get data 'Center)) 0.0 ) ) ) (vl-catch-all-apply (function (lambda () (vlax-put data 'Normal (list 0.0 0.0 1.0)) ) ) ) ) But this code also didnt work.

You haven't defined "arrowAng" variable and you are using it in (polar) function... Sorry, my mistake - you defined it firstly... [EDIT : You should changle variable "angle" to something different like "ang" as (angle) is AutoLISP function and then you should localize "ang" in main (defun) instead of "angle"...]

(defun C:SECTIONLINE ( / pt1 pt2 dirpt baseAngle dirAngle angle arrowLen arrowAng secLetter txtpt angleDeg p1 p2 ) (setq arrowLen 10.0) (setq arrowAng (/ pi 6.0)) (setq pt1 (getpoint "\nSelect first point of section line: ")) (if (not (and pt1 (listp pt1))) (progn (princ "\nCanceled or invalid first point.") (quit)) ) (setq pt2 (getpoint pt1 "\nSelect second point of section line: ")) (if (not (and pt2 (listp pt2))) (progn (princ "\nCanceled or invalid second point.") (quit)) ) (setq dirpt (getpoint "\nPick a point to define section direction: ")) (if (not (and dirpt (listp dirpt))) (progn (princ "\nCanceled or invalid direction point.") (quit)) ) (setq baseAngle (angle pt1 pt2)) (setq dirAngle (angle pt1 dirpt)) (setq angle (if (< (abs (- baseAngle dirAngle)) (/ pi 2.0)) baseAngle (+ baseAngle pi))) (command "._LINE" "_non" pt1 "_non" pt2 "") (setq p1 (polar pt1 (+ angle arrowAng) arrowLen)) (setq p2 (polar pt1 (- angle arrowAng) arrowLen)) (command "._LINE" "_non" pt1 "_non" p1 "") (command "._LINE" "_non" pt1 "_non" p2 "") (setq p1 (polar pt2 (+ angle arrowAng) arrowLen)) (setq p2 (polar pt2 (- angle arrowAng) arrowLen)) (command "._LINE" "_non" pt2 "_non" p1 "") (command "._LINE" "_non" pt2 "_non" p2 "") (setq secLetter (getstring T "\nEnter section letter (e.g., A, B): ")) (if (= secLetter "") (setq secLetter "A")) (if (and (listp pt1) (listp pt2)) (progn (setq txtpt (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pt1 pt2)) (setq angleDeg (* 180.0 (/ angle pi))) (command "._TEXT" "_non" txtpt 2.5 angleDeg (strcat secLetter "-" secLetter)) ) (princ "\nText not placed due to invalid points.") ) (princ "\nSection line created successfully.") (princ) ) I have this error (I use ZWCAD) Command: SECTIONLINE Select first point of section line: Select second point of section line: Pick a point to define section direction: Error: undefined function - nil Thanks

I am searching for a lisp code to draw a section line like the test.dwg. 1) Select 2 points for the length of the section 2) Pick a point for the direction of the section 3) Draw section line with the arrows and ask for the section letter for exampl A,B Thanks TEST.dwg

Then something wasn't created or modified. aka trying to exploding a invalid or corrupted region, or one that is on a locked layer. maybe run audit and purge before and then check if entity is on a locked layers. -Edit Writing lisp isn't the hard part. figuring out all the different things that could go wrong and how to handle that is the hard part. had a user that would always select things with the crossing selection option(bottom right to top left) and complain about how my lisp was picking up things "outside" what they where selecting.

I found it making a google research is at: https://sites.google.com/site/cadkits/home/chz20 And I don't know if this is of some help

Hi, I need some help in changing the line/edge colour of a 200mm. wall in revit. I want the line to appear red in contrast to other wall line colout to emphasize its size. I have been able to change the hatching to red but I am currently unable to change the link thickness. it seemed much easier in other newer version but 2019 it is almost impossible from my point of view. Thanks in advance for your help.

There is a CHZ20.vlx around somewhere, I do not recall everything it does or how fast it would be. What exactly is the time on a basic drawing? As mentioned, cannot really tell any specific issues without the full LISP. I have noticed FLATTEN actually can take a long time on a drawing with lots of objects, even if it is completely z=0 already. FLATTEN and FLATSHOT are mostly useless, IMHO. I would start with just a simple z=0 LISP, then run different LISPs to specifically target other objects like Regions and Blocks. I am not sure if the arc issue have ever been solved, you may have to look around and see. Can you post a sample drawing?

I managed to fix this problem using AI. I don't know how to write Lisp myself. Wpipe test.lsp

That's strange, in my testing it works as I expected. Are you able to post a sample drawing with an arc that rotates? Going to look at the other object types sometime today for you. There is a list at the top of 'Flatten Lines' that work at the moment for info.

my code was like this but sometimes lastent didnt work so ı changed.

and tred this code but rotated arces move y axis so drawing broken. anda also need this objtype;

thanks @Steven P. ı added and its work but ı dont sure more faster than previous

Hi Bigal, Could you help me with this error?, thanks in advance Command: CONC1 (600 600 50 12 12 12 12 4 4 2 2 10) Pick lower left pt ; error: AutoCAD rejected function: invalid table function argument(s): "Layers" "BEAM"

Hi, Here is a code that projected simples entities : POLYLINE,LWPOLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE,POINT. on the SCG at a Z-coordinate to zero if as the entities of start are in a UCS parallel or not. For example, a circle in a UCS non-parallel will become an ellipse. I do this because this is much faster than FLATTEN (which is more efficient: it can handle more entities, but slow) If it can help... (defun l-coor2l-pt (lst flag / ) (if lst (cons (list (car lst) (cadr lst) (if flag (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst)) (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) ) ) (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag) ) ) ) (vl-load-com) (defun c:my_project ( / jspl nbr n AcDoc Space UCS save_ucs WCS ent_name indx l_blg l_pt ename id_obj pl_typ index nw_pl) (setq jspl (ssget '((-4 . "<OR") (-4 . "<AND") (0 . "POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>") (-4 . "AND>") (0 . "LWPOLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE,POINT") (-4 . "OR>")) ) nbr -1 n 0 ) (cond (jspl (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) UCS (vla-get-UserCoordinateSystems AcDoc) save_ucs (vla-add UCS (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point (getvar "UCSXDIR")) (vlax-3d-point (getvar "UCSYDIR")) "CURRENT_UCS" ) ) (vla-put-Origin save_ucs (vlax-3d-point (getvar "UCSORG"))) (vla-StartUndoMark AcDoc) (setq WCS (vla-add UCS (vlax-3d-Point '(0.0 0.0 0.0)) (vlax-3d-Point '(1.0 0.0 0.0)) (vlax-3d-Point '(0.0 1.0 0.0)) "TEMP_WCS")) (vla-put-activeUCS AcDoc WCS) (repeat (sslength jspl) (setq ent_name (ssname jspl (setq nbr (1+ nbr))) indx -1 l_blg nil l_pt nil ename (vlax-ename->vla-object ent_name) id_obj (vla-get-ObjectName ename) ) (cond ((member id_obj '("AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline")) (setq pl_typ (if (vlax-property-available-p ename 'Type) (vlax-get ename 'Type))) (if (member id_obj '("AcDbPolyline" "AcDb2dPolyline")) (if (not (equal (vlax-get ename 'Normal) '(0.0 0.0 1.0) 1E-13)) (progn (repeat (fix (vlax-curve-getEndParam ename)) (setq l_pt (cons (vlax-curve-GetPointAtParam ename (setq indx (1+ indx))) l_pt) index (float indx)) (if (or (eq pl_typ 1) (if (< pl_typ 3) (not (zerop (vla-GetBulge ename indx))))) (while (eq indx (fix (+ 0.01 index))) (setq l_pt (cons (vlax-curve-GetPointAtParam ename (setq index (+ 0.01 index))) l_pt)) ) ) ) (setq l_pt (cons (vlax-curve-getEndPoint ename) l_pt)) ) (setq l_pt (mapcar '(lambda (x) (trans (list (car x) (cadr x) (- ;+ (if (eq id_obj "AcDbPolyline") (caddr x) 0.0) (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) ) ) ent_name 0 ) ) (l-coor2l-pt (vlax-get ename 'Coordinates) (eq id_obj "AcDb2dPolyline")) ) ) ) (setq l_pt (l-coor2l-pt (vlax-get ename 'Coordinates) T)) ) (if (eq (vla-get-ObjectName ename) "AcDbPolyline") (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car l_pt) (mapcar 'cadr l_pt))))) (setq nw_pl (vlax-invoke Space 'AddPolyline (apply 'append l_pt))) ) (vla-put-Normal nw_pl (vlax-3d-point '(0 0 1))) (if (vlax-property-available-p ename 'Type) (progn (setq pl_typ (if (eq (vla-get-ObjectName ename) "AcDb3dPolyline") (if (zerop (vlax-get ename 'Type)) (vlax-get ename 'Type) (1+ (vlax-get ename 'Type))) (vlax-get ename 'Type) ) ) (if (and (vlax-property-available-p ename 'Normal) (not (equal (vlax-get ename 'Normal) '(0.0 0.0 1.0) 1E-13)) (eq pl_typ 1)) (vla-put-Type nw_pl 0) (vla-put-Type nw_pl pl_typ) ) ) (if (and (vlax-property-available-p ename 'Normal) (equal (vlax-get ename 'Normal) '(0 0 1) 1E-13)) (progn (repeat (length l_pt) (setq l_blg (cons (vla-GetBulge ename (setq indx (1+ indx))) l_blg))) (foreach el l_blg (vla-SetBulge nw_pl indx el) (setq indx (1- indx))) ) ) ) (vla-put-Closed nw_pl (vlax-get ename 'Closed)) ) ((member id_obj '("AcDbEllipse" "AcDbCircle" "AcDbArc")) (if (not (equal (vlax-get ename 'Normal) '(0.0 0.0 1.0) 1E-13)) (progn (setq index (vlax-curve-getStartParam ename) l_pt (list (vlax-curve-GetPointAtParam ename index)) ) (while (< (setq index (+ 0.01 index)) (vlax-curve-getEndParam ename)) (setq l_pt (cons (vlax-curve-GetPointAtParam ename index) l_pt)) ) (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car l_pt) (mapcar 'cadr l_pt))))) ) (cond ((eq id_obj "AcDbEllipse") (setq l_pt (vlax-get ename 'Center) nw_pl (vlax-invoke Space 'AddEllipse (list (car l_pt) (cadr l_pt) 0.0) (list (car (vlax-get ename 'MajorAxis)) (cadr (vlax-get ename 'MajorAxis)) 0.0) (* (caddr (vlax-get ename 'Normal)) (vlax-get ename 'RadiusRatio)) ) ) (vla-put-Normal nw_pl (vlax-3d-point '(0 0 1))) (vla-put-StartAngle nw_pl (vlax-get ename 'StartAngle)) (vla-put-StartParameter nw_pl (vlax-get ename 'StartParameter)) (vla-put-EndParameter nw_pl (vlax-get ename 'EndParameter)) ) ((or (eq id_obj "AcDbArc") (eq id_obj "AcDbCircle")) (setq l_pt (vlax-get ename 'Center) nw_pl (if (eq id_obj "AcDbArc") (vlax-invoke Space 'AddArc (list (car l_pt) (cadr l_pt) 0.0) (vlax-get ename 'Radius) (vlax-get ename 'StartAngle) (vlax-get ename 'EndAngle)) (vlax-invoke Space 'AddCircle (list (car l_pt) (cadr l_pt) 0.0) (vlax-get ename 'Radius)) ) ) (vla-put-Normal nw_pl (vlax-3d-point '(0 0 1))) ) ) ) ) ((eq id_obj "AcDbSpline") (if (or (zerop (vlax-get ename 'IsPlanar)) (and (not (zerop (vlax-get ename 'IsPlanar))) (not (equal (cdr (assoc 210 (entget ent_name))) '(0.0 0.0 1.0) 1E-13)) ) ) (progn (setq index (vlax-curve-getStartParam ename) l_pt (list (vlax-curve-GetPointAtParam ename index)) ) (while (< (setq index (+ 10.0 index)) (vlax-curve-getEndParam ename)) (setq l_pt (cons (vlax-curve-GetPointAtParam ename index) l_pt)) ) (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car l_pt) (mapcar 'cadr l_pt))))) ) (progn (setq l_pt (l-coor2l-pt (if (zerop (vlax-get ename 'NumberOfFitPoints)) (cdddr (reverse (cdddr (reverse (vlax-get ename 'ControlPoints))))) (vlax-get ename 'FitPoints)) T) nw_pl (vlax-invoke Space 'AddSpline (apply 'append (mapcar '(lambda (x y) (list x y 0.0)) (mapcar 'car l_pt) (mapcar 'cadr l_pt))) (list (car (vlax-curve-getFirstDeriv ename 0)) (cadr (vlax-curve-getFirstDeriv ename 0)) 0.0) (list (car (vlax-curve-getFirstDeriv ename (vlax-curve-getEndParam ename))) (cadr (vlax-curve-getFirstDeriv ename (vlax-curve-getEndParam ename))) 0.0) ) l_pt (l-coor2l-pt (vlax-get ename 'ControlPoints) T) ) (vla-put-ControlPoints nw_pl (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble (cons 0 (1- (* (length l_pt) 3))) ) (apply 'append (mapcar '(lambda (x y) (list x y 0.0)) (mapcar 'car l_pt) (mapcar 'cadr l_pt))) ) ) ) ) ) ) ((eq id_obj "AcDbLine") (setq nw_pl (vlax-invoke Space 'AddLine (list (car (vlax-get ename 'StartPoint)) (cadr (vlax-get ename 'StartPoint)) 0.0) (list (car (vlax-get ename 'EndPoint)) (cadr (vlax-get ename 'EndPoint)) 0.0) ) ) (vla-put-Normal nw_pl (vlax-3d-point '(0 0 1))) ) ((eq id_obj "AcDbPoint") (setq nw_pl (vlax-invoke Space 'AddPoint (list (car (vlax-get ename 'Coordinates)) (cadr (vlax-get ename 'Coordinates)) 0.0) ) ) (vla-put-Normal nw_pl (vlax-3d-point '(0 0 1))) ) ) (vla-put-TrueColor nw_pl (vla-get-TrueColor ename)) (vla-put-LineType nw_pl (vla-get-LineType ename)) (vla-put-LinetypeScale nw_pl (vla-get-LinetypeScale ename)) (vla-put-Lineweight nw_pl (vla-get-Lineweight ename)) (vla-put-Material nw_pl (vla-get-Material ename)) (vla-put-Layer nw_pl (vla-get-Layer ename)) (vla-delete ename) ) (and save_ucs (vla-put-activeUCS AcDoc save_ucs)) (and WCS (vla-delete WCS) (setq WCS nil)) (vla-EndUndoMark AcDoc) (princ (strcat "\n" (itoa (sslength jspl)) " entity(s) submissive to the command. ENDED !" ) ) ) (T (princ "\nNo compliant entities selected..!")) ) (prin1) )