Leaderboard

Steven P's Hatch2Poly works fine on my 2022 AutoCAD. Both exceed and Steven P did a great job, y'all have left me in the dust.

misspelled rlength on the first setq.

i updated code for additional option for deleting original hatches (when it makes same quantity polylines). please test it

ah my mistake thank you for comments. at first time i use tc (insertion coordinates) points for calculation i was changed that tc with boundingbox but didn't change that so just change (caddr tc) with 0.0 or (caddr lll) is will be okay i will update code in above. because now im going to home now > code updated and tested in acad2023

@exceed @asdfgh I don't know << tc >> indicate A problem with it (setq p1 (list (- (car lll) (* scalefactor th)) (- (cadr lll) (* scalefactor th)) (caddr tc))) (setq p2 (list (+ (car url) (* scalefactor th)) (+ (cadr url) (* scalefactor th)) (caddr tc)))

Exceed's is working here, doesn't delete the hatches. I use this to remove all hatches in a drawing. (defun c:DeHatch (/) (if (setq h (ssget "_X" '((0 . "HATCH")))) (repeat (setq a (sslength h)) (entdel (ssname h (setq a (1- a))))) ) (princ) ) Steven P I get the arc offset.

(defun C:FOO (/ *error* thisdrawing scalefactor ss ssl index outputtxt ssl ent obj ts box lll url th p1 p2 ss2 lent lobj llen lentxt ) (vl-load-com) (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (vla-EndUndoMark thisdrawing) (princ) ) (vla-EndUndoMark thisdrawing) (vla-startundomark thisdrawing) (defun ex:@setclipboardtext (text / htmlfile result) (setq htmlfile (vlax-create-object "htmlfile")) (vlax-release-object htmlfile) (setq htmlfile (vlax-create-object "htmlfile")) (setq result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow) 'ClipBoardData) 'SetData "Text" text ) ) (vlax-release-object htmlfile) text ) (setq scalefactor 2) ; you can adjust this. (princ "\n select texts") (if (setq ss (ssget '((0 . "TEXT")))) ; if you want with no user selection, replace with this, (if (setq ss (ssget "X" '((0 . "TEXT")))) (progn (setq ssl (sslength ss)) (setq index 0) (setq outputtxt "") (repeat ssl (setq ent (ssname ss index)) (setq obj (vlax-ename->vla-object ent)) (setq ts (vlax-get-property obj 'textstring)) (setq box (vla-getboundingbox obj 'll 'ur)) (setq lll (vlax-safearray->list ll)) ; lower left point (setq url (vlax-safearray->list ur)) ; upper right point (setq th (vlax-get-property obj 'height)) (setq p1 (list (- (car lll) (* scalefactor th)) (- (cadr lll) (* scalefactor th)) 0.0)) (setq p2 (list (+ (car url) (* scalefactor th)) (+ (cadr url) (* scalefactor th)) 0.0)) (if (setq ss2 (ssget "c" p1 p2 '((0 . "LINE")))) (progn (setq lent (ssname ss2 0)) (setq lobj (vlax-ename->vla-object lent)) (setq llen (vlax-get-property lobj 'length)) (setq lentxt (vl-princ-to-string llen)) ) (progn (setq lentxt "there's no line") ) ) (setq outputtxt (strcat outputtxt (if (= index 0) "" "\r\n") ts "\t" lentxt)) (setq index (+ index 1)) ) (ex:@setclipboardtext outputtxt) (princ "\n copy complete. you can paste it to excel.") ) (progn (princ "\n there's no text.") ) ) (vla-EndUndoMark thisdrawing) (princ) ) you can start with this

‘Near’ is a human friendly word. It must be described so that the machine can understand how close it is. generally Lines can be long, and text is not that long. so, you need to know where to find the text in line, around starting point, midpoint, and endpoint or something. Since the text is not a single pair with a line, you need to specify a bounding rectangle and capture it, like you would select text in CAD. In the best case, the text insertion point is located exactly above the line. You also need to be aware of various factors to consider, such as if there is a back dwg excluding the relevant objects in the drawing or text that should not be selected, if lines intersect, or if there are multiple lines in the radius around the text. It would be good if the general formula could be described in sufficient detail but cannot, the best thing to do is to attach a sample drawing.

This routine has been tested on AutoCAD 2023. ; HCEN - 2023.09.06 exceed ; Draw CenterLine in hatch (straight feature or elbow feature shape) ; for structural member systems, trays, piping, ducts, etc., ; updated ; - Tested in autocad 2023 and zwcad 2022. ; - color inherit & delete original hatches option. (by user input) ; This routine requires that the two line segments have the same length ; and that length must be the shortest length. ; Straight, 90 degree elbow, 45 degree elbow, 30 degree elbow, etc. ; Tilted cuts or odd shapes are not supported. ; If the r value of the elbow is small and smaller than the two line ; segment values above, an error may occur. (defun C:HCEN (/ *error* thisdrawing util mspace myline index entl ent pss ss pssl resultformula resultsum pent pobj ptype plength plist pclosed plistlen pindex distlist p1 p2 pdist distlistlen dindex memorydist widthconjecture 1dist resultlen rss breakptlist breakp1 breakp2 bpllen bpindex bplistlen eobjlist eobjlistlen eindex remainlist 1obj 1objtype 1objsp 1objep bindex rssflag b1 rsslen rsindex rsofflist rs1 rsoff1 rsoff2 midptlist midpt rsoff1sp rsoff1ep mindex mflag 1midpt x delindex delrss mss newmss m1 oss ossl oindex oent oobj each hyp_txt ssindex ssslen colorlist sssindex sscolor ssent coloruseranswer deleteuseranswer ) (vl-load-com) (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (setvar 'cmdecho oldcmdecho) (setvar 'peditaccept oldpeditaccept) (vla-EndUndoMark thisdrawing) (princ) ) ;; Round Multiple - Lee Mac ;; Rounds 'n' to the nearest multiple of 'm' (defun LM:roundm (n m) (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5))) ) ;; Round To - Lee Mac ;; Rounds 'n' to 'p' decimal places (defun LM:roundto (n p) (LM:roundm n (expt 10.0 (- p))) ) (vla-EndUndoMark thisdrawing) (vla-startundomark thisdrawing) (setq oldpeditaccept 0) (setq oldpeditaccept (getvar 'peditaccept)) (setq oldcmdecho 1) (setq oldcmdecho (getvar 'cmdecho)) (setvar 'peditaccept 1) (setvar 'cmdecho 0) (setq util (vla-get-utility thisdrawing)) (setq mspace (vla-get-modelspace thisdrawing)) (if (setq entl (entlast)) (progn (setq entl (entlast)) ) (progn (setq myline (vla-addline mspace (vlax-3d-point (list 0 0 0)) (vlax-3d-point (list 1 1 1)) ) ) (setq entl (entlast)) ) ) (setq pss (ssadd)) (princ "\n Select Hatches : ") (if (setq ss (ssget '((0 . "HATCH")))) (progn (setq ssslen (sslength ss)) (setq colorlist '()) (setq sssindex 0) (setq coloruseranswer (getstring "\n Do you want to inherit the color of the hatch to the polyline? (Space Bar or any key - Yes / N - Current Color")) (if (= coloruseranswer nil) (setq coloruseranswer "Y") (setq coloruseranswer (strcase coloruseranswer)) ) (repeat ssslen (setq sssent (ssname ss sssindex)) (setq sscolor (vlax-get-property (vlax-get-property (vlax-ename->vla-object sssent) 'truecolor) 'colorindex ) ) ;(princ sscolor) (princ "\n") (command "_.hatchgenerateboundary" sssent "") (if (/= coloruseranswer "N") (vlax-put-property (vlax-ename->vla-object (entlast)) 'color sscolor) ) (setq sssindex (+ sssindex 1)) ) (setq ssindex 0) (while (setq ent (entnext entl)) (ssadd ent pss) (if (= ssindex 0) (progn (if (/= myline nil) (vla-delete myline) ) ) ) (setq entl ent) (setq ssindex (+ ssindex 1)) ) (sssetfirst nil pss) (setq pssl (sslength pss)) (setq index 0) (setq resultformula "") (setq resultsum 0) (setq mss (ssadd)) (repeat pssl (setq pent (ssname pss index)) (setq pobj (vlax-ename->vla-object pent)) (setq ptype (vlax-get-property pobj 'entityname)) (setq plength (vlax-get-property pobj 'length)) (setq plist (vlax-safearray->list (vlax-variant-value (vlax-get-property pobj 'coordinates)) ) ) (setq pclosed (vlax-get-property pobj 'closed)) (if (= pclosed :vlax-true) (progn (setq plist (append plist (list (car plist) (cadr plist)))) ) (progn) ) (setq plistlen (length plist)) (setq pindex 0) (setq distlist '()) (repeat (- (/ plistlen 2) 1) (setq p1 (list (nth pindex plist) (nth (+ pindex 1) plist))) (setq p2 (list (nth (+ pindex 2) plist) (nth (+ pindex 3) plist))) (setq pdist (distance p1 p2)) (setq distlist (cons pdist distlist)) (setq pindex (+ pindex 2)) ) (setq sorteddistlist (vl-sort distlist '<)) (setq distlistlen (length sorteddistlist)) (setq dindex 0) (setq memorydist -1) (setq widthconjecture 0) (repeat distlistlen (setq 1dist (nth dindex sorteddistlist)) (if (and (= widthconjecture 0) (= (vl-princ-to-string memorydist) (vl-princ-to-string 1dist)) ) (setq widthconjecture 1dist) ) (setq memorydist 1dist) (setq dindex (+ dindex 1)) ) (if (= widthconjecture 0) (setq widthconjecture (car sorteddistlist)) ) (setq dindex 0) (setq pindex 0) (setq breakptlist '()) (setq distlist (reverse distlist)) (repeat distlistlen (setq 1dist (nth dindex distlist)) (if (= (lm:roundto widthconjecture 0) (lm:roundto 1dist 0)) (progn (setq breakp1 (list (nth pindex plist) (nth (+ pindex 1) plist))) (setq breakp2 (list (nth (+ pindex 2) plist) (nth (+ pindex 3) plist))) (setq breakptlist (cons (list breakp1 breakp2) breakptlist)) ) ) (setq dindex (+ dindex 1)) (setq pindex (+ pindex 2)) ) (setq bplistlen (length breakptlist)) (setq eobjlist (vlax-safearray->list (vlax-variant-value (vla-explode pobj)))) (entdel pent) (setq eobjlistlen (length eobjlist)) (setq eindex 0) (setq remainlist '()) (setq rss (ssadd)) (repeat eobjlistlen (setq 1obj (nth eindex eobjlist)) (setq 1objtype (vlax-get-property 1obj 'entityname)) (cond ((= 1objtype "AcDbArc") (setq remainlist (cons 1obj remainlist)) (ssadd (vlax-vla-object->ename 1obj) rss) ) ((= 1objtype "AcDbLine") (setq 1objsp (vlax-safearray->list (vlax-variant-value (vlax-get-property 1obj 'startpoint)) ) ) (setq 1objep (vlax-safearray->list (vlax-variant-value (vlax-get-property 1obj 'endpoint)) ) ) (if (/= (lm:roundto (distance 1objsp 1objep) 0) 0) (progn (setq bindex 0) (setq rssflag 0) (repeat bplistlen (setq b1 (nth bindex breakptlist)) (if (or (and (= (lm:roundto (car (car b1)) 0) (lm:roundto (car 1objsp) 0)) (= (lm:roundto (cadr (car b1)) 0) (lm:roundto (cadr 1objsp) 0) ) (= (lm:roundto (car (cadr b1)) 0) (lm:roundto (car 1objep) 0)) (= (lm:roundto (cadr (cadr b1)) 0) (lm:roundto (cadr 1objep) 0) ) ) (and (= (lm:roundto (car (car b1)) 0) (lm:roundto (car 1objep) 0)) (= (lm:roundto (cadr (car b1)) 0) (lm:roundto (cadr 1objep) 0) ) (= (lm:roundto (car (cadr b1)) 0) (lm:roundto (car 1objsp) 0)) (= (lm:roundto (cadr (cadr b1)) 0) (lm:roundto (cadr 1objsp) 0) ) ) ) (progn (setq rssflag (+ rssflag 1)) ) (progn ) ) (setq bindex (+ bindex 1)) ) (if (/= rssflag 0) (progn (entdel (vlax-vla-object->ename 1obj)) ) (progn (setq remainlist (cons 1obj remainlist)) (ssadd (vlax-vla-object->ename 1obj) rss) ) ) ) (progn (entdel (vlax-vla-object->ename 1obj)) ) ) ) (t ) ) (setq eindex (+ eindex 1)) ) (setq rsslen 0) (if rss (progn (setq rsslen (sslength rss)) (setq rsindex 0) (setq rsofflist '()) (setq bindex 0) (setq midptlist '()) (repeat bplistlen (setq bp1 (nth bindex breakptlist)) (setq midpt (polar (car bp1) (angle (car bp1) (cadr bp1)) (/ (distance (car bp1) (cadr bp1)) 2) ) ) (setq midptlist (cons midpt midptlist)) (setq bindex (+ bindex 1)) ) (repeat rsslen (setq rs1 (vlax-ename->vla-object (ssname rss rsindex))) (setq rsoff1 (car (vlax-safearray->list (vlax-variant-value (vlax-invoke-method rs1 'Offset (* (/ widthconjecture 2) 1) ) ) ) ) ) (setq rsoff1sp (vlax-safearray->list (vlax-variant-value (vlax-get-property rsoff1 'startpoint) ) ) ) (setq rsoff1ep (vlax-safearray->list (vlax-variant-value (vlax-get-property rsoff1 'endpoint)) ) ) (setq miptlistlen (length midptlist)) (setq mindex 0) (setq mflag 0) (repeat miptlistlen (setq 1midpt (nth mindex midptlist)) (if (or (and (= (rtos (car 1midpt) 2 2) (rtos (car rsoff1sp) 2 2)) (= (rtos (cadr 1midpt) 2 2) (rtos (cadr rsoff1sp) 2 2)) ) (and (= (rtos (car 1midpt) 2 2) (rtos (car rsoff1ep) 2 2)) (= (rtos (cadr rsoff1ep) 2 2) (rtos (cadr 1midpt) 2 2)) ) ) (progn (setq mflag (+ mflag 1)) ) (progn ) ) (setq mindex (+ mindex 1)) ) (if (= mflag 0) (progn (entdel (vlax-vla-object->ename rsoff1)) (setq rsoff1 (car (vlax-safearray->list (vlax-variant-value (vlax-invoke-method rs1 'Offset (* (/ widthconjecture 2) -1) ) ) ) ) ) (entdel (vlax-vla-object->ename rs1)) ) (progn (entdel (vlax-vla-object->ename rs1)) ) ) (ssadd (vlax-vla-object->ename rsoff1) mss) (vlax-for x (vla-get-hyperlinks rsoff1) (vla-delete x)) (vla-add (vlax-get-property rsoff1 'Hyperlinks) (vl-princ-to-string widthconjecture) ) (setq rsindex (+ rsindex 1)) ) ) ) (setq index (+ index 1)) ) (setq newmss (ssadd)) (setq mindex 0) (repeat (sslength mss) (setq m1 (ssname mss mindex)) ;(princ m1) (if (entget m1) (progn (ssadd m1 newmss) ) ) (setq mindex (+ mindex 1)) ) (sssetfirst nil newmss) (setq oss (ssadd)) (setq entl (entlast)) (command "_pedit" "_M" newmss "" "J" "0" "") (while (setq ent (entnext entl)) (ssadd ent oss) (setq entl ent) ) (sssetfirst nil oss) (setq ossl (sslength oss)) (setq oindex 0) (repeat ossl (setq oent (ssname oss oindex)) (setq oobj (vlax-ename->vla-object oent)) (vlax-for each (vlax-get-property oobj 'Hyperlinks) (setq hyp_txt (strcat (vla-get-url each))) ) (vlax-put-property oobj 'constantwidth (atoi hyp_txt)) (vlax-for x (vla-get-hyperlinks oobj) (vla-delete x)) (setq olen (vlax-get-property oobj 'length)) (setq resultformula (strcat resultformula (if (= oindex 0) "" " + ") (vl-princ-to-string olen) ) ) (setq resultsum (+ resultsum olen)) (setq oindex (+ oindex 1)) ) (princ "\n hatches count = ") (princ (sslength ss)) (princ "\n plines count - ") (princ oindex) (princ "\n total lenght of you selected") (princ "\n ") (princ resultformula) (princ " = ") (princ resultsum) (command "erase" rss "") (command "erase" pss "") (if (= (sslength ss) oindex) (progn (setq deleteuseranswer (getstring "\n The number of hatches and polylines is the same. Are you sure you want to delete the original hatch? (SpaceBar or AnyKey - Yes / N - No)")) (if (= deleteuseranswer nil) (setq deleteuseranswer "Y") (setq deleteuseranswer (strcase deleteuseranswer)) ) (if (/= deleteuseranswer "N") (command "erase" ss "") ) ) (progn (princ "\n The number of hatches and polylines does not match. There may be a problem, so please check manually.") ) ) (sssetfirst nil oss) ) (progn (princ "\n There are no hatches in the selection set. Please try again.") ) ) (setvar 'cmdecho oldcmdecho) (setvar 'peditaccept oldpeditaccept) (vla-EndUndoMark thisdrawing) (princ) ) below memo is for other people who lisping. not how to use this. there was a difference in the basic command, hatchgenerateboundary works differently in zwcad and autocad. In autocad, length 0 line is created, and in zwcad, it does not. Since it is the same hatch in the same drawing, there is a difference even if the boundary is a dirty issue. I didn't handle the exception for that. even in the case of doing entdel to not exist entities. zwcad moves on to the next step without an error.

I will typically draw and dimension in model space. However, dimensioning is done through the viewports with the 'DIMSCALE' set to '0'. This will allow the current DIMSTYLE to be scaled to the viewport scale. No need to create multiple scales of the same DIMSTYLE.