Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 03/17/2023 in all areas

  1. I found this code here https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/entmake-hatch-with-base-point-or-object-polyline-entity-name/m-p/8703197#M383362 I adapted it to do what you asked. I made 2 commands: 1 that selects existing polylines ( SPH ), 1 where you make new polylines ( MPH ). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; https://www.cadtutor.net/forum/topic/77129-polyline-and-hatching-with-autolisp/ ;; User makes a polyline by selecting points. The polyline is auto closed, a hatch is drawn inside ;; Make Polyline Hatch (defun c:mph ( / ss sc pp pt pts ln ls pline) (setq sc (getreal "\nScale: ")) (if (= 0.0 sc) (setq sc 1.0) ) (prompt "\nSelect points to make a Closed Polyline. Press enter to close the polyline: ") (setq pts (list)) (setq ls (list)) (setq pt (getpoint "\nPoint 1: ")) (setq pp pt) (setq pts (append pts (list pt))) (while (setq pt (getpoint pt "\nPoint: ")) ;; draw temporary line (setq ls (append ls (list (drawLine pp pt)))) (setq pp pt) (setq pts (append pts (list pt))) ) (setq pline (drawLWPoly pts 1)) ;; delete temporary lines (foreach ln ls (entdel ln) ) (hatch_closed_polyline (ssadd pline) sc) ) ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun drawLine (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))) ) (defun drawLWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; user selects existing polylines; a hatch will be drawn inside ;; Select Polyline Hatch (defun c:sph ( / ss sc) (setq sc (getreal "\nScale: ")) (prompt "\nSelect Closed Polylines to Hatch: ") (while (setq ss (ssget '((0 . "LWPOLYLINE")))) (hatch_closed_polyline ss sc) ;;(entmakex-hatch hList 0.0 "ANSI31" 1.0) ) ) ;; slightly modified from this code: ;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/entmake-hatch-with-base-point-or-object-polyline-entity-name/m-p/8703197#M383362 (defun hatch_closed_polyline (ss sc / cnt e hList) (if (= 0.0 sc) (setq sc 1.0) ) (setq cnt (sslength ss)) (while (<= 0 (setq cnt (1- cnt))) (setq e (ssname ss cnt)) (if (setq tmp (CreateHatchList e)) (setq hList (cons tmp hList)) );if );while (setq hList (reverse hList)) (if (entmakex-hatch hList 0.0 "ANSI31" sc) (prompt "\nSuccess!") (prompt "\n...Failure.") );if (princ) );defun (defun CreateHatchList (e / i j pList found) (foreach i (entget e) (if (= 10 (car i)) (progn (setq pList (cons i pList)) (setq found nil j (member i (entget e))) (while (and (not found) (< 0 (length j))) (if (= 42 (car (car j))) (setq pList (cons (car j) pList) found t) );if (setq j (cdr j)) );while );progn );if );foreach (reverse pList) );defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun entmakex-hatch (l a n s) ;; By ElpanovEvgeniy ;; L - list point ;; A - angle hatch ;; N - name pattern ;; S - scale ;; return - hatch ename (entmakex (apply 'append (list (list '(0 . "HATCH") '(100 . "AcDbEntity") '(410 . "Model") '(100 . "AcDbHatch") '(10 0.0 0.0 0.0) '(210 0.0 0.0 1.0) (cons 2 n) (if (= n "SOLID") '(70 . 1) '(70 . 0) ) ;_ if '(71 . 0) (cons 91 (length l)) ) ;_ list (apply 'append (mapcar '(lambda (a) (apply 'append (list (list '(92 . 7) '(72 . 1) '(73 . 1) (cons 93 (/ (length a) 2))) (mapcar '(lambda (b) b) a) '((97 . 0)) ) ;_ list ) ;_ apply ) ;_ lambda l ) ;_ mapcar ) ;_ apply (list '(75 . 0) '(76 . 1) (cons 52 a) (cons 41 s) '(77 . 0) '(78 . 1) (cons 53 a) '(43 . 0.) '(44 . 0.) '(45 . 1.) '(46 . 1.) '(79 . 0) '(47 . 1.) '(98 . 2) '(10 0. 0. 0.0) '(10 0. 0. 0.0) '(451 . 0) '(460 . 0.0) '(461 . 0.0) '(452 . 1) '(462 . 1.0) '(453 . 2) '(463 . 0.0) '(463 . 1.0) '(470 . "ANSI31") ) ;_ list ) ;_ list ) ;_ apply ) ;_ entmakex ) ;_ defun (princ "\nCOMMAND MPH: Make Polyline Hatch.") (princ "\nCOMMAND SPH: Select Polyline Hatch.") (princ)
    1 point
  2. It works perfectly fine now, thanks a lot sir.
    1 point
  3. OK, This is what I have, should be the same as yours? Try it just to make sure of say typing errors and so on ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-polyline-length-total-by-layer-in-table/m-p/11229970#M432527 ;; Hatched area Table sorted by Layer with the Color markers ;;; (Defun c:POLYLENGHT ( / AllData ss e edata Area_table crow bn area_ ssNH fname clr ) (vl-load-com) ;;; pBe 23Apr2013 ;;; ;;; Mod for FSJ_Mo : Layer instead of Block swatches ;;; ;;; pBe 18Jul2013 ;;; ;;; karpki : Header by filename, m2 05/01/2020 ;;; ;;; Moded by hak_vz for karpki: color markers 12/01/2020 ;;; (setq txtht 250) ;; Change all '500' to this (setq cellht (* 3 txtht)) ;; Change all 1500 to this (setq cellwd (* 14 txtht)) ;; Change 7000 to this (if (setq AllData nil ssNH (ssadd) ss (ssget '((0 . "POLYLINE,LWPOLYLINE"))) ) (progn (repeat (setq i (sslength ss)) (setq e (vlax-ename->vla-object (ssname ss (Setq i (1- i))))) (setq edata (list (vlax-get e 'Layer) (IF (not (vl-catch-all-error-p (setq area_ (vl-catch-all-apply 'vla-get-area (list E))) ) ) area_ (progn (ssadd (ssname ss i) ssNH) 0.0) ) ) ) (setq AllData (if (setq f (assoc (car edata) AllData)) (subst (list (car f) (+ (cadr f) (cadr edata))) f Alldata) (cons edata AllData) ) ) ) (setq AllData (vl-sort AllData '( lambda (m n) (< (Car m) (car n))))) (setq Area_table (vlax-invoke (vlax-get (vla-get-ActiveLayout (vla-get-activedocument (vlax-get-acad-object)) ) 'Block ) 'Addtable (getpoint "\nPick point for Table:") 2 3 cellht cellwd ) ) (setq fname(substr (setq str (getvar "dwgname")) 1 (- (strlen str) 4))) ;get Header name from file name (vla-settext Area_table 0 0 fname) ;set header name (vla-setcelltextheight Area_table 0 0 txtht) (mapcar '(lambda (y) (vla-settext Area_table 1 (car y) (cadr y)) (vla-setcelltextheight Area_table 1 (car y) txtht) ;second row text height ) (list '(0 "Category") '(1 "Total Length") '(2 "Colour")) ) (foreach d AllData (vla-insertrows Area_table (1+ (setq crow (vla-get-rows Area_table))) cellht ;cell height from 4-th row 1 ) (vla-setcelltextheight Area_table crow 0 txtht) ;set Layer name (Category) (vla-setCellAlignment Area_table crow 0 5) (vla-setCellValue Area_table crow 0 (car d)) (vla-setCellValue Area_table crow 1 (cadr d)) ;set Area (vla-setcelltextheight Area_table crow 1 txtht) (vla-setCellAlignment Area_table crow 1 5) (vla-setcellformat Area_table crow 1 (strcat "%lu2%pr3%ps[, m" (chr 072) "]")) (setq x(strcat "AutoCAD.AcCmColor." (substr (getvar 'Acadver) 1 2))) ;set Color markers (setq clr (vlax-create-object x)) (vla-put-colorindex clr (cdr (assoc 62 (tblsearch "layer" (car d))))) (vla-SetCellBackgroundColor Area_table crow 2 clr) ) ) ) (princ) )
    1 point
  4. For me its "72", but when I change all things according to your answer I get this error:
    1 point
  5. @smitaranjan just trying to understand what it is.dwg APSFL-01.csv
    1 point
  6. That's odd. if you create a piece of mtext, make a squared sign ( ² ) in it and then paste that into the command line using (ascii ) that should give you the code to use, for me it is 178, or copy this into the command line: (ascii "²")
    1 point
  7. and did you do this to get squared? (vla-setcellformat Area_table crow 1 (strcat "%lu2%pr3%ps[, m" (chr 178) "]"))
    1 point
  8. Perfect... you don't need our help then! EDIT If you make the table with the LISP and measure the distances I reckon within the LISP these numbers will appear somewhere - and they are the ones to change. Do a quick check of course that you aren't changing something odd. Cell heights are 1500? and cell widths are 7000? So if it was me I'd add this to the start of the code, perhaps under the (vl-load-com). and the comments should suggest what to change later in the code: I just picked a text height of 250 - change it to what you want, cellht and cellwd are keeping the cell sizes in proportion to the text in the original table. Change the 250 to what you want and the rest will follow, you could even go further and ask the user what text height to use (setq txtht 250) ;; Change all '500' to this (setq cellht (* 3 txtht)) ;; Change all 1500 to this (setq cellwd (* 14 txtht)) ;; Change 7000 to this Have a go and see what you can do.
    1 point
×
×
  • Create New...