All Activity

@Nikon IMHO - the extra variables that mhupp referenced in his example are unnecessary and you didn't localize them. I'd recommend you simplify to this: (defun c:trapezoid (/ bw p0 p1 p2 p3 p4 ra sa th) (if (and (setq bw (getreal "\nEnter the width of the Base: ")) (setq th (getreal "\nEnter the Height: ")) (setq sa (getreal "\nEnter the side angles: ")) (setq p0 (getpoint "\nSelect the insertion point: ")) ) (progn (setq ra (* pi (/ sa 180.0)) p1 (list (- (car p0) (/ bw 2)) (cadr p0) (caddr p0)) p2 (list (+ (car p1) bw) (cadr p0) (caddr p0)) p3 (list (+ (car p2) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) p4 (list (- (car p1) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) ) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)) (mapcar '(lambda (x) (cons 10 x)) (list p1 p2 p3 p4)) ) ) ) ) )

@mhupp that works fine. I personally think the benefits are extremely tiny on such a simple code form. For short routines, I tend to just use the command sequence. On more intensive stuff I use the ActiveX entity creation more often then using entmake with DXF codes.

I replaced in the code @pkenewell (command-s "._pline" "_non" p1 "_non" p2 "_non" p3 "_non" p4 "_c") with (entmakex… It works too. ;; pkenewell 14.11.2025 (defun c:trapezoid-pk-mh (/ bw p0 p1 p2 p3 p4 ra sa th) (if (and (setq bw (getreal "\nEnter the width of the Base: ")) (setq th (getreal "\nEnter the Height: ")) (setq sa (getreal "\nEnter the side angles: ")) (setq p0 (getpoint "\nSelect the insertion point: ")) ) (progn (setq ra (* pi (/ sa 180.0)) p1 (list (- (car p0) (/ bw 2)) (cadr p0) (caddr p0)) p2 (list (+ (car p1) bw) (cadr p0) (caddr p0)) p3 (list (+ (car p2) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) p4 (list (- (car p1) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) ) ; (command-s "._pline" "_non" p1 "_non" p2 "_non" p3 "_non" p4 "_c") ; pkenewell (setq pts (list p1 p2 p3 p4)) ; mhupp (setq trap (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)) (mapcar '(lambda (p) (cons 10 p)) pts) ) ) ) ) ) (princ) )

and entmake isn't affected by snaps in case you forget to bypass them as necessary. Far better I think - It is all I ever do when creating entities

Replace (command-s line with what i posted. the (sssetfirst line isn't need just to show as an example.

@mhupp thanks, but I don't understand how this can be used in the code...

I always try to avoid using command when I can. entmakex is faster and doesn't output to the command line. wrapping with setq you can even save the entity or add to selection set. (setq pts (list p1 p2 p3 p4)) (setq trap (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)) (mapcar '(lambda (p) (cons 10 p)) pts) ) ) ) (sssetfirst nil (ssadd trap))

@pkenewell Thank you, your code works perfectly! And thank you for the possibility of choice the angle.

@marko_ribar thanks, but the code gives an error: error: invalid argument type: numberp: #<SUBR @000001f24dbceca0 ANGLE> I replaced it in this line "angle" на "ang" and the code now works. (setq radian (* angle (/ pi 180.0))) → (setq radian (* ang (/ pi 180.0)))

Here's my quick version: (defun c:trapezoid (/ bw p0 p1 p2 p3 p4 ra sa th) (if (and (setq bw (getreal "\nEnter the width of the Base: ")) (setq th (getreal "\nEnter the Height: ")) (setq sa (getreal "\nEnter the side angles: ")) (setq p0 (getpoint "\nSelect the insertion point: ")) ) (progn (setq ra (* pi (/ sa 180.0)) p1 (list (- (car p0) (/ bw 2)) (cadr p0) (caddr p0)) p2 (list (+ (car p1) bw) (cadr p0) (caddr p0)) p3 (list (+ (car p2) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) p4 (list (- (car p1) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) ) (command-s "._pline" "_non" p1 "_non" p2 "_non" p3 "_non" p4 "_c") ) ) )

From what I inspected... That @dexus code works well with correct implementation of djikstra... When I used his code it bumped into endless (while) loop... Here is my revision and it should work, but result is not exact... Seems that resulting polyline is rummaging between references... Here is my revision : ; Attempt at drawing a centerline using voronoi diagram ; Voronoi diagram calculations found here: https://www.theswamp.org/index.php?topic=45085.msg503034#msg503034 (defun c:cl (/ _side ent->pts removeDuplicates minlen RemoveIDDup minpath1 triangulate getcircumcircle ss ent1 ent2 pl s1 s2 vor line) (defun _side (pline pnt / cpt end target der) (setq cpt (vlax-curve-getClosestPointTo pline pnt) ; https://www.theswamp.org/index.php?topic=55685.msg610429#msg610429 end (vlax-curve-getEndParam pline) target (vlax-curve-getParamAtPoint pline cpt) der (if (and (equal target (fix target) 1e-8) (or (vlax-curve-isClosed pline) (and (not (equal (vlax-curve-getStartParam pline) target 1e-8)) (not (equal end target 1e-8))) ) ) (mapcar (function -) (polar cpt (angle (list 0.0 0.0) (vlax-curve-getFirstDeriv pline (rem (+ target 1e-3) end))) 1.0) (polar cpt (angle (vlax-curve-getFirstDeriv pline (rem (+ (- target 1e-3) end) end)) (list 0.0 0.0)) 1.0) ) (vlax-curve-getFirstDeriv pline target) ) ) (minusp (sin (- (angle cpt pnt) (angle (list 0.0 0.0) der)))) ) (defun _polyline (pts) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 8 (getvar (quote clayer))) (cons 70 0) ) (mapcar (function (lambda (x) (cons 10 x))) pts) ) ) ) (defun ent->pts (ent acc / end ind step rtn) (setq end (vlax-curve-getEndParam ent)) (setq ind (vlax-curve-getStartParam ent)) (setq step (/ end (float acc))) (while (< ind end) (setq rtn (cons (vlax-curve-getPointAtParam ent ind) rtn)) (setq ind (+ ind step)) ) rtn ) (defun removeDuplicates (lst / a ll) (while (setq a (car lst)) (if (vl-some (function (lambda (x) (equal x a 1e-6))) (cdr lst)) (setq ll (cons a ll) lst (vl-remove-if (function (lambda (x) (equal x a 1e-6))) (cdr lst))) (setq ll (cons a ll) lst (cdr lst)) ) ) (reverse ll) ) ; https://www.theswamp.org/index.php?topic=45092.msg578984#msg578984 (defun minlen (LtsLine startEnd / ID1 ID2 IDEnd IDStart LtsID LtsIDFil LtsIDPnt LtsID_Edge LtsPath P1 P2 listpoint) (setq LtsPnt (removeDuplicates (apply (function append) LtsLine))) (setq LtsIDPnt (mapcar (function (lambda (x) (list (vl-position x LtsPnt) x))) LtsPnt)) (setq LtsID (mapcar (function (lambda (x) (vl-position x LtsPnt))) LtsPnt)) (setq IDStart (vl-position (caar startEnd) LtsPnt)) (setq IDEnd (vl-position (caadr startEnd) LtsPnt)) (setq LtsID_Edge (list)) (foreach e LtsLine (setq ID1 (caar (vl-remove-if-not (function (lambda (x) (equal (car e) (cadr x) 1e-6))) LtsIDPnt))) (setq ID2 (caar (vl-remove-if-not (function (lambda (x) (equal (cadr e) (cadr x) 1e-6))) LtsIDPnt))) (setq LtsID_Edge (append LtsID_Edge (list (list ID1 ID2 (distance (nth ID1 LtsPnt) (nth ID2 LtsPnt)))))) ) (setq LtsIDFil (RemoveIDDup LtsID_Edge)) (setq LtsPath (minpath1 IDStart IDEnd LtsID LtsIDFil)) (setq listpoint (mapcar (function (lambda (x) (nth (car x) LtsPnt))) LtsPath)) ) (defun RemoveIDDup (l) (if l (cons (car l) (RemoveIDDup (vl-remove-if (function (lambda (x) (or (and (= (car x) (car (car l))) (= (cadr x) (cadr (car l))) ) (and (= (car x) (cadr (car l))) (= (cadr x) (car (car l))) ) ) )) (cdr l) ) ) ) ) ) (defun minpath1 (g f nodes edges / brname clnodes closedl go new nodname old openl totdist ppath) (setq nodes (vl-remove g nodes)) (setq openl (list (list g 0 nil))) (setq closedl nil) (setq go t) (foreach n nodes (setq nodes (subst (list n 0 nil) n nodes)) ) (while (and go (not (= (caar closedl) f))) (setq nodname (caar openl)) (setq totdist (cadar openl)) (setq closedl (cons (car openl) closedl)) (setq openl (cdr openl)) (setq clnodes (mapcar (function car) closedl)) (foreach e edges (setq brname nil) (cond ( (= (car e) nodname) (setq brname (cadr e)) ) ( (= (cadr e) nodname) (setq brname (car e)) ) ) (if brname (progn (setq new (list brname (+ (caddr e) totdist) nodname)) (cond ( (member brname clnodes) ) ( (setq old (vl-some (function (lambda (x) (if (= brname (car x)) x))) openl)) (if (< (cadr new) (cadr old)) (setq openl (subst new old openl)) ) ) ( t (setq openl (cons new openl)) ) ) ) ) ) (setq openl (vl-sort openl (function (lambda (a b) (< (cadr a) (cadr b)))))) (and (null openl) (null (caar closedl)) (setq go nil)) ) (setq ppath (list (car closedl))) (foreach n closedl (if (= (car n) (caddr (car ppath))) (setq ppath (cons n ppath)) ) ) ppath ) ;;***************************************************************************; ;; Triangulate ; ;; Structure of Program by ElpanovEvgeniy ; ;; 17.10.2008 ; ;; edit 20.05.2011 ; ;; Program triangulate an irregular set of 3d points. ; ;; Modified and Commented by ymg June 2011. ; ;; Modified to operate on index by ymg in June 2013. ; ;; Contour Generation added by ymg in July 2013. ; ;; Removed lots of code not used for centerline function November 2025. ; ;;***************************************************************************; (defun triangulate (pl / a al b bb c cp ctr e el epos l n np npos pt r sl tl tr vl vor xmax xmin ymax ymin) (if pl (progn (setq tl nil pl (vl-sort pl (function (lambda (a b) (< (car a) (car b))))) ; Sort points list on x coordinates bb (list (apply 'mapcar (cons 'min pl)) (apply 'mapcar (cons 'max pl))) ; Replaced code to get the min and max with 3d Bounding Box Routine ; A bit slower but clearer. zmin and zmax kept for contouring xmin (caar bb) xmax (caadr bb) ymin (cadar bb) ymax (cadadr bb) np (length pl) ; Number of points to insert cp (list (/ (+ xmin xmax) 2.0) (/ (+ ymin ymax) 2.0)) ; Midpoint of points cloud and center point of circumcircle through supertriangle. r (* (distance cp (list xmin ymin)) 20) ; This could still be too small in certain case. No harm if we make it bigger. sl (list (list (+ (car cp) r) (cadr cp) 0) (list (- (car cp) r) (+ (cadr cp) r) 0) (list (- (car cp) r) (- (cadr cp) r) 0) ) ; sl list of 3 points defining the Supertriangle, I have tried initializing to an infinite triangle but it slows down calculation pl (append pl sl) ; Vertex of Supertriangle are appended to the Point list sl (list np (+ np 1) (+ np 2)) ; sl now is a list of index into point list defining the supertriangle al (list (list xmax cp r sl)) ; Initialize the Active Triangle list ; al is a list that contains active triangles defined by 4 items: ; item 0: Xmax of points in triangle. ; item 1: List 2d coordinates of center of circle circumscribing triangle. ; item 2: Radius of above circle. ; item 3: List of 3 indexes to vertices defining the triangle ctr (list cp) ; added for Voronoi n -1 ; n is a counting index into Point List ) ; Begin insertion of points (repeat np (setq n (1+ n) ; Increment Index into Point List pt (nth n pl) ; Get one point from point list el nil) ; el list of triangles edges (repeat (length al) ; Loop to go through Active triangle list (setq tr (car al) ; Get one triangle from active triangle list. al (cdr al)) ; Remove the triangle from the active list. (cond ( (< (car tr) (car pt)) (setq tl (cons (cadddr tr) tl) ctr (cons (cadr tr) ctr)) ; added for voronoi ) ; This triangle inactive. We store it's 3 vertex in tl (Final triangle list). ( (< (distance pt (cadr tr)) (caddr tr)) ; pt is inside the triangle. (setq tr (cadddr tr) ; Trim tr to vertex of triangle only. a (car tr) ; Index of First point. b (cadr tr) ; Index of Second point. c (caddr tr)) ; Index of Third point. (setq el (vl-list* (list a b) (list b c) (list c a) el)) ; ((a b) (b c) (c a) (. .) (. .).....) ) ( t (setq l (cons tr l)) ) ; tr did not meet any cond so it remain active. We store it in the swap list ) ; End cond ) ; End repeat (length al) (setq al l ; Restore active triangle list from the temporary list. l nil) ; Clear the swap list to prepare for next insertion. ; Removes doubled edges, calculates circumcircles and add them to al (while el (if (or (member (reverse (car el)) el) (member (car el) (cdr el)) ) (setq el (vl-remove (reverse (car el)) el) el (vl-remove (car el) el)) (setq al (cons (getcircumcircle n (car el) pl) al) el (cdr el)) ) ) ) ; End repeat np ; We are done with points insertion. Any triangle left in al is added to tl (foreach tr al (setq tl (cons (cadddr tr) tl) ctr (cons (cadr tr) ctr)) ; Added for Voronoi ) ; Extract all triangle edges from tl and form edges list el (setq el nil) (foreach tr tl (setq el (vl-list* (list (caddr tr) (car tr)) (list (cadr tr) (caddr tr)) (list (car tr) (cadr tr)) el ) ) ) (setq el (reverse el)) ; Here let's draw the Voronoi Diagram (setq vl nil) (foreach e el (setq npos (vl-position (reverse e) el) epos (vl-position e el)) (if npos (setq vl (cons (list (/ npos 3) (/ epos 3)) vl)) (setq vl (cons (list (- (length ctr) 1) (/ epos 3)) vl)) ) ) (setq vor nil) (while vl (setq e (car vl) vl (vl-remove (reverse e) (cdr vl)) vor (cons e vor)) ) (mapcar (function (lambda (v) (list (nth (cadr v) ctr) (nth (car v) ctr) ) )) (cdddr ; Remove the edges of Supercircle (vl-sort vor (function (lambda (a b) (> (car a) (car b)) )) ) ) ) ) ) ) ;;************************************************************************************************; ;; Written by ElpanovEvgeniy ; ;; 17.10.2008 ; ;; Calculation of the centre of a circle and circle radius ; ;; for program triangulate ; ;; ; ;; Modified ymg june 2011 (renamed variables) ; ;; Modified ymg June 2013 to operate on Index ; ;;************************************************************************************************; (defun getcircumcircle (a el pl / b c c2 cp r ang vl pt) (setq pt (nth a pl) b (nth(car el) pl) c (nth(cadr el) pl) c2 (list (car c) (cadr c)) ; c2 is point c but in 2d vl (list a (car el) (cadr el))) (if (not (zerop (setq ang (- (angle b c) (angle b pt))))) (progn (setq cp (polar c2 (+ -1.570796326794896 (angle c pt) ang) (setq r (/ (distance pt c2) (sin ang) 2.0))) r (abs r)) (list (+ (car cp) r) cp r vl) ) ) ) (if (not (while (cond ( (not (setq ss (ssget (list (cons 0 "LWPOLYLINE"))))) (princ "\nNothing selected. Try again...\n") ) ( (/= (sslength ss) 2) (princ "\nSelect 2 polylines! Try again...\n") ) ( (and (setq ent1 (ssname ss 0)) (setq ent2 (ssname ss 1)) (setq pl (append (ent->pts ent1 100) (ent->pts ent2 100))) (setq ent1 (vlax-ename->vla-object ent1)) (setq ent2 (vlax-ename->vla-object ent2)) ) nil ; Stop loop ) ) ) ) (progn (setq s1 (_side ent1 (vlax-curve-getStartPoint ent2))) (setq s2 (_side ent2 (vlax-curve-getStartPoint ent1))) (setq vor (triangulate pl)) (setq vor (vl-remove-if-not (function (lambda (line) (and (equal s1 (_side ent1 (car line))) (equal s1 (_side ent1 (cadr line))) (equal s2 (_side ent2 (car line))) (equal s2 (_side ent2 (cadr line))) ) )) (vl-remove-if (function (lambda (x) (or (equal x (list nil nil)) (not (car x)) (not (cadr x))))) vor) ) ) (if (< (distance (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent2)) (distance (vlax-curve-getEndPoint ent1) (vlax-curve-getEndPoint ent2)) ) (setq start (list (vlax-curve-getEndPoint ent1) (vlax-curve-getStartPoint ent1)) end (list (vlax-curve-getStartPoint ent2) (vlax-curve-getEndPoint ent2))) (setq start (list (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent1)) end (list (vlax-curve-getStartPoint ent2) (vlax-curve-getEndPoint ent2))) ) (setq startEnd (mapcar (function (lambda (end1 end2) (caar (vl-sort (mapcar (function (lambda (line) (list line (+ (distance (car line) end1) (distance (car line) end2) (distance (cadr line) end1) (distance (cadr line) end2) ) ) )) vor ) (function (lambda (a b) (< (cadr a) (cadr b)) )) ) ) )) start end ) ) (_polyline ( (lambda (lst / rtn) ; Draw a line of the midpoints of voronoi lines (while (cdr lst) (setq rtn (cons (mapcar (function (lambda (a b) (* (+ a b) 0.5))) (car lst) (cadr lst) ) rtn ) ) (setq lst (cdr lst)) ) rtn ) (minlen vor startEnd) ) ) ) ) (princ) )

I think you should rename the variable 'angle': 'angle' is a language symbol, that is, a function. Try changing it to 'ang', for example.

Untested, but it should work IMHO... (defun c:DrawTrapez30 (/ baseHeight height ang radian topBase pt1 pt2 pt3 pt4) (initget 7) (setq baseHeight (getreal "\nEnter the size of the bottom base: ")) (initget 7) (setq height (getreal "\nEnter the height of the trapezoid: ")) ;; Angle in radians (setq ang 30) (setq radian (* ang (/ pi 180.0))) ;; Determining the starting point (setq pt1 (mapcar (function +) (list 0.0 0.0) (getpoint "\nEnter the starting point of the lower base: "))) ;; Calculating the coordinates of the vertices of a trapezoid (setq pt2 (polar pt1 0.0 baseHeight)) (setq pt3 (polar pt2 (- (* 0.5 pi) radian) (/ height (cos radian)))) (setq pt4 (polar pt1 (+ (* 0.5 pi) radian) (/ height (cos radian)))) ;; Calculating the upper base (setq topBase (distance pt3 pt4)) ;; Drawing a trapezoid (command "_.pline" "_non" pt1 "_non" pt2 "_non" pt3 "_non" pt4 "_C") (princ) )

Hello everyone, can you tell me how to get the coordinates of the upper-left point of the trapezoid correctly? And the angle of 30 degrees does not work... (defun c:DrawTrapez30 (/ baseHeight height angle radian topBase pt1 pt2 pt3 pt4) (setq baseHeight (getreal "\nEnter the size of the bottom base: ")) (setq height (getreal "\nEnter the height of the trapezoid: ")) ;; Angle in radians (setq angle 30) (setq radian (* angle (/ pi 180.0))) ;; Calculating the upper base (setq topBase (* baseHeight (cos radian))) ;; Determining the starting point (setq pt1 (getpoint "\nEnter the starting point of the lower base: ")) ;; Calculating the coordinates of the vertices of a trapezoid??? (setq pt2 (list (car pt1) (+ (cadr pt1) height))) ; upper left point (setq pt3 (list (+ (car pt1) baseHeight) (cadr pt1))) ; lower right point (setq pt4 (list (+ (car pt1) baseHeight (* (sin radian) height)) (+ (cadr pt1) height ))) ; upper right point ;; Drawing a trapezoid (command "_.pline" pt1 pt2 pt4 pt3 "_C") (princ))

Pretty good, but still needs a lot of tweaking, it's really strange on the OPs AxisExample drawing. Looks very promising for a top notch solution, IMO. Good work.

In the future please use Code Tags for your code. (<> in the editor toolbar)

Reading about selection sets yesterday, if you are deleting from a selection set within your code, be aware that the entire set is indexed again which can add in delays (set contains entities 1 2 3 4 5 6 78 9, delete entity 5 from the set, then 6 7 8 and 9 are all indexed again to be 5 6 7 8 - time which can add up with very large selection sets). For case 1 I would be considering what you are doing in ';;;;code' to see if there are efficiencies in there (try running it as you write above to get a benchmark for the speed over your large selection set without any other codes)

I've tested the code. In this way, it is difficult to guess the desired position of the dim text. Then you have to manually correct the position of the dim text. I'm using a macro *^C^C_aidimtextmove;1;\; to move dim text with an indication of position. You can write this macro as code, but the command works once with one size, I can't add a loop to change multiple sizes in one command call. (vl-load-com) (defun C:dimtxtmove (/ ) (vl-cmdf "_aidimtextmove" "1") (vl-cmdf pause) (vl-cmdf "") (princ) )

Your code looks brilliant, but for some reason I can’t get it to work. Is it possible I’m doing something wrong?

Yeah didn't think this would be so difficult. posting what I have so far. but I think ill stop here as this code is just for testing and only leaves points and not a drawing a continuous polyline. mid.mp4 -edit would notice that line types would stop the code for some reason so hard coded continuous. or maybe just my ganky code. midpoints.lsp

(defun c:dtf (/ *error* ent obj entg dimsc but counter) (princ "\n Move DIM Text to Various Points..") ;; https://www.cadtutor.net/forum/topic/97280-toggle-dimension-lisp/#findComment-666274 (defun *error* ( msg ) (setvar 'cmdecho 0) ;; 5.28.24 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (if msg (prompt (strcat "\n" msg))) (setvar 'cmdecho 1) (princ) ) (defun dotx (/) (princ "\n ** Reset **..") (command "dimoverride" "c" ent "") (command "dim1" "hometext" ent "") ) (defun dotl (/) (setq tpos (mapcar '+ (cdr (assoc 13 entg)) (list 0 dimsc 0.0))) ;; (vlax-put obj 'TextMovement 1) (vlax-put obj 'TextPosition tpos) ) (defun dotr (/) (setq tpos (mapcar '+ (cdr (assoc 14 entg)) (list 0.5 dimsc 0.0))) (vlax-put obj 'TextMovement 1) (vlax-put obj 'TextPosition tpos) ) (defun dobl (/) (setq tpos (mapcar '+ (cdr (assoc 13 entg)) (list 0.0 (- dimsc) 0.0))) (vlax-put obj 'TextMovement 1) (vlax-put obj 'TextPosition tpos) ) (defun dobr (/) (setq tpos (mapcar '+ (cdr (assoc 14 entg)) (list 0.0 (- dimsc) 0.0))) (vlax-put obj 'TextMovement 1) (vlax-put obj 'TextPosition tpos) ) (setvar 'cmdecho 0) (setq counter 2) (while (setq ent (car (entsel "\n Pick DIM: "))) (setq entg (entget ent)) (setq obj (vlax-ename->vla-object ent)) (setq dimsc (vlax-get obj 'scalefactor)) (if (= but nil) (setq but 1)) (cond ((= counter 1) (dotl)) ((= counter 2) (dotr)) ((= counter 3) (dobl)) ((= counter 4) (dobr)) ((= counter 5) (dotx)) ) (setq counter (+ counter 1)) (if (= counter 6) (setq counter 1)) ) (setvar 'cmdecho 1) (*error* nil) (princ) )

This gets the current styles (if (not ah:vercheck)(load "vercheck")) (ah:vercheck) ; version check see vercheck.lsp (setq lst '()) (vlax-for j (vlax-get *AeccDoc* 'SurfaceS) (setq lst (cons (cons (vla-get-name j) j) lst)) ) (princ lst) It should be possible to make a single new style using the data from an existing style. I need to dump say a few of the styles to see what is in them. It will take a little while as have to go elsewhere to work on CIV3D. Then use a VLA-add a style. Similar to add description keys. Just a side comment we had a survey dwg form other software so rather than import the styles we just copied all of the other dwg into our company DWT, so everything was set up correct. The dwg had 3faces so we could make a TIN. Sounds easier way. vercheck.lsp

Getting inside the CIV3D database can be difficult. Its not a straight forward task to just get this item out of a CIV3D dwg. I did a few tasks re CIV3D and often have to look at different spots in the data base than what you would think hold the information your after. One thing I did was a IMPORT Description key sets, as you could only export. I did some other stuff with surface styles, I have a toolbar that allows you to set the current surface style without using Toolspace set contour interval, on/off etc. In Civ3D depending on version there is sample code for making different CIV3D objects like import points, make a surface style, I have limited access to CIV3D but the sample code is a few levels deep in the CIV3D directory, they have lisp and .NET examples. I think in later releases they removed some of the sample code. I will see if I can find something. Have a look at this. https://www.google.com/search?q=get+alignment+style+detials+civ3d+autolisp&rlz=1C1CHBF_enAU856AU856&oq=get+alignment+style+detials+civ3d+autolisp&gs_lcrp=EgZjaHJvbWUyBggAEEUYOTIJCAEQIRgKGKABMgcIAhAhGI8CMgcIAxAhGI8C0gEKMTcxMDRqMGoxNagCCLACAfEFrEvci61nuFXxBaxL3IutZ7hV&sourceid=chrome&ie=UTF-8

You can limit what ssget selects by entity, layer, color, size, basically anything in dxf codes. please read up on ssget This means you could just make a window selection. And not have to zoom in and out to make selections. also @Steven P already said "ssadd does a check if the entity exists in the set" check the length of SS before and after to see if it was already in the list. also also looks like your not using localized variables could be why its taking so long. (defun C:123 ( / ss pick l) (setq ss (ssadd)) (princ "\nSelect Entity: ") (while (setq pick (ssget)) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex pick))) (setq l (sslength ss)) ; Length before adding (setq ss (ssadd ent ss)) ; Try adding entity (if (= l (sslength ss)) ; If length is the same, item was already in list (princ "\n\nDuplicate Selected Line") ) ) (princ (strcat "\n" (itoa (sslength ss)) " Entities now in Selection SS")) ) ; rest of code goes here (princ) ) (defun C:bm ( / ss ent) (while (setq SS (ssget (ssget "_+.:E:S"))) ;exits if selection isn't made (setq ent (ssname ss 0)) ;CODE ) )

Is it possible to import surface styles from my template using lisp? I asked Claude and the lisp provided inserts all object styles. ;;-------------------------=={ Import Alignment Styles }==---------------;; ;; ;; ;; Imports Alignment Styles from Power Generation template ;; ;; Uses INSERT method to import block with embedded styles ;; ;; ;; ;;----------------------------------------------------------------------;; (defun C:PG-INS-ALIGN ( / template_dwg curecho curlayer block_name *error*) ;; Error handler (defun *error* (msg) (if curecho (setvar "CMDECHO" curecho)) (if curlayer (setvar "CLAYER" curlayer)) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " msg)) ) (princ) ) ;; Save current settings (setq curecho (getvar "CMDECHO")) (setq curlayer (getvar "CLAYER")) (setvar "CMDECHO" 0) ;; Set template path and block name (setq template_dwg "C:/WSB-DT/Autodesk/Power Generation/Templates/Utility Scale Solar/RENEWABLES-CT-DESIGN.dwt") (setq block_name "TPLT-Alignment-Styles") ;; Check if template file exists (if (findfile template_dwg) (progn (princ "\n----------\nImporting Alignment Styles...") ;; Set layer to 0 (setvar "CLAYER" "0") ;; Insert block from template ;; Format: blockname=filepath (command "_.INSERT" (strcat block_name "=" template_dwg) "0,0,0" ; Insertion point "" ; X scale (default) "" ; Y scale (default) "") ; Rotation (default) ;; Check if insert was successful (if (entlast) (progn ;; Explode the inserted block (command "_.EXPLODE" (entlast)) ;; Purge the block definition (command "._-PURGE" "_B" block_name "_N") ;; Run audit to verify drawing integrity (command "._AUDIT" "_Y") (princ "\n----------\nPower Generation Alignment Styles Have Been Imported!") ) (progn (princ "\n----------\nERROR: Block insertion failed!") (princ (strcat "\nBlock '" block_name "' not found in template")) (princ "\n----------") ) ) ;; Restore settings (setvar "CLAYER" curlayer) (setvar "CMDECHO" curecho) ) (progn ;; Template file not found (setvar "CMDECHO" curecho) (princ "\n----------\nERROR: Template file not found!") (princ (strcat "\nLooking for: " template_dwg)) (princ "\nPlease verify the path is correct") (princ "\n----------") ) ) (princ) ) ;;----------------------------------------------------------------------;; ;; Load Confirmation ;; ;;----------------------------------------------------------------------;; (princ "\n----------") (princ "\nAlignment Style Import Command Loaded:") (princ "\n PG-INS-ALIGN - Import Alignment Styles") (princ "\n") (princ "\nNote: Template must contain a block named 'TPLT-Alignment-Styles'") (princ "\n with embedded alignment style definitions") (princ "\n----------") (princ)