Leaderboard

Ok the answer is make some standard sizes, why make a new size to save 20 mm of paper. make say sizes with 50 mm steps you only have to do once. Even the code I talked about just found the size to suit but you have to make each sheet size. Its just one of those things.

; HCEN - 2023.09.05 exceed ; Draw CenterLine in hatch (straight feature or elbow feature shape) ; for structural member systems, trays, piping, ducts, etc., (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 ) (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-startundomark thisdrawing) (setq oldpeditaccept 0) (setq oldpeditaccept (getvar 'peditaccept)) (setq oldcmdecho 0) (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 : ") (setq ss (ssget '((0 . "HATCH")))) (command "_.hatchgenerateboundary" ss "") (while (> (getvar 'cmdactive) 0) (command pause) ) (setq index 0) (while (setq ent (entnext entl)) (ssadd ent pss) (if (= index 0) (progn (if (/= myline nil) (vla-delete myline) ) ) ) (setq entl ent) (setq index (+ index 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) ) ;(princ pclosed) ;(princ plist) ;(princ plength) ;(princ ptype) (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) ;(princ sorteddistlist) (repeat distlistlen (setq 1dist (nth dindex sorteddistlist)) ;(princ "\n 1dist - ") ;(princ 1dist) ;(princ "\n memorydist - ") ;(princ memorydist) ;(princ "\n widthconjecture - ") ;(princ widthconjecture) (if (and (= widthconjecture 0) (= (vl-princ-to-string memorydist) (vl-princ-to-string 1dist))) (setq widthconjecture 1dist) ;(princ "\n why") ) (setq memorydist 1dist) (setq dindex (+ dindex 1)) ) ;(princ "\n this solid's width conjecture is = ") ;(princ widthconjecture) (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)) ) ;(princ breakptlist) (setq bplistlen (length breakptlist)) (setq eobjlist (vlax-safearray->list (vlax-variant-value (vla-explode pobj)))) (entdel pent) ;(princ eobjlist) (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)))) (setq bindex 0) (setq rssflag 0) ;(princ "\n bp list len - ") ;(princ bplistlen) (repeat bplistlen (setq b1 (nth bindex breakptlist)) ;(princ "\n b1 - ") ;(princ b1) (if (or (and (= (list (lm:roundto (car (car b1)) 0) (lm:roundto (cadr (car b1)) 0)) (list (lm:roundto (car 1objsp) 0) (lm:roundto (cadr 1objsp) 0))) (= (list (lm:roundto (car (cadr b1)) 0) (lm:roundto (cadr (cadr b1)) 0)) (list (lm:roundto (car 1objep) 0) (lm:roundto (cadr 1objep) 0))) ) (and (= (list (lm:roundto (car (car b1)) 0) (lm:roundto (cadr (car b1)) 0)) (list (lm:roundto (car 1objep) 0) (lm:roundto (cadr 1objep) 0))) (= (list (lm:roundto (car (cadr b1)) 0) (lm:roundto (cadr (cadr b1)) 0)) (list (lm:roundto (car 1objsp) 0) (lm:roundto (cadr 1objsp) 0))) ) ) (progn (setq rssflag (+ rssflag 1)) ) (progn ;(princ "\ntest") ;(princ b1) ;(princ 1objsp) ;(princ 1objep) ) ) (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) ) ) ) (t ;(ssdel (vlax-vla-object->ename 1obj) rss) ) ) (setq eindex (+ eindex 1)) ) ;(sssetfirst nil rss) (setq rsslen (sslength rss)) ;(princ "\n rss length - ") ;(princ rsslen) ;(princ "\n remainlist - ") ;(princ remainlist) (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)) ) ;(princ "\n mid pt list - ") ;(princ midptlist) (repeat rsslen (setq rs1 (vlax-ename->vla-object (ssname rss rsindex))) ;(princ rs1) (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 (= (list (rtos (car 1midpt) 2 2) (rtos (cadr 1midpt) 2 2)) (list (rtos (car rsoff1sp) 2 2) (rtos (cadr rsoff1sp) 2 2))) (= (list (rtos (car 1midpt) 2 2) (rtos (cadr 1midpt) 2 2)) (list (rtos (car rsoff1ep) 2 2) (rtos (cadr rsoff1ep) 2 2))) ) (progn ;(princ "\n Same 1midpt - ") ;(princ 1midpt) ;(princ " / ") ;(princ rsoff1sp) ;(princ " / ") ;(princ rsoff1ep) ;(princ " select 1") (setq mflag (+ mflag 1)) ) (progn ;(princ "\n Same 1midpt - ") ;(princ 1midpt) ;(princ " / ") ;(princ rsoff1sp) ;(princ " / ") ;(princ rsoff1ep) ; ;(princ " select 2") ) ) (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)) ) ) ) ) ) ) (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)) ;(vl-cmdf "_pedit" (vlax-vla-object->ename rsoff1) "w" widthconjecture "") ;(ssadd (entlast) mss) ;(setq rsofflist (cons rsoff1 rsofflist)) ;(setq rsofflist (cons rsoff2 rsofflist)) (setq rsindex (+ rsindex 1)) ) ;(princ remainlist) ;(setq bpllen (length breakptlist)) ;(setq bpindex 0) ;(repeat bpllen ; (setq bp1 (nth bpindex breakptlist)) ; (setq bpindex (+ bpindex 1)) ;) ;(setq resultlen (/ (- plength (* 2 widthconjecture)) 2)) ;(setq resultformula (strcat resultformula (if (= index 0) "" "+") (vl-princ-to-string resultlen))) ;(setq resultsum (+ resultsum resultlen)) (setq delindex 0) (repeat (sslength rss) (setq delrss (ssname rss delindex)) (entdel delrss) (setq delindex (+ delindex 1)) ) (setq index (+ index 1)) ) (command "-overkill" mss "o" "0.000001" "") ;(while (setq ent (entnext entl)) ; (ssadd ent oss) ; (setq entl ent) ;) ;(sssetfirst nil) ;(sssetfirst nil mss) (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) ;(command "regen") ;(command "select" newmss "") ;(princ (sslength newmss)) (setq oss (ssadd)) (setq entl (entlast)) (vl-cmdf "_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) ;(setq mpl (entlast)) (princ "\n total lenght of you selected") (princ "\n ") (princ resultformula) (princ " = ") (princ resultsum) (setvar 'cmdecho oldcmdecho) (setvar 'peditaccept oldpeditaccept) (vla-EndUndoMark thisdrawing) (princ) )

I had to solve this problem in drawings coming from microstation/dgn format. A lot of arcs and polylines had this and couldn't be joined. I solved this problem with a simple Lisp routine. (defun c:swap() (setq f1 (ssget "_x" '((210 0.0 0.0 -1.0)))) (if (/= f1 nil) (command "_mirror3d" f1 "" "xy" "0,0,0" "y") ) (setq f1 nil) ) Marco