Leaderboard

Hi Looking at this http://www.lee-mac.com/justifybasepoint.html

I am just going to put this here as a starter, LSChainage using Lee Macs Chainage LISP as a base. This modification lets you select numbers on a drawing, enter then select the line, plotting a block at the chainage. Needs a little modification to take away the number selection and calculate the distance along the line - that's the part I will look at later. This part was just copied and pasted from my stuff ;;https://www.cadtutor.net/forum/topic/1264-drawing-points-along-polyline/ (defun C:LSChainage ( / MyPt ppt pent ang cumm_dist dis dist_list leng obj pt reversed) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Set Attribute Value - Lee Mac ;; Sets the value of the first attribute with the given tag found within the block, if present. ;; blk - [ent] Block (Insert) Entity Name ;; tag - [str] Attribute TagString ;; val - [str] Attribute Value ;; Returns: [str] Attribute value if successful, else nil. (defun LM:setattributevalue ( blk tag val / enx ) (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))) (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx)) (progn (entupd blk) val ) ) (LM:setattributevalue blk tag val) ) ) ) ;;Chainage, make a small mark every 1/2 distance and add distance and big mark every distance (defun make_blk_measure ( / ) (if (not (tblsearch "STYLE" "$BLK_MEAS")) (entmake '((0 . "STYLE") (5 . "40") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "$BLK_MEAS") (70 . 0) (40 . 0.0) (41 . 0.7) (50 . 0.0) (71 . 0) (42 . 0.1) (3 . "ARIAL.TTF") (4 . "") ) ) ) (if (not (tblsearch "BLOCK" "BLK_MEASURE_CURVE")) (progn (entmake '((0 . "BLOCK") (8 . "0") (2 . "BLK_MEASURE_CURVE") (70 . 2) (4 . "") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0)) ) (entmake (append '((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine")) (list (list 10 0.0 (- (getvar "TEXTSIZE")) 0.0)) (list (list 11 0.0 (getvar "TEXTSIZE") 0.0)) '((210 0.0 0.0 1.0)) ) ) (entmake '( (0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbText") (10 0.0 0.0 0.0) (40 . 1.0) (1 . "0.0") (50 . 1.570796326794896) (41 . 0.7) (51 . 0.0) (7 . "$BLK_MEAS") (71 . 8) (72 . 1) (11 1.0 0.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbAttributeDefinition") (3 . "measure") (2 . "VALUE_MEASURE") (70 . 0) (73 . 0) (74 . 1) ) ) (entmake '((0 . "ENDBLK") (8 . "0") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2))) ) ) (if (not (tblsearch "BLOCK" "BLK_TICK_CURVE")) (progn (entmake '((0 . "BLOCK") (8 . "0") (2 . "BLK_TICK_CURVE") (70 . 2) (4 . "") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0)) ) (entmake (append '((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine")) (list (list 10 0.0 (* 0.5 (- (getvar "TEXTSIZE"))) 0.0)) (list (list 11 0.0 (* 0.5 (getvar "TEXTSIZE")) 0.0)) '((210 0.0 0.0 1.0)) ) ) (entmake '((0 . "ENDBLK") (8 . "0") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2))) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/end-selection-in-loop-with-enter-button/td-p/8815294 (defun LSGrabTexts ( / distlist ent) (setq distlist nil) (setvar 'errno 0) (while ; lop selecting texts (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect Text: "))) (cond ( (= 7 (getvar 'errno)) ;cond a (princ "\nMissed, try again.") ) ;end cond a ( (= 'ename (type ent)) ;cond b (princ (setq dist (cdr (assoc 1 (entget ent)))) ) (setq distlist (append distlist (list (atof dist)))) ) ;end cond b ) ) ) (princ "\nDistances: ")(princ distlist) distlist ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq dist_list (LSGrabTexts)) ; get absolute distances (setq dist_list_orig dist_list) (setq cumm_dist (apply 'max dist_list)) (setq dis 0.0) (setq pent (car (entsel "\n >> Select profile >>"))) (setq ppta (assoc 10 (entget pent))) ; start of route line (setq pptb (assoc 10 (reverse (entget pent)) )) ; end of route line (setq MyPt (getpoint "\nSelect Start Point")) (setq obj (vlax-ename->vla-object pent)) (setq leng (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj))) (if (or ;; Selected MyPt at ends of route line (= (vlax-curve-getdistatpoint obj MyPt) 0) (= (vlax-curve-getdistatpoint obj MyPt) leng) ) (progn ) ; end progn (progn (setq MyEndPt (getpoint "\nSelect a Point in the Direction")) (setq lenga (vlax-curve-getdistatpoint obj MyPt)) (setq lengb (vlax-curve-getdistatpoint obj MyEndPt)) (if (< lenga lengb) (progn (princ "\nA-B Calc Start Point") (setq newlist (list)) (setq acount 0) (while (< acount (length dist_list)) (setq newval (+ lenga (nth acount dist_list))) (if (< newval 0)(setq newval 0)) (setq newlist (append newlist (list newval))) (setq acount (+ acount 1)) ) (setq dist_list newlist) (setq MyPt (list (cadr ppta) (caddr ppta) 0) ) ) ; end progn (progn (princ "\nB-A Calc Start Point") (setq newlist (list)) (setq acount 0) (while (< acount (length dist_list)) (setq newval (+ (- leng lenga) (nth acount dist_list))) (if (< newval 0)(setq newval 0)) (setq newlist (append newlist (list newval))) (setq acount (+ acount 1)) ) (setq dist_list newlist) (setq MyPt (list (cadr pptb) (caddr pptb) 0) ) ) ; end progn ) ; end if ) ; end progn ) ; end if (if (= (vlax-curve-getdistatpoint obj MyPt) 0) () (progn (princ "\nReverse") (setq newlist (list)) (setq acount 0) (while (< acount (length dist_list)) (setq newval (- leng (nth acount dist_list))) (if (< newval 0)(setq newval 0)) (setq newlist (append newlist (list newval))) (setq acount (+ acount 1)) ) (princ newlist) (setq dist_list newlist) ) ) ; end if (setq acount 0) (while (< acount (length dist_list)) (setq dis (nth acount dist_list)) (if (> (nth acount dist_list) leng)(setq dis leng)) ;; fudge if SOP greater than route length?? (setq pt (vlax-curve-getpointatdist obj dis)) ;;insert block 'tick' (make_blk_measure) (setq ang (angle '(0 0 0) (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj pt)))) (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'InsertBlock pt "BLK_MEASURE_CURVE" 1 1 1 ang) (setq MyLastBlock (entlast)) (LM:setattributevalue MyLastBlock "VALUE_MEASURE" (strcat (rtos acount) ": " (rtos (nth acount dist_list_orig))) ) ;;or draw point: ;; (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'AddPoint pt) (setq dist_list (cdr dist_list)) (setq acount (+ acount 1)) ) ;end while (princ) )

Default, -3 (" all lineweights to be be set as default") Though yes, I would usually go ByLayer as a standard setting

If you put (CONS 370 25) the lineweight becomes 25mm, try -3 (ENTMOD (SUBST (CONS 370 -3) (ASSOC 370 EG) EG))

The best way to fix a gap is not to draw it in the first place. Is it possible to draw a polyline to represent your polygon? That way the nodes are guaranteed to close, especially if you use the Close option to finish it.

Another: (defun c:foo (/ n p s) (if (setq s (ssget '((0 . "LWPOLYLINE")))) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (setq n 0) (while (setq p (vlax-curve-getpointatparam e n)) (entmakex (list '(0 . "POINT") (cons 10 p))) (setq n (+ n 0.5)) ) ) ) (princ) )